module Aws.Lambda.Runtime.ApiInfo
  ( Event (..),
    fetchEvent,
  )
where

import qualified Aws.Lambda.Runtime.API.Endpoints as Endpoints
import qualified Aws.Lambda.Runtime.Error as Error
import Control.Exception (IOException)
import Control.Exception.Safe.Checked
import qualified Control.Monad as Monad
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as ByteString
import qualified Data.ByteString.Lazy.Char8 as Lazy
import Data.Text (Text, pack)
import qualified Data.Text as Text
import qualified Network.HTTP.Client as Http
import qualified Network.HTTP.Types.Header as Http
import qualified Text.Read as Read

-- | Event that is fetched out of the AWS Lambda API
data Event = Event
  { Event -> Int
deadlineMs :: !Int,
    Event -> Text
traceId :: !Text,
    Event -> Text
awsRequestId :: !Text,
    Event -> Text
invokedFunctionArn :: !Text,
    Event -> ByteString
event :: !Lazy.ByteString
  }
  deriving (Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Event] -> ShowS
$cshowList :: [Event] -> ShowS
show :: Event -> String
$cshow :: Event -> String
showsPrec :: Int -> Event -> ShowS
$cshowsPrec :: Int -> Event -> ShowS
Show)

-- | Performs a GET to the endpoint that provides the next event
fetchEvent :: Throws Error.Parsing => Http.Manager -> Text -> IO Event
fetchEvent :: Throws Parsing => Manager -> Text -> IO Event
fetchEvent Manager
manager Text
lambdaApi = do
  Response ByteString
response <- Manager -> Text -> IO (Response ByteString)
fetchApiData Manager
manager Text
lambdaApi
  let body :: ByteString
body = forall body. Response body -> body
Http.responseBody Response ByteString
response
      headers :: ResponseHeaders
headers = forall body. Response body -> ResponseHeaders
Http.responseHeaders Response ByteString
response
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Monad.foldM Throws Parsing => Event -> (HeaderName, ByteString) -> IO Event
reduceEvent (ByteString -> Event
initialEvent ByteString
body) ResponseHeaders
headers

fetchApiData :: Http.Manager -> Text -> IO (Http.Response Lazy.ByteString)
fetchApiData :: Manager -> Text -> IO (Response ByteString)
fetchApiData Manager
manager Text
lambdaApi = do
  let Endpoints.Endpoint Text
endpoint = Text -> Endpoint
Endpoints.nextInvocation Text
lambdaApi
  Request
request <- forall (m :: * -> *). MonadThrow m => String -> m Request
Http.parseRequest forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ Text
endpoint
  IO (Response ByteString) -> IO (Response ByteString)
keepRetrying forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
Http.httpLbs Request
request Manager
manager

reduceEvent :: Throws Error.Parsing => Event -> (Http.HeaderName, ByteString) -> IO Event
reduceEvent :: Throws Parsing => Event -> (HeaderName, ByteString) -> IO Event
reduceEvent Event
event (HeaderName, ByteString)
header =
  case (HeaderName, ByteString)
header of
    (HeaderName
"Lambda-Runtime-Deadline-Ms", ByteString
value) ->
      case forall a. Read a => String -> Maybe a
Read.readMaybe forall a b. (a -> b) -> a -> b
$ ByteString -> String
ByteString.unpack ByteString
value of
        Just Int
ms -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
event {deadlineMs :: Int
deadlineMs = Int
ms}
        Maybe Int
Nothing -> forall (m :: * -> *) e a.
(MonadThrow m, Exception e, Throws e) =>
e -> m a
throw (Text -> Text -> Text -> Parsing
Error.Parsing Text
"Could not parse deadlineMs." (String -> Text
pack forall a b. (a -> b) -> a -> b
$ ByteString -> String
ByteString.unpack ByteString
value) Text
"deadlineMs")
    (HeaderName
"Lambda-Runtime-Trace-Id", ByteString
value) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
event {traceId :: Text
traceId = String -> Text
pack forall a b. (a -> b) -> a -> b
$ ByteString -> String
ByteString.unpack ByteString
value}
    (HeaderName
"Lambda-Runtime-Aws-Request-Id", ByteString
value) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
event {awsRequestId :: Text
awsRequestId = String -> Text
pack forall a b. (a -> b) -> a -> b
$ ByteString -> String
ByteString.unpack ByteString
value}
    (HeaderName
"Lambda-Runtime-Invoked-Function-Arn", ByteString
value) ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
event {invokedFunctionArn :: Text
invokedFunctionArn = String -> Text
pack forall a b. (a -> b) -> a -> b
$ ByteString -> String
ByteString.unpack ByteString
value}
    (HeaderName, ByteString)
_ ->
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Event
event

initialEvent :: Lazy.ByteString -> Event
initialEvent :: ByteString -> Event
initialEvent ByteString
body =
  Event
    { deadlineMs :: Int
deadlineMs = Int
0,
      traceId :: Text
traceId = Text
"",
      awsRequestId :: Text
awsRequestId = Text
"",
      invokedFunctionArn :: Text
invokedFunctionArn = Text
"",
      event :: ByteString
event = ByteString
body
    }

keepRetrying :: IO (Http.Response Lazy.ByteString) -> IO (Http.Response Lazy.ByteString)
keepRetrying :: IO (Response ByteString) -> IO (Response ByteString)
keepRetrying IO (Response ByteString)
action = do
  Either IOException (Response ByteString)
result <- forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(Throws e => m a) -> m (Either e a)
try IO (Response ByteString)
action :: IO (Either IOException (Http.Response Lazy.ByteString))
  case Either IOException (Response ByteString)
result of
    Right Response ByteString
success -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Response ByteString
success
    Either IOException (Response ByteString)
_ -> IO (Response ByteString) -> IO (Response ByteString)
keepRetrying IO (Response ByteString)
action