infernal 0.5.0 → 0.6.0
raw patch · 2 files changed
+53/−48 lines, 2 filesdep ~aesondep ~binarydep ~bytestring
Dependency ranges changed: aeson, binary, bytestring, case-insensitive, exceptions, hashable, http-client, http-types, little-logger, little-rio, microlens, microlens-mtl, microlens-th, mtl, text, unliftio-core, unordered-containers, wai
Files
- infernal.cabal +20/−20
- src/Infernal.hs +33/−28
infernal.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3e72ee8a176a23ff4e8b2e60f739ffe4798421d4f70cbd236dc7c34e7e953d2d+-- hash: 2f7de139b6f352da06ebe337ff14d48d201042872514dfcc65bc781b9071972e name: infernal-version: 0.5.0+version: 0.6.0 synopsis: The Infernal Machine - An AWS Lambda Custom Runtime for Haskell description: Please see the README on GitHub at <https://github.com/ejconlon/infernal#readme> category: AWS@@ -36,23 +36,23 @@ default-extensions: ConstraintKinds DeriveFunctor DeriveFoldable DeriveGeneric DeriveTraversable DerivingStrategies GeneralizedNewtypeDeriving NoImplicitPrelude OverloadedStrings Rank2Types TemplateHaskell ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wpartial-fields -Wredundant-constraints -fno-warn-unused-top-binds -fno-warn-warnings-deprecations build-depends:- aeson >=1.4+ aeson >=1.5 && <1.6 , base >=4.12 && <5- , binary >=0.8- , bytestring >=0.10- , case-insensitive >=1.2- , exceptions >=0.10- , hashable >=1.3- , http-client >=0.6- , http-types >=0.12- , little-logger >=0.1- , little-rio >=0.1- , microlens >=0.4- , microlens-mtl >=0.2- , microlens-th >=0.4- , mtl >=2.2- , text >=1.2- , unliftio-core >=0.1- , unordered-containers >=0.2- , wai >=3.2+ , binary >=0.8 && <0.9+ , bytestring >=0.10 && <0.11+ , case-insensitive >=1.2 && <1.3+ , exceptions >=0.10 && <0.11+ , hashable >=1.3 && <1.4+ , http-client >=0.6 && <0.7+ , http-types >=0.12 && <0.13+ , little-logger >=0.3 && <0.4+ , little-rio >=0.2 && <0.3+ , microlens >=0.4 && <0.5+ , microlens-mtl >=0.2 && <0.3+ , microlens-th >=0.4 && <0.5+ , mtl >=2.2 && <2.3+ , text >=1.2 && <1.3+ , unliftio-core >=0.2 && <0.3+ , unordered-containers >=0.2 && <0.3+ , wai >=3.2 && <3.3 default-language: Haskell2010
src/Infernal.hs view
@@ -42,8 +42,8 @@ import Lens.Micro (Lens') import Lens.Micro.Mtl (view) import Lens.Micro.TH (makeLenses)-import LittleLogger (HasSimpleLog (..), LogApp, SimpleLogAction, WithSimpleLog, logDebug, logError, logException,- newLogApp)+import LittleLogger (HasSimpleLog (..), SimpleLogAction, WithSimpleLog, defaultSimpleLogAction, logDebug, logError,+ logException) import LittleRIO (RIO, runRIO, unliftRIO) import qualified Network.HTTP.Client as HC import qualified Network.HTTP.Types as HT@@ -53,24 +53,30 @@ import System.IO (BufferMode (LineBuffering), hSetBuffering, stderr, stdout) import Text.Read (readMaybe) +class ToText a where+ toText :: a -> Text++instance ToText Text where+ toText = id+ -- | The UUID associated with a Lambda request. newtype LambdaRequestId = LambdaRequestId { _unLambdaRequestId :: Text- } deriving newtype (Eq, Show, Ord, IsString, Hashable)+ } deriving newtype (Eq, Show, Ord, IsString, Hashable, ToText) -- | The request parsed from the "next invocation" API (<https://docs.aws.amazon.com/lambda/latest/dg/runtimes-api.html#runtimes-api-next docs>) data LambdaRequest = LambdaRequest- { _lreqId :: !LambdaRequestId -- ^ From the @Lambda-Runtime-Aws-Request-Id@ header- , _lreqTraceId :: !Text -- ^ From the @Lambda-Runtime-Trace-Id@ header- , _lreqFunctionArn :: !Text -- ^ From the @Lambda-Runtime-Invoked-Function-Arn@ header- , _lreqDeadlineMs :: !Int -- ^ From the @Lambda-Runtime-Deadline-Ms@ header, an epoch deadline in ms- , _lreqBody :: !LBS.ByteString -- ^ The unparsed request body. Typically you will 'Data.Aeson.decode' this.+ { _lreqId :: !LambdaRequestId -- ^ From the @Lambda-Runtime-Aws-Request-Id@ header+ , _lreqTraceId :: !(Maybe Text) -- ^ From the @Lambda-Runtime-Trace-Id@ header+ , _lreqFunctionArn :: !(Maybe Text) -- ^ From the @Lambda-Runtime-Invoked-Function-Arn@ header+ , _lreqDeadlineMs :: !Int -- ^ From the @Lambda-Runtime-Deadline-Ms@ header, an epoch deadline in ms+ , _lreqBody :: !LBS.ByteString -- ^ The unparsed request body. Typically you will 'Data.Aeson.decode' this. } deriving stock (Eq, Show) -- | A response to the 'LambdaRequest', typically as encoded JSON. newtype LambdaResponse = LambdaResponse { _unLambdaResponse :: LBS.ByteString- } deriving (Eq, Show, Ord, IsString, Hashable)+ } deriving newtype (Eq, Show, Ord, IsString, Hashable) -- | An error formatted to propagate to AWS (<https://docs.aws.amazon.com/lambda/latest/dg/runtimes-api.html#runtimes-api-invokeerror docs>). -- Note that this is an 'Exception' so you can throw it to short-circuit processing and report useful information. By default, if you throw@@ -184,19 +190,19 @@ handleInvokeError :: WithSimpleLog env m => PostLambdaInvokeError m -> UnliftIO n -> InvokeErrorCallback n -> LambdaRequest -> SomeException -> m () handleInvokeError postErr unio invokeErrCb lamReq err = do- let lamIdText = _unLambdaRequestId (_lreqId lamReq)- logError ("Caught invocation error for request id " <> lamIdText <> ":")+ let lamReqId = _lreqId lamReq+ logError ("Caught invocation error for request id " <> toText lamReqId <> ":") logException err lamErr <- case castLambdaError err of Just lamErr -> do- logError ("Posting original invocation error for request id " <> lamIdText)+ logError ("Posting original invocation error for request id " <> toText lamReqId) pure lamErr Nothing -> do lamErr <- unliftInto unio (invokeErrCb lamReq err)- logError ("Posting new invocation error for request id " <> lamIdText <> ":")+ logError ("Posting new invocation error for request id " <> toText lamReqId <> ":") logException lamErr pure lamErr- postErr (_lreqId lamReq) lamErr+ postErr lamReqId lamErr guardInvokeError :: (MonadCatch m, WithSimpleLog env m) => PostLambdaInvokeError m -> UnliftIO n -> InvokeErrorCallback n -> LambdaRequest -> m () -> m () guardInvokeError postErr unio invokeErrCb lamReq body = catchRethrowExitCode body (handleInvokeError postErr unio invokeErrCb lamReq)@@ -213,13 +219,12 @@ logDebug "Polling for request" lamReq <- _lcGetLambdaRequest client let lamReqId = _lreqId lamReq- lamIdText = _unLambdaRequestId lamReqId- logDebug ("Servicing request id " <> lamIdText)+ logDebug ("Servicing request id " <> toText lamReqId) guardInvokeError postErr unio invokeErrCb lamReq $ do lamRepBody <- unliftInto unio (runCb lamReq)- logDebug ("Posting response to request id " <> lamIdText)+ logDebug ("Posting response to request id " <> toText lamReqId) postRep lamReqId lamRepBody- logDebug ("Finished request id " <> lamIdText)+ logDebug ("Finished request id " <> toText lamReqId) pollLoop :: (MonadCatch m, WithSimpleLog env m) => LambdaClient m -> UnliftIO n -> CallbackConfig n -> m () pollLoop client unio cbc =@@ -294,17 +299,17 @@ invalidDeadlineError :: Text -> LambdaError invalidDeadlineError deadlineMsText = LambdaError "InvalidDeadlineError" ("Invalid value for deadline: " <> deadlineMsText) +lookupOptionalHeader :: Text -> HT.ResponseHeaders -> Maybe Text+lookupOptionalHeader name = fmap decodeUtf8 . lookup (CI.mk (encodeUtf8 name))+ lookupHeader :: MonadThrow m => Text -> HT.ResponseHeaders -> m Text-lookupHeader name headers =- case lookup (CI.mk (encodeUtf8 name)) headers of- Nothing -> throwM (missingHeaderError name)- Just value -> pure (decodeUtf8 value)+lookupHeader name = maybe (throwM (missingHeaderError name)) pure . lookupOptionalHeader name parseLambdaRequest :: MonadThrow m => HT.ResponseHeaders -> LBS.ByteString -> m LambdaRequest parseLambdaRequest headers body = do reqId <- lookupHeader "Lambda-Runtime-Aws-Request-Id" headers- traceId <- lookupHeader "Lambda-Runtime-Trace-Id" headers- functionArn <- lookupHeader "Lambda-Runtime-Invoked-Function-Arn" headers+ let traceId = lookupOptionalHeader "Lambda-Runtime-Trace-Id" headers+ functionArn = lookupOptionalHeader "Lambda-Runtime-Invoked-Function-Arn" headers deadlineMsText <- lookupHeader "Lambda-Runtime-Deadline-Ms" headers deadlineMs <- case readMaybe (Text.unpack deadlineMsText) of Just value -> pure value@@ -338,10 +343,10 @@ postLambdaInitErrorImpl = postRequest ["init", "error"] . encode postLambdaInvokeErrorImpl :: MonadLambdaImpl env m => PostLambdaInvokeError m-postLambdaInvokeErrorImpl lamReqId = postRequest ["invocation", _unLambdaRequestId lamReqId, "error"] . encode+postLambdaInvokeErrorImpl lamReqId = postRequest ["invocation", toText lamReqId, "error"] . encode postLambdaResponseImpl :: MonadLambdaImpl env m => PostLambdaResponse m-postLambdaResponseImpl lamReqId = postRequest ["invocation", _unLambdaRequestId lamReqId, "response"] . _unLambdaResponse+postLambdaResponseImpl lamReqId = postRequest ["invocation", toText lamReqId, "response"] . _unLambdaResponse lambdaClientImpl :: MonadLambdaImpl env m => LambdaClient m lambdaClientImpl = LambdaClient@@ -394,10 +399,10 @@ -- | A simple entrypoint that delegates to 'runLambda'. Use this as the body of your @main@ function if you want to get a Lambda function up and running quickly. -- All you need to do is provide a 'RunCallback' that handles JSON-encoded requests and returns JSON-encoded responses (or throws 'LambdaError' exceptions). -- Your callback has access to a simple logger (try 'logDebug', for example) whose output will be collected by Lambda and published to CloudWatch.-runSimpleLambda :: RunCallback (RIO LogApp) -> IO ()+runSimpleLambda :: RunCallback (RIO SimpleLogAction) -> IO () runSimpleLambda cb = do hSetBuffering stdout LineBuffering hSetBuffering stderr LineBuffering- let app = newLogApp+ let app = defaultSimpleLogAction unio <- unliftRIO app runRIO app (runLambda unio defaultInitErrorCallback (const (pure (defaultCallbackConfig cb))))