module Aws.Lambda.Core
(
LambdaConfiguration(..)
, lcRegion
, lcAccessKeyId
, lcSecretAccessKey
, LambdaQuery(..)
, lambdaQuery
, lambdaQuery'
, lqMethod
, lqPath
, lqParams
, lqBody
, LambdaTransaction(..)
, LambdaPayload(..)
, PagedLambdaTransaction(..)
, InvalidHttpMethodException
, _InvalidHttpMethodException
, InvalidRegionException
, _InvalidRegionException
, pattern InvalidParameterValueException
, pattern ResourceNotFoundException
, pattern ServiceException
) where
import Aws.General
import Aws.Lambda.Internal.Constraints
import Control.Applicative
import Control.Lens
import Control.Lens.Action
import Control.Monad.Catch
import Control.Monad.Trans
import Control.Monad.Unicode
import qualified Data.Aeson as AE
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.Map as M
import Data.Monoid
import Data.Monoid.Unicode
import qualified Data.Text as T
import Data.Typeable
import Network.HTTP.Types
import Network.HTTP.Client
import qualified Network.Wreq as W
import qualified Network.Wreq.Types as WT
import Prelude.Unicode
data LambdaConfiguration
= LambdaConfiguration
{ _lcRegion ∷ !Region
, _lcAccessKeyId ∷ !B.ByteString
, _lcSecretAccessKey ∷ !B.ByteString
} deriving (Eq, Show)
makeLenses ''LambdaConfiguration
lambdaOptions
∷ LambdaConfiguration
→ W.Options
→ W.Options
lambdaOptions lc =
foldr (∘) id $
[ W.auth ?~ W.awsAuth W.AWSv4 (lc ^. lcAccessKeyId) (lc ^. lcSecretAccessKey)
, W.header "Accept" .~ ["application/json"]
]
class LambdaPayload body where
packagePayload
∷ body
→ Σ (WT.Postable ⊗ WT.Putable)
instance LambdaPayload () where
packagePayload () = Pack B.empty
instance LambdaPayload B.ByteString where
packagePayload b = Pack b
instance LambdaPayload AE.Value where
packagePayload x = Pack x
data LambdaQuery body
= LambdaQuery
{ _lqBody ∷ !body
, _lqParams ∷ !(M.Map T.Text T.Text)
, _lqPath ∷ ![T.Text]
, _lqMethod ∷ !StdMethod
} deriving (Eq, Show)
makeLenses ''LambdaQuery
lambdaQuery
∷ Monoid body
⇒ StdMethod
→ [T.Text]
→ LambdaQuery body
lambdaQuery meth p = LambdaQuery
{ _lqMethod = meth
, _lqPath = p
, _lqBody = mempty
, _lqParams = M.empty
}
lambdaQuery'
∷ StdMethod
→ [T.Text]
→ body
→ LambdaQuery body
lambdaQuery' meth p b = LambdaQuery
{ _lqMethod = meth
, _lqPath = p
, _lqBody = b
, _lqParams = M.empty
}
newtype InvalidRegionException
= InvalidRegionException
{ _ireRegion ∷ Region
} deriving (Eq, Show, Typeable)
instance Exception InvalidRegionException
makePrisms ''InvalidRegionException
lambdaEndpointUrl
∷ MonadThrow m
⇒ Region
→ [T.Text]
→ m String
lambdaEndpointUrl r e = do
subdomain ← case r of
UsWest2 → return "us-west-2"
UsEast1 → return "us-east-1"
EuWest1 → return "eu-west-1"
_ → throwM $ InvalidRegionException r
return $
"https://lambda." ⊕ subdomain ⊕ ".amazonaws.com/2014-11-13/" ⊕ (T.unpack $ T.intercalate "/" e)
liftThrow
∷ ( MonadThrow m
, MonadIO m
)
⇒ IO α
→ m α
liftThrow m = do
either throwM return =≪ do
liftIO $ catch
(fmap Right m)
(\(e ∷ SomeException) → return $ Left e)
newtype InvalidHttpMethodException
= InvalidHttpMethodException
{ _ihmeMethod ∷ StdMethod
} deriving (Eq, Show, Typeable)
instance Exception InvalidHttpMethodException
makePrisms ''InvalidHttpMethodException
pattern InvalidParameterValueException msg
← StatusCodeException (Status 400 msg) _ _
pattern ResourceNotFoundException msg
← StatusCodeException (Status 400 msg) _ _
pattern ServiceException msg
← StatusCodeException (Status 500 msg) _ _
asJSON'
∷ ( MonadThrow m
, MonadCatch m
, AE.FromJSON α
)
⇒ Response LB.ByteString
→ m (Response α)
asJSON' resp =
catch (W.asJSON resp) $ \(_ ∷ WT.JSONError) → do
W.asJSON resp { responseBody = "{}" }
class (LambdaPayload body, AE.FromJSON resp) ⇒ LambdaTransaction req body resp | req → resp body, resp → req where
buildQuery
∷ req
→ LambdaQuery body
runLambda
∷ ( MonadThrow m
, MonadCatch m
, MonadIO m
)
⇒ LambdaConfiguration
→ req
→ m resp
runLambda cfg req = do
let query = buildQuery req
opts = lambdaOptions cfg W.defaults
& W.params <>~ query ^. lqParams ∘ to M.toList
body = query ^. lqBody ∘ to packagePayload
url ← lambdaEndpointUrl (cfg ^. lcRegion) (query ^. lqPath)
spread body $ \payload → do
resp ← case query ^. lqMethod of
GET → liftThrow $ W.getWith opts url
POST → liftThrow $ W.postWith opts url payload
PUT → liftThrow $ W.putWith opts url payload
DELETE → liftThrow $ W.deleteWith opts url
meth → throwM $ InvalidHttpMethodException meth
resp ^! act asJSON' ∘ W.responseBody
class (LambdaTransaction req body resp, Monoid acc) ⇒ PagedLambdaTransaction req body resp cur acc | req → resp cur acc where
requestCursor ∷ Setter' req (Maybe cur)
responseCursor ∷ Getter resp (Maybe cur)
responseAccum ∷ Getter resp acc
pagedRunLambda
∷ ( MonadThrow m
, MonadCatch m
, MonadIO m
, Functor m
)
⇒ LambdaConfiguration
→ req
→ m acc
pagedRunLambda cfg req = do
resp ← runLambda cfg req
case resp ^. responseCursor of
Just cur →
mappend (resp ^. responseAccum)
<$> pagedRunLambda cfg (req & requestCursor ?~ cur)
Nothing →
return $
resp ^. responseAccum