module AWS.Lambda.RuntimeClient (
getBaseRuntimeRequest,
getNextEvent,
sendEventSuccess,
sendEventError,
sendInitError
) where
import Control.Concurrent (threadDelay)
import Control.Exception (displayException, try, throw)
import Data.Aeson (encode)
import Data.Aeson.Types (FromJSON, ToJSON)
import Data.Bifunctor (first)
import qualified Data.ByteString as BS
import GHC.Generics (Generic (..))
import Network.HTTP.Simple (HttpException, JSONException,
Request, Response,
getResponseStatus, httpJSONEither,
httpNoBody, parseRequest,
setRequestBodyJSON,
setRequestBodyLBS,
setRequestCheckStatus,
setRequestHeader, setRequestMethod,
setRequestPath)
import Network.HTTP.Types.Status (status403, status413, statusIsSuccessful)
import System.Environment (getEnv)
data LambdaError = LambdaError
{ errorMessage :: String,
errorType :: String,
stackTrace :: [String]
} deriving (Show, Generic)
instance ToJSON LambdaError
getBaseRuntimeRequest :: IO Request
getBaseRuntimeRequest = do
awsLambdaRuntimeApi <- getEnv "AWS_LAMBDA_RUNTIME_API"
parseRequest $ "http://" ++ awsLambdaRuntimeApi
getNextEvent :: FromJSON a => Request -> IO (Response (Either JSONException a))
getNextEvent baseRuntimeRequest = do
resOrEx <- runtimeClientRetryTry $ httpJSONEither $ toNextEventRequest baseRuntimeRequest
let checkStatus res = if not $ statusIsSuccessful $ getResponseStatus res then
Left "Unexpected Runtime Error: Could not retrieve next event."
else
Right res
let resOrMsg = first (displayException :: HttpException -> String) resOrEx >>= checkStatus
case resOrMsg of
Left msg -> do
_ <- sendInitError baseRuntimeRequest msg
error msg
Right y -> return y
sendEventSuccess :: ToJSON a => Request -> BS.ByteString -> a -> IO ()
sendEventSuccess baseRuntimeRequest reqId json = do
resOrEx <- runtimeClientRetryTry $ httpNoBody $ toEventSuccessRequest reqId json baseRuntimeRequest
let resOrTypedMsg = case resOrEx of
Left ex ->
Left $ Left $ displayException (ex :: HttpException)
Right res ->
if getResponseStatus res == status413 then
Left (Right "Payload Too Large")
else if not $ statusIsSuccessful $ getResponseStatus res then
Left (Left "Unexpected Runtime Error: Could not post handler result.")
else
Right ()
case resOrTypedMsg of
Left (Left msg) ->
sendEventError baseRuntimeRequest reqId msg
Left (Right msg) -> error msg
Right () -> return ()
sendEventError :: Request -> BS.ByteString -> String -> IO ()
sendEventError baseRuntimeRequest reqId e =
fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toEventErrorRequest reqId e baseRuntimeRequest
sendInitError :: Request -> String -> IO ()
sendInitError baseRuntimeRequest e =
fmap (const ()) $ runtimeClientRetry $ httpNoBody $ toInitErrorRequest e baseRuntimeRequest
runtimeClientRetryTry' :: Int -> IO (Response a) -> IO (Either HttpException (Response a))
runtimeClientRetryTry' 1 f = try f
runtimeClientRetryTry' i f = do
resOrEx <- try f
let retry = threadDelay 500 >> runtimeClientRetryTry' (i - 1) f
case resOrEx of
Left (_ :: HttpException) -> retry
Right res ->
if getResponseStatus res == status403 then retry
else return $ Right res
runtimeClientRetryTry :: IO (Response a) -> IO (Either HttpException (Response a))
runtimeClientRetryTry = runtimeClientRetryTry' 3
runtimeClientRetry :: IO (Response a) -> IO (Response a)
runtimeClientRetry = fmap (either throw id) . runtimeClientRetryTry
toNextEventRequest :: Request -> Request
toNextEventRequest = setRequestPath "2018-06-01/runtime/invocation/next"
toEventSuccessRequest :: ToJSON a => BS.ByteString -> a -> Request -> Request
toEventSuccessRequest reqId json =
setRequestBodyJSON json .
setRequestMethod "POST" .
setRequestPath (BS.concat ["2018-06-01/runtime/invocation/", reqId, "/response"])
toBaseErrorRequest :: String -> Request -> Request
toBaseErrorRequest e =
setRequestBodyLBS (encode (LambdaError { errorMessage = e, stackTrace = [], errorType = "User"}))
. setRequestHeader "Content-Type" ["application/vnd.aws.lambda.error+json"]
. setRequestMethod "POST"
. setRequestCheckStatus
toEventErrorRequest :: BS.ByteString -> String -> Request -> Request
toEventErrorRequest reqId e =
setRequestPath (BS.concat ["2018-06-01/runtime/invocation/", reqId, "/error"]) . toBaseErrorRequest e
toInitErrorRequest :: String -> Request -> Request
toInitErrorRequest e =
setRequestPath "2018-06-01/runtime/init/error" . toBaseErrorRequest e