{-# LANGUAGE CPP #-}
module AWS.Lambda.RuntimeClient.Internal (
eventResponseToNextData,
) where
import AWS.Lambda.Context (LambdaContext)
import AWS.Lambda.Internal (DynamicContext (..), StaticContext,
mkContext)
import Data.Aeson (Value, eitherDecode)
import Data.Aeson.Types (FromJSON)
import Data.Bifunctor (first)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as BSC
import qualified Data.ByteString.Internal as BSI
import qualified Data.ByteString.Lazy as BSW
import Data.CaseInsensitive (original)
#if !MIN_VERSION_base(4,11,0)
import Data.Semigroup ((<>))
#endif
import Data.Text.Encoding (decodeUtf8)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Network.HTTP.Client (Response, responseBody,
responseHeaders)
import Network.HTTP.Types (HeaderName)
eventResponseToNextData :: StaticContext -> Response Value -> (BS.ByteString, Value, Either String LambdaContext)
eventResponseToNextData :: StaticContext
-> Response Value
-> (ByteString, Value, Either String LambdaContext)
eventResponseToNextData StaticContext
staticContext Response Value
nextRes =
let
reqIdBS :: ByteString
reqIdBS = forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$ forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Aws-Request-Id" Response Value
nextRes
eCtx :: Either String LambdaContext
eCtx = forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String
"Runtime Error: Unable to decode Context from event response.\n" forall a. Semigroup a => a -> a -> a
<>) forall a b. (a -> b) -> a -> b
$ do
Text
traceId <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ HeaderName -> Response Value -> Either String ByteString
exactlyOneHeader HeaderName
"Lambda-Runtime-Trace-Id" Response Value
nextRes
Text
functionArn <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 forall a b. (a -> b) -> a -> b
$ HeaderName -> Response Value -> Either String ByteString
exactlyOneHeader HeaderName
"Lambda-Runtime-Invoked-Function-Arn" Response Value
nextRes
ByteString
deadlineHeader <- HeaderName -> Response Value -> Either String ByteString
exactlyOneHeader HeaderName
"Lambda-Runtime-Deadline-Ms" Response Value
nextRes
Double
milliseconds :: Double <- forall b a. b -> Maybe a -> Either b a
maybeToEither String
"Could not parse deadline" forall a b. (a -> b) -> a -> b
$ forall a. Read a => String -> Maybe a
readMaybe forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
deadlineHeader
let deadline :: UTCTime
deadline = POSIXTime -> UTCTime
posixSecondsToUTCTime forall a b. (a -> b) -> a -> b
$ forall a b. (Real a, Fractional b) => a -> b
realToFrac forall a b. (a -> b) -> a -> b
$ Double
milliseconds forall a. Fractional a => a -> a -> a
/ Double
1000
Maybe ClientContext
clientContext <- forall a.
FromJSON a =>
HeaderName -> Response Value -> Either String (Maybe a)
decodeOptionalHeader HeaderName
"Lambda-Runtime-Client-Context" Response Value
nextRes
Maybe CognitoIdentity
identity <- forall a.
FromJSON a =>
HeaderName -> Response Value -> Either String (Maybe a)
decodeOptionalHeader HeaderName
"Lambda-Runtime-Cognito-Identity" Response Value
nextRes
let dynCtx :: DynamicContext
dynCtx = Text
-> Text
-> Text
-> UTCTime
-> Maybe ClientContext
-> Maybe CognitoIdentity
-> DynamicContext
DynamicContext (ByteString -> Text
decodeUtf8 ByteString
reqIdBS) Text
functionArn Text
traceId UTCTime
deadline Maybe ClientContext
clientContext Maybe CognitoIdentity
identity
forall (m :: * -> *) a. Monad m => a -> m a
return (StaticContext -> DynamicContext -> LambdaContext
mkContext StaticContext
staticContext DynamicContext
dynCtx)
in (ByteString
reqIdBS, forall a. Response a -> a
getResponseBody Response Value
nextRes, Either String LambdaContext
eCtx)
getResponseBody :: Response a -> a
getResponseBody :: forall a. Response a -> a
getResponseBody = forall a. Response a -> a
responseBody
getResponseHeader :: HeaderName -> Response a -> [BS.ByteString]
HeaderName
headerName = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
(==) HeaderName
headerName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders
headerNameToString :: HeaderName -> String
= forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
BSI.w2c forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s. CI s -> s
original
exactlyOneHeader :: HeaderName -> Response Value -> Either String BS.ByteString
HeaderName
name Response Value
res =
let nameStr :: String
nameStr = HeaderName -> String
headerNameToString HeaderName
name
in case forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
name Response Value
res of
[ByteString
a] -> forall a b. b -> Either a b
Right ByteString
a
[] -> forall a b. a -> Either a b
Left (String
"Missing response header " forall a. Semigroup a => a -> a -> a
<> String
nameStr)
[ByteString]
_ -> forall a b. a -> Either a b
Left (String
"Too many values for header " forall a. Semigroup a => a -> a -> a
<> String
nameStr)
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither :: forall b a. b -> Maybe a -> Either b a
maybeToEither b
b Maybe a
ma = case Maybe a
ma of
Maybe a
Nothing -> forall a b. a -> Either a b
Left b
b
Just a
a -> forall a b. b -> Either a b
Right a
a
readMaybe :: (Read a) => String -> Maybe a
readMaybe :: forall a. Read a => String -> Maybe a
readMaybe String
s = case forall a. Read a => ReadS a
reads String
s of
[(a
x,String
"")] -> forall a. a -> Maybe a
Just a
x
[(a, String)]
_ -> forall a. Maybe a
Nothing
decodeHeaderValue :: FromJSON a => BSC.ByteString -> Either String a
= forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BSW.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
BSI.c2w forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BSC.unpack
decodeOptionalHeader :: FromJSON a => HeaderName -> Response Value -> Either String (Maybe a)
HeaderName
name Response Value
res =
let nameStr :: String
nameStr = HeaderName -> String
headerNameToString HeaderName
name
in case forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
name Response Value
res of
[] -> forall a b. b -> Either a b
Right forall a. Maybe a
Nothing
[ByteString
x] -> forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
e -> String
"Could not JSON decode header " forall a. Semigroup a => a -> a -> a
<> String
nameStr forall a. Semigroup a => a -> a -> a
<> String
": " forall a. Semigroup a => a -> a -> a
<> String
e) forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
decodeHeaderValue ByteString
x
[ByteString]
_ -> forall a b. a -> Either a b
Left (String
"Too many values for header " forall a. Semigroup a => a -> a -> a
<> String
nameStr)