AWS.hs

{-|
Module:             AWSMachine
Description:        Basic wrappers around the AWS library with Machine support.
Copyright:          © 2017 All rights reserved.
License:            GPL-3
Maintainer:         Evan Cofsky <>
Stability:          experimental
Portability:        POSIX
-}

module Network.AWS.Machines.AWS (
    module Machine,
    module Lawless,
    AWSProcessT,
    AWSSourceT,
    RequestMod,
    M,
    withAWS,
    awsSource,
    pagedSource,
    liftAWS,
    liftIO,
    MonadIO,
    MonadAWS,
    MonadBaseControl,
    AWST',
    Env,
    ResourceT,
    MonadCatch
    ) where

import Lawless hiding (
    argument,
    mapping,
    filtered,
    dropping,
    droppingWhile,
    taking,
    takingWhile,
    cycled,
    iterated,
    repeated,
    replicated,
    (<~),
    (<>)
    )
import Network.AWS hiding (send, within)
import Control.Monad.Trans.AWS
import Control.Monad.IO.Class
import Control.Monad.Trans.Control
import Control.Monad.Catch
import Text
import Control.Monad.Trans.Resource
import Machine
import Data.Machine.Concurrent
import Data.Foldable

default (Text)

-- | The base monad constraints for an 'AWSMachineT'.
type M m = (MonadBaseControl IO m, MonadAWS (AWST' Env (ResourceT m)))

-- | Any 'MachineT' operating in the AWST' stack.
type AWSMachineT m k b = M m ⇒ MachineT (AWST' Env (ResourceT m)) k b

-- | A process transducing a stream of AWS values.
type AWSProcessT m a b = AWSMachineT m (Is a) b

-- | A stream of AWS values.
type AWSSourceT m b = ∀ k. AWSMachineT m k b

-- | A 'Getter' for extracting values from an 'Rs' 'AWSRequest'.
type GetResponse f a c =
    (AWSRequest a, Foldable f) ⇒ Getting (f c) (Rs a) (f c)

-- | Modifies an 'AWSRequest' after the smart constructor has created
-- it.
type RequestMod a = a → a

-- | Run an AWSProcessT.
withAWS ∷ (MonadCatch m, MonadIO m, M m) ⇒
    Credentials → Logger → Region → AWSProcessT m a b → m [b]
withAWS creds lgr reg f = do
    env <- set envLogger lgr <$> newEnv creds
    runResourceT $ runAWST env
        $ within reg
        $ runT f

awsSource ∷
    (AWSRequest a, Foldable f) ⇒
    GetResponse f a c
    → [RequestMod a]
    → a
    → AWSSourceT m c
awsSource i ms r =
    let
        r0 = modRequest ms r
        unf _ rs = Just (rs ^. i, Nothing)
        nr = \case
            Nothing → return Nothing
            Just q → liftAWS $ send q >>= return ∘ unf q
    in
        unfoldT nr (Just r0) >~> asParts

-- | Stream an 'AWSPager' instance.
pagedSource ∷
    (Foldable f, AWSPager a) ⇒
    GetResponse f a c -- ^ Accessor for the list of ∈ in the response.
    → [RequestMod a] -- ^ Request modifiers
    → a -- ^ The initial request.
    → AWSSourceT m c
    -- ^ A 'Source' of each ∈ in each page.
pagedSource i ms r =
    let
        -- Extract the response to yield, and prepare the next
        -- iteration of 'unfoldT'.
        unf rq rs = Just (rs ^. i, page rq rs)

        -- For each request, if mr isn't Nothing:
        --    1. send the request
        --    2. unfold the response
        -- Otherwise:
        --    return 'Nothing' to end the machine.
        nr mr =
            case mr of
                Nothing → return Nothing
                Just q → liftAWS $ send q >>= return ∘ unf q

        -- The initial request
        r0 = modRequest ms r
    in
        unfoldT nr (Just r0) >~> asParts

modRequest ∷
    [RequestMod a] → a → a
modRequest [] rq = rq
modRequest (m:ms) rq = modRequest ms $ m rq