aws-lambda-runtime (empty) → 0
raw patch · 5 files changed
+962/−0 lines, 5 filesdep +aesondep +asyncdep +aws-lambda-runtime
Dependencies added: aeson, async, aws-lambda-runtime, base, base-compat, bytestring, containers, deepseq, filepath, http-client, http-media, http-types, lens, lens-aeson, parsec, process, text, time, zip-archive
Files
- LICENSE +202/−0
- aws-lambda-runtime.cabal +77/−0
- example/Example.hs +39/−0
- src/AWS/Lambda/RuntimeAPI.hs +399/−0
- src/AWS/Lambda/RuntimeAPI/Package.hs +245/−0
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ aws-lambda-runtime.cabal view
@@ -0,0 +1,77 @@+cabal-version: 2.2+name: aws-lambda-runtime+version: 0++synopsis: Haskell on AWS Lambda Runtime API+category: AWS, Development+description:+ Make "native" Haskell AWS Lambda (using Runtime API).+ .+ * "AWS.Lambda.RuntimeAPI" is for writing lambdas+ .+ * "AWS.Lambda.RuntimeAPI.Package" is for packaging them.++homepage: https://github.com/phadej/aws-lambda-haskell-runtime+bug-reports: https://github.com/phadej/aws-lambda-haskell-runtime/issues+license: Apache-2.0+license-file: LICENSE+author: Oleg Grenrus <oleg.grenrus@iki.fi>+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>+copyright: (c) 2018 Futurice, 2018 Oleg Grenrus++tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.2++source-repository head+ type: git+ location: https://github.com/phadej/aws-lambda-haskell-runtime++library+ ghc-options: -Wall+ hs-source-dirs: src+ default-language: Haskell2010+ exposed-modules:+ AWS.Lambda.RuntimeAPI+ AWS.Lambda.RuntimeAPI.Package++ -- GHC boot libraries+ build-depends:+ , base ^>=4.10.1.0 || ^>=4.11.1.0 || ^>=4.12.0.0+ , bytestring ^>=0.10.8.2+ , containers ^>=0.5.10.2 || ^>= 0.6.0.1+ , deepseq ^>=1.4.3.0+ , text ^>=1.2.3.0+ , time ^>=1.8.0.2++ -- other dependencies+ build-depends:+ , aeson ^>=1.4.2.0+ , async ^>=2.2.1+ , base-compat ^>=0.10.5+ , http-client ^>=0.5.14+ , http-media ^>=0.7.1.3+ , http-types ^>=0.12.2++ -- for Package+ build-depends:+ , filepath ^>=1.4.1.2+ , parsec ^>=3.1.13.0+ , process ^>=1.6.1.0+ , zip-archive ^>=0.4++executable example-lambda+ ghc-options: -Wall+ hs-source-dirs: example+ default-language: Haskell2010+ main-is: Example.hs++ -- inherited dependencies+ build-depends:+ , base+ , aeson+ , aws-lambda-runtime+ , text++ -- additional dependencies+ build-depends:+ , lens ^>=4.17+ , lens-aeson ^>=1.0.2
+ example/Example.hs view
@@ -0,0 +1,39 @@+module Main where++import AWS.Lambda.RuntimeAPI+import Control.Lens (deep, (%~), (&))+import Data.Aeson (Value (..), decode) +import Data.String (fromString)+import Data.Aeson.Lens (_String)+import System.Environment (getArgs)++import qualified Data.Text as T++main :: IO ()+main = autoMockJsonMain mock $ \req -> do+ -- get remaining time (in millisecons) and log it+ t <- getTimeRemaining req+ print t++ let res :: Value+ res = requestPayload req+ & deep _String %~ T.toUpper++ return res+ where+ mock = Mock+ { mockResponse = print+ , mockRequest = do+ args <- getArgs+ case args of+ -- no arguments: run with @null@+ [] -> mockRequest' Null+ (a:_)+ -- single argument: if looks like valid JSON: use it+ | Just a' <- decode (fromString a) -> mockRequest' a'+ -- otherwise pass as a literal string:+ | otherwise -> mockRequest' (String (fromString a))+ }++ mockRequest' :: Value -> IO (GenRequest Value)+ mockRequest' v = makeMockRequest v 10000 -- 10 seconds
+ src/AWS/Lambda/RuntimeAPI.hs view
@@ -0,0 +1,399 @@+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE OverloadedStrings #-}+-- | Based on the logic as implemented in https://github.com/awslabs/aws-lambda-cpp+module AWS.Lambda.RuntimeAPI (+ -- * Entry points+ defaultMain,+ jsonMain,+ -- ** Mocks+ autoMockMain,+ autoMockJsonMain,+ Mock, GenMock (..),+ makeMockRequest,+ -- * Requests and response+ Request,+ Response (..),+ GenRequest (..),+ RequestId,+ -- * Time remaining+ getTimeRemaining,+ -- * JSON responses+ jsonResponse,+ jsonMediaType,+ ) where++import Prelude ()+import Prelude.Compat++import Control.Concurrent.Async (waitCatch, withAsync)+import Control.DeepSeq (NFData (..), force)+import Control.Exception (SomeException, displayException, evaluate)+import Control.Monad (forever, void)+import Data.ByteString (ByteString)+import Data.Int (Int64)+import Data.Maybe (fromMaybe)+import Data.Text (Text)+import Network.HTTP.Media (MediaType)+import System.Environment (lookupEnv)+import System.IO (hFlush, stdout)++import qualified Data.Aeson as Aeson+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BS8+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import qualified Data.Time.Clock.System as Time+import qualified Network.HTTP.Client as H+import qualified Network.HTTP.Media as HTTP+import qualified Network.HTTP.Types as HTTP++-------------------------------------------------------------------------------+-- Types+-------------------------------------------------------------------------------++-- | Opaque request id+newtype RequestId = RequestId ByteString+ deriving Show++newtype Deadline = Deadline Int64+ deriving Show++-- | Request with 'ByteString' payload+type Request = GenRequest ByteString++data GenRequest a = Request+ { requestPayload :: !a -- ^ The user's payload represented (originally) as a UTF-8 string.+ , requestId :: !RequestId -- ^ And identifier unique to the current invocation.+ , requestXRayTraceId :: !ByteString -- ^ X-Ray tracigng of the current invocation.+ , requestClientContext :: !ByteString -- ^ Information about the client application and device when invoked through the AWS Mobile SDK.+ , requestCognitoIdentity :: !ByteString -- ^ Information about the Amazon Cognito identity provider when invoked through the AWS Mobile SDK.+ , requestARN :: !ByteString -- ^ The ARN requested. This can be different in each invoke that executes the same version.+ , requestDeadline :: !Deadline -- ^ Function execution deadline counted in milliseconds since the Unix epoch.+ }+ deriving (Show, Functor, Foldable, Traversable)++data Response+ = SuccessResponse !MediaType !BS.ByteString+ | FailureResponse !Text !Text -- ^ error type, error message+ deriving Show++instance NFData Response where+ rnf (SuccessResponse mt bs) =+ rnf (HTTP.mainType mt) `seq`+ rnf (HTTP.subType mt) `seq`+ rnf (HTTP.parameters mt) `seq`+ rnf bs+ rnf (FailureResponse ty msg) = rnf msg `seq` rnf ty++-- | Create JSON response.+jsonResponse :: Aeson.ToJSON a => a -> Response+jsonResponse a = SuccessResponse jsonMediaType $ LBS.toStrict $ Aeson.encode a++-------------------------------------------------------------------------------+-- Helpers+-------------------------------------------------------------------------------++-- | Get time remaining (milliseconds).+getTimeRemaining :: GenRequest a -> IO Int64+getTimeRemaining Request { requestDeadline = Deadline deadline } = do+ millis <- getCurrentMillis+ return (max 0 (deadline - millis))++-- | Get current time in milliseconds. Useful with 'Mock'.+getCurrentMillis :: IO Int64+getCurrentMillis = do+ Time.MkSystemTime sec nano <- Time.getSystemTime+ return $ sec * 1000 + fromIntegral (nano `div` 1000000)++-------------------------------------------------------------------------------+-- JSON media type+-------------------------------------------------------------------------------++jsonMediaType :: MediaType+jsonMediaType = "application/json"++-------------------------------------------------------------------------------+-- Logging+-------------------------------------------------------------------------------++logError :: ByteString -> IO ()+logError str = do+ BS8.putStrLn $ "[ERROR] " <> str+ hFlush stdout++logException :: ByteString -> SomeException -> IO ()+logException str exc = do+ BS8.putStrLn $ "[ERROR] Exception " <> str <> " -- " <> BS8.pack (displayException exc)+ hFlush stdout++logInfo :: ByteString -> IO ()+logInfo _ = return ()++logHttpRequest :: H.Request -> IO ()+logHttpRequest _ = return ()++logHttpResponse :: HttpRes -> IO ()+logHttpResponse _ = return ()++-------------------------------------------------------------------------------+-- Http+-------------------------------------------------------------------------------++httpLbs :: Ctx -> H.Request -> IO HttpRes+httpLbs ctx req = do+ logHttpRequest req+ eres <- tryDeep $ toHttpRes <$> H.httpLbs req (ctxManager ctx)+ case eres of+ Right res -> do+ logHttpResponse res+ return res+ Left exc -> do+ logException "httpLbs" exc+ return $ HttpRes+ { hrStatus = HTTP.status500+ , hrHeaders = mempty+ , hrBody = mempty+ }++data HttpRes = HttpRes+ { hrStatus :: HTTP.Status+ , hrHeaders :: HTTP.ResponseHeaders+ , hrBody :: LBS.ByteString+ }++instance NFData HttpRes where+ rnf (HttpRes (HTTP.Status x y) z w) =+ rnf x `seq`+ rnf y `seq`+ rnf z `seq`+ rnf w++toHttpRes :: H.Response LBS.ByteString -> HttpRes+toHttpRes res = HttpRes+ { hrStatus = H.responseStatus res+ , hrHeaders = H.responseHeaders res+ , hrBody = H.responseBody res+ }++-------------------------------------------------------------------------------+-- trydeep+-------------------------------------------------------------------------------++-- | Erlang inspired tryDeep+tryDeep :: NFData a => IO a -> IO (Either SomeException a)+tryDeep m = withAsync (m >>= evaluate . force) waitCatch++-------------------------------------------------------------------------------+-- Headers+-------------------------------------------------------------------------------++headerRequestId :: HTTP.HeaderName+headerRequestId = "lambda-runtime-aws-request-id"++headerTraceId :: HTTP.HeaderName+headerTraceId = "lambda-runtime-trace-id";++headerClientContext :: HTTP.HeaderName+headerClientContext = "lambda-runtime-client-context";++headerCognitoIdentity :: HTTP.HeaderName+headerCognitoIdentity = "lambda-runtime-cognito-identity";++headerARN :: HTTP.HeaderName+headerARN = "lambda-runtime-invoked-function-arn";++headerDeadline :: HTTP.HeaderName+headerDeadline = "lambda-runtime-deadline-ms";++-------------------------------------------------------------------------------+-- "runtime"+-------------------------------------------------------------------------------++-- | Context. Called runtime in C++ implementation.+data Ctx = Ctx+ { ctxManager :: H.Manager+ , ctxNextRequest :: H.Request+ , ctxSuccessRequest :: H.Request+ , ctxErrorRequest :: H.Request+ }++-- | Initialise the context, i.e. needed things to communicate with AWS Lambda+initCtx :: IO Ctx+initCtx = do+ endpoint <- do+ e <- lookupEnv "AWS_LAMBDA_RUNTIME_API"+ case e of+ Nothing -> fail "AWS_LAMBDA_RUNTIME_API not defined"+ Just e' -> return e'++ nextReq <- H.parseRequest $ "http://" ++ endpoint ++ "/2018-06-01/runtime/invocation/next"+ successReq <- H.parseRequest $ "http://" ++ endpoint ++ "/2018-06-01/runtime/invocation/:request/response"+ errorReq <- H.parseRequest $ "http://" ++ endpoint ++ "/2018-06-01/runtime/invocation/:request/error"++ mgr <- H.newManager H.defaultManagerSettings+ -- TODO: I'm not sure if it's enought to have timeout only on NEXT requests?+ { H.managerResponseTimeout = H.responseTimeoutNone+ }++ return Ctx+ { ctxManager = mgr+ , ctxNextRequest = nextReq+ -- { H.responseTimeout = H.responseTimeoutNone+ -- }+ , ctxSuccessRequest = successReq+ { H.method = "POST"+ }+ , ctxErrorRequest = errorReq+ { H.method = "POST"+ }+ }++-- | Ask lambda for an invocation.+getNext :: Ctx -> IO (Either HTTP.Status Request)+getNext ctx = do+ res <- httpLbs ctx $ ctxNextRequest ctx++ let st = hrStatus res++ if not $ HTTP.statusIsSuccessful st+ then return (Left st)+ else do+ let headers = Map.fromList $ hrHeaders res+ optionalHeader h = fromMaybe mempty $ Map.lookup h headers++ case Map.lookup headerRequestId headers of+ Nothing -> return $ Left st+ Just reqId -> return $ Right Request+ { requestPayload = LBS.toStrict (hrBody res)+ , requestId = RequestId reqId+ , requestXRayTraceId = optionalHeader headerTraceId+ , requestClientContext = optionalHeader headerClientContext+ , requestCognitoIdentity = optionalHeader headerCognitoIdentity+ , requestARN = optionalHeader headerARN+ , requestDeadline = parseDeadline $ optionalHeader headerDeadline+ }+ where+ parseDeadline bs = Deadline $ maybe 0 (fromInteger . fst) (BS8.readInteger bs)++-- | Tells lambda that the function has succeeded.+postSuccess :: Ctx -> Request -> Response -> IO ()+postSuccess ctx req (SuccessResponse mt bs) =+ void $ httpLbs ctx httpReq+ where+ httpReq :: H.Request+ httpReq = (ctxSuccessRequest ctx)+ { H.path = replaceRequestId (requestId req) $ H.path (ctxSuccessRequest ctx)+ , H.requestHeaders =+ [ ("Content-Type", HTTP.renderHeader mt)+ ]+ , H.requestBody = H.RequestBodyBS bs+ }+postSuccess ctx req (FailureResponse ty msg) =+ postFailure ctx req ty msg+++-- | Tells lambda that the function has failed.+postFailure :: Ctx -> Request -> Text -> Text -> IO ()+postFailure ctx req ty msg =+ void $ httpLbs ctx httpReq+ where+ httpReq :: H.Request+ httpReq = (ctxSuccessRequest ctx)+ { H.path = replaceRequestId (requestId req) $ H.path (ctxSuccessRequest ctx)+ , H.requestHeaders =+ [ ("Content-Type", HTTP.renderHeader jsonMediaType)+ ]+ , H.requestBody = H.RequestBodyLBS $ Aeson.encode $ Aeson.object+ [ "errorMessage" Aeson..= msg+ , "errorType" Aeson..= ty+ , "stackTrace" Aeson..= Aeson.Array mempty+ ]+ }++replaceRequestId :: RequestId -> ByteString -> ByteString+replaceRequestId (RequestId rid) path = case BS.breakSubstring ":request" path of+ (pfx, sfx) -> pfx <> rid <> BS.drop 8 sfx++-------------------------------------------------------------------------------+-- Main variants+-------------------------------------------------------------------------------++-- | Default main to implement AWS Lambda using Runtime API+defaultMain :: (Request -> IO Response) -> IO ()+defaultMain handler = do+ ctx <- initCtx++ forever $ do+ next <- getNext ctx+ case next of+ -- on failure we log, and loop+ -- TODO: use status+ Left _st -> logError "HTTP request was not successful. HTTP response code: %d. Retrying.."++ -- on success we have a request!+ Right req -> do+ logInfo "Invoking user handler"+ eres <- tryDeep (handler req)+ case eres of+ Left exc -> do+ logException "handler" exc+ postFailure ctx req "SomeException" (Text.pack $ displayException exc)+ Right res -> postSuccess ctx req res++-- | Like 'defaultMain' but work with JSON+jsonMain :: (Aeson.FromJSON a, Aeson.ToJSON b) => (GenRequest a -> IO b) -> IO ()+jsonMain handler = defaultMain $ \req ->+ case traverse Aeson.eitherDecodeStrict req of+ Right req' -> jsonResponse <$> handler req'+ Left err -> return $ FailureResponse "decode" (Text.pack err)++-------------------------------------------------------------------------------+-- Mock variants+-------------------------------------------------------------------------------++type Mock = GenMock ByteString++-- | How to mock the 'Request', what to do with the 'Response'.+data GenMock a = Mock+ { mockRequest :: IO (GenRequest a)+ , mockResponse :: Response -> IO ()+ }++-- | Create 'Mock' request+makeMockRequest+ :: a -- ^ payload value+ -> Int64 -- ^ request duration (in milliseconds)+ -> IO (GenRequest a)+makeMockRequest payload duration = do+ currentMillis <- getCurrentMillis+ return $ Request+ { requestPayload = payload+ , requestId = RequestId "mock-deadc0de"+ , requestXRayTraceId = mempty+ , requestClientContext = mempty+ , requestCognitoIdentity = mempty+ , requestARN = mempty+ , requestDeadline = Deadline $ currentMillis + max 1000 duration+ }++-- | Check the existence of @AWS_LAMBDA_RUNTIME_API@ environment variable.+--+-- If it exists, assume we are running in AWS Lambda environment, i.e. run normally.+-- Otherwise use supplied 'MockOptions'+autoMockMain :: Mock -> (Request -> IO Response) -> IO ()+autoMockMain mock handler = do+ e <- lookupEnv "AWS_LAMBDA_RUNTIME_API"+ case e of+ Just _ -> defaultMain handler+ Nothing -> mockRequest mock >>= handler >>= mockResponse mock++-- | Like 'autoMockMain' but works with JSON+autoMockJsonMain :: (Aeson.FromJSON a, Aeson.ToJSON b) => GenMock a -> (GenRequest a -> IO b) -> IO ()+autoMockJsonMain mock handler = do+ e <- lookupEnv "AWS_LAMBDA_RUNTIME_API"+ case e of+ Just _ -> jsonMain handler+ Nothing -> mockRequest mock >>= handler >>= mockResponse mock . jsonResponse
+ src/AWS/Lambda/RuntimeAPI/Package.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE MultiWayIf #-}+-- | Utility to package lambda+--+-- Example usage, you need to run it on AWS Linux+-- (e.g. Docker, see [Dockerfile](https://github.com/phadej/aws-lambda-runtime-api/blob/master/docker-image/Dockerfile))+-- with @GHC@, @cabal@ and @cabal-plan@ available.+--+-- @+-- module Main (main) where+--+-- import AWS.Lambda.RuntimeAPI.Package ('defaultConf', 'packageAwsLambda')+-- import Data.Char (isSpace)+--+-- import qualified Data.ByteString.Lazy as LBS+-- import qualified System.Process as P+--+-- main :: IO ()+-- main = do+-- -- Build the executable+-- let exe = "example-lambda"+-- P.callProcess "cabal" ["new-build", exe]+--+-- -- Find the build artifact+-- exePath \<- trim \<$> P.readProcess "cabal-plan" [ "list-bin", exe ] ""+-- putStrLn $ "Packaging executable: " ++ exePath+--+-- -- Package it+-- zipFile \<- 'packageAwsLambda' 'defaultConf' exePath+-- LBS.writeFile "example-lambda.zip" zipFile+-- where+-- trim = dropWhile isSpace . reverse . dropWhile isSpace . reverse+-- @+--+-- Given such environment, we can build an example lambda function:+--+-- @+-- % docker run -ti --rm -v $(pwd):/work -w /work amazonlinux-with-ghc+--+-- % cabal new-update+-- % cabal new-build+-- % runghc package-example-lambda.hs+-- @+--+-- The resulting @example-lambda.zip@ is ready to be uploaded!+--+module AWS.Lambda.RuntimeAPI.Package (+ packageAwsLambda,+ Conf (..),+ defaultConf,+ confAdditionalLibs,+ confReadFile,+ -- * Utilities+ findExtraLibs,+ ) where++import Prelude ()+import Prelude.Compat++import Control.Applicative (Alternative (..), optional)+import Control.DeepSeq (force)+import Control.Exception (evaluate)+import Data.Bits (shiftL)+import Data.Char (isAlphaNum, isHexDigit)+import Data.List (isPrefixOf)+import Data.List.NonEmpty (NonEmpty (..))+import Data.Maybe (catMaybes)+import Data.Traversable (for)+import System.FilePath.Posix (takeFileName)+import System.Process (proc, readCreateProcess)++import qualified Codec.Archive.Zip as Zip+import qualified Data.ByteString.Lazy as LBS+import qualified Text.Parsec as P++-- | Package AWS Lambda executable.+packageAwsLambda+ :: Conf+ -> FilePath+ -> IO LBS.ByteString -- ^ Result is ZIP package+packageAwsLambda conf exePath = do+ -- executable, we package it as "bootstrap"+ exeContents <- _confReadFile conf exePath++ let exeEntry :: Zip.Entry+ exeEntry = (Zip.toEntry "bootstrap" 0 exeContents)+ { Zip.eExternalFileAttributes = shiftL 0755 16+ , Zip.eVersionMadeBy = 0x0300 -- UNIX file attributes+ }++ -- .so dependencies+ libs <- findExtraLibs (_confAdditionalLibs conf) exePath+ libEntries <- for libs $ \lib -> do+ libContents <- _confReadFile conf lib+ return $ Zip.toEntry (takeFileName lib) 0 libContents++ -- all together+ let entries = exeEntry : libEntries++ evaluate $ force $ Zip.fromArchive Zip.Archive+ { Zip.zEntries = entries+ , Zip.zSignature = Nothing+ , Zip.zComment = mempty+ }++data Conf = Conf+ { _confAdditionalLibs :: ![String] -- ^ library names we know surely need to be packaged+ , _confReadFile :: !(FilePath -> IO LBS.ByteString) -- ^ function to read file from filesystem+ }++defaultConf :: Conf+defaultConf = Conf+ { _confAdditionalLibs = []+ , _confReadFile = LBS.readFile+ }++confAdditionalLibs :: Functor f => ([String] -> f [String]) -> Conf -> f Conf+confAdditionalLibs f conf = (\x -> conf { _confAdditionalLibs = x}) <$> f (_confAdditionalLibs conf)++confReadFile :: Functor f => ((FilePath -> IO LBS.ByteString) -> f (FilePath -> IO LBS.ByteString)) -> Conf -> f Conf+confReadFile f conf = (\x -> conf { _confReadFile = x}) <$> f (_confReadFile conf)++-------------------------------------------------------------------------------+-- LDD magic - find dependencies+-------------------------------------------------------------------------------++-- | Run @ldd@ on given @filepath@, return @.so@ files.+findExtraLibs+ :: [String] -- ^ additional libs+ -> FilePath -- ^ ELF file+ -> IO [FilePath]+findExtraLibs additionalCopyLibs fp = do+ output <- readCreateProcess (proc "ldd" [fp]) ""+ either (fail . show) (return . catMaybes) $+ P.parse (many lddLine <* P.eof) "<ldd output>" output+ where+ lddLine = do+ P.spaces+ lib <|> ldLinux++ lib = do+ l :| _ <- sepByNonEmpty+ (some $ P.satisfy $ \c -> isAlphaNum c || c == '-' || c == '+' || c == '_')+ (P.char '.')++ P.spaces+ md <- optional $ do+ _ <- P.string "=>"+ P.spaces+ many $ P.satisfy $ \c ->+ isAlphaNum c || c == '.' || c == '-' || c == '+' || c == '_' || c == '/'+ _ <- address++ if | "libHS" `isPrefixOf` l -> return md+ | l `elem` skipLibs -> return Nothing+ | l `elem` copyLibs -> return md+ | otherwise -> fail $ "Unknown lib " ++ l++ ldLinux = P.string "/lib64/ld-linux-x86-64.so.2" *> address *> return Nothing++ sepByNonEmpty p sep = do+ x <- p+ xs <- many (sep *> p)+ return (x :| xs)++ -- Libraries which exist in Linux AMI+ skipLibs =+ [ "linux-vdso"++ , "libBrokenLocale"+ , "libacl"+ , "libanl"+ , "libasound"+ , "libattr"+ , "libaudit"+ , "libauparse"+ , "libblkid"+ , "libbz2"+ , "libc"+ , "libcap-ng"+ , "libcap"+ , "libcidn"+ , "libcrypt"+ -- , "libcrypto"+ , "libdbus-1"+ , "libdl"+ , "libexpat"+ , "libgcc_s-4.8.3-20140911"+ , "libgcc_s"+ , "libgpg-error"+ , "libidn"+ , "libip4tc"+ , "libip6tc"+ , "libiptc"+ , "libkeyutils"+ , "liblber-2.4"+ , "libldap-2.4"+ , "libldap_r-2.4"+ , "libldif-2.4"+ , "libm"+ , "libmount"+ , "libncurses"+ , "libncursesw"+ , "libnih-dbus"+ , "libnih"+ , "libnsl"+ , "libnss_compat"+ , "libnss_db"+ , "libnss_dns"+ , "libnss_files"+ , "libnss_hesiod"+ , "libnss_nis"+ , "libnss_nisplus"+ , "libpam"+ , "libpam_misc"+ , "libpamc"+ , "libpcre"+ , "libpopt"+ , "libpthread"+ , "libpwquality"+ , "libreadline"+ , "libresolv"+ , "librt"+ , "libsepol"+ , "libthread_db"+ , "libtinfo"+ , "libudev"+ , "libutil"+ , "libuuid"+ , "libxtables"+ , "libz"++ ]++ -- Libraries which we know for sure aren't in Amazon Linux AMI+ copyLibs =+ [ "libgmp"+ , "libffi"+ ] ++ additionalCopyLibs++ address = P.spaces+ *> P.char '('+ *> P.string "0x"+ *> P.skipMany (P.satisfy isHexDigit)+ *> P.char ')'+ *> P.char '\n'