{-# LANGUAGE CPP #-}
{-|
Module      : AWS.Lambda.RuntimeClient.Internal
Description : Internal HTTP related machinery for talking to the AWS Lambda Custom Runtime interface.
Copyright   : (c) Nike, Inc., 2018
License     : BSD3
Maintainer  : nathan.fairhurst@nike.com, fernando.freire@nike.com
Stability   : stable
-}

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 =
  -- If we got an event but our requestId is invalid/missing, there's no hope of meaningful recovery
  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

      -- Build out the Dynamic portion of the Lambda Context
      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

      -- combine our StaticContext and possible DynamicContext into a LambdaContext
      forall (m :: * -> *) a. Monad m => a -> m a
return (StaticContext -> DynamicContext -> LambdaContext
mkContext StaticContext
staticContext DynamicContext
dynCtx)

  -- Return the interesting components
  in (ByteString
reqIdBS, forall a. Response a -> a
getResponseBody Response Value
nextRes, Either String LambdaContext
eCtx)


-- Helpers (mostly) for Headers

getResponseBody :: Response a -> a
getResponseBody :: forall a. Response a -> a
getResponseBody = forall a. Response a -> a
responseBody

getResponseHeader :: HeaderName -> Response a -> [BS.ByteString]
getResponseHeader :: forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader 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
headerNameToString :: HeaderName -> String
headerNameToString = 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
exactlyOneHeader :: HeaderName -> Response Value -> Either String ByteString
exactlyOneHeader 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

-- Note: Does not allow whitespace
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

-- TODO: There must be a better way to do this
decodeHeaderValue :: FromJSON a => BSC.ByteString -> Either String a
decodeHeaderValue :: forall a. FromJSON a => ByteString -> Either String a
decodeHeaderValue = 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

-- An empty array means we successfully decoded, but nothing was there
-- If we have exactly one element, our outer maybe signals successful decode,
--   and our inner maybe signals that there was content sent
-- If we had more than one header value, the event was invalid
decodeOptionalHeader :: FromJSON a => HeaderName -> Response Value -> Either String (Maybe a)
decodeOptionalHeader :: forall a.
FromJSON a =>
HeaderName -> Response Value -> Either String (Maybe a)
decodeOptionalHeader 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)