diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for AWS-LARPI + +## 0.1.0.0 -- 2021-01-25 + +* First version. Released on an unsuspecting world. diff --git a/Dockerfile b/Dockerfile new file mode 100644 --- /dev/null +++ b/Dockerfile @@ -0,0 +1,36 @@ +FROM frolvlad/alpine-ghc as build +# install build tools +# cache dependencies +# build +RUN apk add cabal wget zlib zlib-dev +RUN mkdir /cabal-build +RUN mkdir /cabal-bins +RUN cabal update +RUN cabal install --global req warp + +ADD aws-larpi.cabal . +ADD LICENSE . +ADD CHANGELOG.md . +ADD Dockerfile . +ADD src/ src/ + +RUN cabal build --builddir=/cabal-build --enable-static --enable-executable-static aws-larpi + +ARG PKG=test + +ADD $PKG/$PKG.cabal $PKG/ +RUN cabal build --builddir=/cabal-build --enable-static --enable-executable-static --only-dependencies $PKG +ADD $PKG/ $PKG/ + +RUN cabal install --builddir=/cabal-build --installdir=/cabal-bins --install-method=copy\ + --enable-static --enable-executable-static $PKG + +# copy artifacts to a clean image +FROM alpine +RUN apk add libffi gmp zlib zlib-dev +ADD https://github.com/aws/aws-lambda-runtime-interface-emulator/releases/latest/download/aws-lambda-rie /usr/bin/aws-lambda-rie +RUN chmod 755 /usr/bin/aws-lambda-rie +COPY entry.sh / +RUN chmod 755 /entry.sh +COPY --from=build /cabal-bins /cabal-bins +ENTRYPOINT [ "/entry.sh" ] diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +MIT License + +Copyright (c) 2021 Matthías Páll Gissurarson + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/aws-larpi.cabal b/aws-larpi.cabal new file mode 100644 --- /dev/null +++ b/aws-larpi.cabal @@ -0,0 +1,41 @@ +cabal-version: >=1.10 +-- Initial package description 'AWS-LARPI.cabal' generated by 'cabal init'. +-- For further documentation, see http://haskell.org/cabal/users-guide/ + +name: aws-larpi +version: 0.1.0.0 +synopsis: Package Haskell functions for easy use on AWS Lambda. +description: The AWS LARPI package allows you to run Haskell code on AWS + by defining a simple request handler for AWS Lambda requests, and then + packaging it using the Dockerfile included. Uses the + . +-- bug-reports: +license: MIT +license-file: LICENSE +author: Matthías Páll Gissurarson +maintainer: mpg@mpg.is +-- copyright: +category: AWS +homepage: https://github.com/Tritlo/AWS-LARPI +build-type: Simple +extra-source-files: CHANGELOG.md, + Dockerfile + +tested-with: GHC == 8.8.3 + +source-repository head + type: git + location: git://github.com/Tritlo/AWS-LARPI.git + +library + hs-source-dirs: src/ + exposed-modules: AWS.LARPI + -- other-extensions: + build-depends: base >=4.13 && <4.14, + req >= 3.8 && < 3.9, + bytestring >= 0.9 && < 0.11, + text >= 1.2 && < 1.3, + modern-uri >= 0.3 && < 0.4, + aeson >= 1.5 && < 1.6 + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/src/AWS/LARPI.hs b/src/AWS/LARPI.hs new file mode 100644 --- /dev/null +++ b/src/AWS/LARPI.hs @@ -0,0 +1,200 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} +{-# LANGUAGE RankNTypes, ExistentialQuantification #-} + +-- | The AWS.LARPI library defines the interface and the associated data types +-- for running a Haskell program directly on AWS Lambda, and handles most of +-- associated overheads, leaving the user free to focus on the functionality +-- itself. +module AWS.LARPI ( + runLambdaInterface, + + LambdaInterface(..), LambdaInvocation(..), LambdaError(..) + +) where + + +import System.Environment + +import Network.HTTP.Req +import Text.URI + +import Data.ByteString.Char8 (ByteString) +import qualified Data.ByteString.Char8 as B +import qualified Data.ByteString.Lazy as BL + +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +import Data.Maybe + +import Data.Aeson +import GHC.Generics + +import Control.Monad (when) + + +-- CONSTANTS +version :: Text +version = "2018-06-01" + +invPath :: Url 'Http -> Url 'Http +invPath api = api /~ version /: "runtime" /: "invocation" + +errHeader :: Option 'Http +errHeader = header "Lambda-Runtime-Function-Error-Type" "Unhandled" + + +data Config = Conf { c_base :: Url 'Http + , c_opts :: Option 'Http } + + + +invocationResponse :: Config -> Text -> ByteString -> IO () +invocationResponse Conf{..} req_id resp = + runReq defaultHttpConfig $ do + req POST + (invPath c_base /: req_id /: "response" ) + (ReqBodyBs resp) + ignoreResponse + c_opts + return () + + +invocationError :: Config -> Text -> LambdaError -> IO () +invocationError Conf{..} req_id lerr = + runReq defaultHttpConfig $ do + res <- req POST + (invPath c_base /: req_id /: "error" ) + (ReqBodyJson lerr) + ignoreResponse + (c_opts <> errHeader) + return () + +initializationError :: Config -> LambdaError -> IO () +initializationError Conf{..} lerr = + runReq defaultHttpConfig $ do + res <- req POST + (c_base /~ version /: "runtime" /: "init" /: "error" ) + (ReqBodyJson lerr) + ignoreResponse + (c_opts <> errHeader) + return () + + +nextInvocation :: Config -> IO LambdaInvocation +nextInvocation Conf{..} = runReq defaultHttpConfig $ do + res <- req GET + (invPath c_base /: "next") + NoReqBody + bsResponse + (c_opts <> responseTimeout maxBound) + let rH = responseHeader res + + return $ LambdaInvocation { + li_body = responseBody res + , li_aws_request_id = fromJust $ + T.decodeUtf8 <$> (rH "Lambda-Runtime-Aws-Request-Id") + , li_deadline_ms = rH "Lambda-Runtime-Deadline-Ms" + , li_invoked_function_arn = rH "Lambda-Runtime-Invoked-Function-Arn" + , li_trace_id = rH "Lambda-Runtime-Trace-Id" + , li_client_context = rH "Lambda-Runtime-Client-Context" + , li_cognito_identity = rH "Lambda-Runtime-Cognito-Identity" } + +--- EXPORTS + + +-- | A Lambda error consists of a message and an error type, both of which +-- the user can define. +data LambdaError = + LambdaErr { errorMessage :: String + , errorType :: String } + deriving (Show, Generic, ToJSON) + +-- | A Lambda invocaton contains the body of the request and a few headers +-- defined by AWS. Only the AWS-Request-Id header is guaranteed to be defined. +-- The headers are the following: +-- +-- * li_aws_request_id – The request ID, which identifies the request that triggered +-- the function invocation. +-- +-- For example, 8476a536-e9f4-11e8-9739-2dfe598c3fcd. +-- +-- * li_deadline_ms – The date that the function times out in Unix time milliseconds. +-- +-- For example, 1542409706888. +-- +-- * li_invoked_function_arn – The ARN of the Lambda function, version, or alias +-- that's specified in the invocation. +-- +-- For example, arn:aws:lambda:us-east-2:123456789012:function:custom-runtime. +-- +-- * li_trace_id – The AWS X-Ray tracing +-- header. +-- +-- For example, Root=1-5bef4de7-ad49b0e87f6ef6c87fc2e700;Parent=9a9197af755a6419;Sampled=1. +-- +-- * li_client_context – For invocations from the AWS Mobile SDK, data about the +-- client application and device. +-- +-- * li_cognito_identity – For invocations from the AWS Mobile SDK, data about the +-- Amazon Cognito identity provider. +data LambdaInvocation = + LambdaInvocation { + li_body :: ByteString + , li_aws_request_id :: Text + , li_deadline_ms :: Maybe ByteString + , li_invoked_function_arn :: Maybe ByteString + , li_trace_id :: Maybe ByteString + , li_client_context :: Maybe ByteString + , li_cognito_identity :: Maybe ByteString} + deriving (Show, Eq) + + +-- | A Lambda interface consists of two functions: +-- +-- The li_handler is the function that is run on every Lambda Invocation +-- the results will be dumped as JSON, as this is what most AWS APIs +-- expect. The first argument is the result of the li_init function, such +-- as a database connection or an IORef or similar. Existentially +-- quantified in the same manner as the ST monad to avoid the state +-- escaping. +-- +-- The li_init function is called at the start of the program to initialize +-- the Lambda function, and some optional state. The state is then passed +-- to the handler at each invocation, e.g. a database connection or similar. +data LambdaInterface a = forall s. + LambdaInterface { + li_handler :: ToJSON a => s + -> LambdaInvocation + -> IO (Either LambdaError a) + , li_init :: IO (Either LambdaError s) + } + +-- | The runLambdaInteface should be provided with the definition of the +-- interface to run, and handles the interaction with the AWS API, such as the +-- waiting for next request, responding to the right request, setting the +-- X-Ray trace id and initializing the function at the start. +runLambdaInterface :: ToJSON a => LambdaInterface a -> IO () +runLambdaInterface (LambdaInterface {..}) = + do Just api <- fmap T.pack <$> lookupEnv "AWS_LAMBDA_RUNTIME_API" + Just (c_base, c_opts) <- useHttpURI <$> mkURI ("http://" <> api) + let conf = Conf{..} + i_res <- li_init + case i_res of + Left err -> initializationError conf err + Right init_state -> loop conf init_state li_handler + where loop conf init_state handler = do + li@LambdaInvocation{..} <- nextInvocation conf + when (isJust li_trace_id) $ + setEnv "_X_AMZN_TRACE_ID" $ B.unpack $ fromJust li_trace_id + res <- handler init_state li + case res of + Left lerr -> invocationError conf li_aws_request_id lerr + Right resp -> invocationResponse conf li_aws_request_id + (BL.toStrict $ encode resp) + loop conf init_state handler +