module Aws.Lambda.Runtime.API.Endpoints
  ( response,
    invocationError,
    runtimeInitError,
    nextInvocation,
    Endpoint (..),
  )
where

import qualified Aws.Lambda.Runtime.API.Version as Version
import Data.Text (Text)

newtype Endpoint
  = Endpoint Text
  deriving (Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
(Int -> Endpoint -> ShowS)
-> (Endpoint -> String) -> ([Endpoint] -> ShowS) -> Show Endpoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Show)

-- | Endpoint that provides the ID of the next invocation
nextInvocation :: Text -> Endpoint
nextInvocation :: Text -> Endpoint
nextInvocation Text
lambdaApi =
  Text -> Endpoint
Endpoint (Text -> Endpoint) -> Text -> Endpoint
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"http://",
        Text
lambdaApi,
        Text
"/",
        Text
Version.value,
        Text
"/runtime/invocation/next"
      ]

-- | Where the response of the Lambda gets published
response :: Text -> Text -> Endpoint
response :: Text -> Text -> Endpoint
response Text
lambdaApi Text
requestId =
  Text -> Endpoint
Endpoint (Text -> Endpoint) -> Text -> Endpoint
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"http://",
        Text
lambdaApi,
        Text
"/",
        Text
Version.value,
        Text
"/runtime/invocation/",
        Text
requestId,
        Text
"/response"
      ]

-- | Invocation (runtime) errors should be published here
invocationError :: Text -> Text -> Endpoint
invocationError :: Text -> Text -> Endpoint
invocationError Text
lambdaApi Text
requestId =
  Text -> Endpoint
Endpoint (Text -> Endpoint) -> Text -> Endpoint
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"http://",
        Text
lambdaApi,
        Text
"/",
        Text
Version.value,
        Text
"/runtime/invocation/",
        Text
requestId,
        Text
"/error"
      ]

-- | Runtime initialization errors should go here
runtimeInitError :: Text -> Endpoint
runtimeInitError :: Text -> Endpoint
runtimeInitError Text
lambdaApi =
  Text -> Endpoint
Endpoint (Text -> Endpoint) -> Text -> Endpoint
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"http://",
        Text
lambdaApi,
        Text
"/",
        Text
Version.value,
        Text
"/runtime/init/error"
      ]