{-# 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 = [ByteString] -> ByteString
forall a. [a] -> a
head ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> Response Value -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
"Lambda-Runtime-Aws-Request-Id" Response Value
nextRes

    eCtx :: Either String LambdaContext
eCtx = (String -> String)
-> Either String LambdaContext -> Either String LambdaContext
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" String -> String -> String
forall a. Semigroup a => a -> a -> a
<>) (Either String LambdaContext -> Either String LambdaContext)
-> Either String LambdaContext -> Either String LambdaContext
forall a b. (a -> b) -> a -> b
$ do
      Text
traceId <- (ByteString -> Text)
-> Either String ByteString -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (Either String ByteString -> Either String Text)
-> Either String ByteString -> Either String Text
forall a b. (a -> b) -> a -> b
$ HeaderName -> Response Value -> Either String ByteString
exactlyOneHeader HeaderName
"Lambda-Runtime-Trace-Id" Response Value
nextRes
      Text
functionArn <- (ByteString -> Text)
-> Either String ByteString -> Either String Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (Either String ByteString -> Either String Text)
-> Either String ByteString -> Either String Text
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 <- String -> Maybe Double -> Either String Double
forall b a. b -> Maybe a -> Either b a
maybeToEither String
"Could not parse deadline" (Maybe Double -> Either String Double)
-> Maybe Double -> Either String Double
forall a b. (a -> b) -> a -> b
$ String -> Maybe Double
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Double) -> String -> Maybe Double
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BSC.unpack ByteString
deadlineHeader
      let deadline :: UTCTime
deadline = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Double -> POSIXTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Double -> POSIXTime) -> Double -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Double
milliseconds Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000

      Maybe ClientContext
clientContext <- HeaderName -> Response Value -> Either String (Maybe ClientContext)
forall a.
FromJSON a =>
HeaderName -> Response Value -> Either String (Maybe a)
decodeOptionalHeader HeaderName
"Lambda-Runtime-Client-Context" Response Value
nextRes
      Maybe CognitoIdentity
identity <- HeaderName
-> Response Value -> Either String (Maybe CognitoIdentity)
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
      LambdaContext -> Either String 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, Response Value -> Value
forall a. Response a -> a
getResponseBody Response Value
nextRes, Either String LambdaContext
eCtx)


-- Helpers (mostly) for Headers

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

getResponseHeader :: HeaderName -> Response a -> [BS.ByteString]
getResponseHeader :: HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
headerName = ((HeaderName, ByteString) -> ByteString)
-> [(HeaderName, ByteString)] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (HeaderName, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ([(HeaderName, ByteString)] -> [ByteString])
-> (Response a -> [(HeaderName, ByteString)])
-> Response a
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((HeaderName, ByteString) -> Bool)
-> [(HeaderName, ByteString)] -> [(HeaderName, ByteString)]
forall a. (a -> Bool) -> [a] -> [a]
filter (HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
(==) HeaderName
headerName (HeaderName -> Bool)
-> ((HeaderName, ByteString) -> HeaderName)
-> (HeaderName, ByteString)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderName, ByteString) -> HeaderName
forall a b. (a, b) -> a
fst) ([(HeaderName, ByteString)] -> [(HeaderName, ByteString)])
-> (Response a -> [(HeaderName, ByteString)])
-> Response a
-> [(HeaderName, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response a -> [(HeaderName, ByteString)]
forall body. Response body -> [(HeaderName, ByteString)]
responseHeaders

headerNameToString :: HeaderName -> String
headerNameToString :: HeaderName -> String
headerNameToString = (Word8 -> Char) -> [Word8] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Char
BSI.w2c ([Word8] -> String)
-> (HeaderName -> [Word8]) -> HeaderName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
BS.unpack (ByteString -> [Word8])
-> (HeaderName -> ByteString) -> HeaderName -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HeaderName -> ByteString
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 HeaderName -> Response Value -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
name Response Value
res of
    [ByteString
a] -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
a
    [] -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String
"Missing response header " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nameStr)
    [ByteString]
_ ->  String -> Either String ByteString
forall a b. a -> Either a b
Left (String
"Too many values for header " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nameStr)

maybeToEither :: b -> Maybe a -> Either b a
maybeToEither :: b -> Maybe a -> Either b a
maybeToEither b
b Maybe a
ma = case Maybe a
ma of
  Maybe a
Nothing -> b -> Either b a
forall a b. a -> Either a b
Left b
b
  Just a
a -> a -> Either b a
forall a b. b -> Either a b
Right a
a

-- Note: Does not allow whitespace
readMaybe :: (Read a) => String -> Maybe a
readMaybe :: String -> Maybe a
readMaybe String
s = case ReadS a
forall a. Read a => ReadS a
reads String
s of
  [(a
x,String
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  [(a, String)]
_ -> Maybe a
forall a. Maybe a
Nothing

-- TODO: There must be a better way to do this
decodeHeaderValue :: FromJSON a => BSC.ByteString -> Either String a
decodeHeaderValue :: ByteString -> Either String a
decodeHeaderValue = ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
eitherDecode (ByteString -> Either String a)
-> (ByteString -> ByteString) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BSW.pack ([Word8] -> ByteString)
-> (ByteString -> [Word8]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> String -> [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Word8
BSI.c2w (String -> [Word8])
-> (ByteString -> String) -> ByteString -> [Word8]
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 :: HeaderName -> Response Value -> Either String (Maybe a)
decodeOptionalHeader HeaderName
name Response Value
res =
  let nameStr :: String
nameStr = HeaderName -> String
headerNameToString HeaderName
name
  in case HeaderName -> Response Value -> [ByteString]
forall a. HeaderName -> Response a -> [ByteString]
getResponseHeader HeaderName
name Response Value
res of
    [] -> Maybe a -> Either String (Maybe a)
forall a b. b -> Either a b
Right Maybe a
forall a. Maybe a
Nothing
    [ByteString
x] -> (String -> String)
-> Either String (Maybe a) -> Either String (Maybe a)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\String
e -> String
"Could not JSON decode header " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nameStr String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
e) (Either String (Maybe a) -> Either String (Maybe a))
-> Either String (Maybe a) -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ (a -> Maybe a) -> Either String a -> Either String (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Either String (Maybe a))
-> Either String a -> Either String (Maybe a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String a
forall a. FromJSON a => ByteString -> Either String a
decodeHeaderValue ByteString
x
    [ByteString]
_ -> String -> Either String (Maybe a)
forall a b. a -> Either a b
Left (String
"Too many values for header " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
nameStr)