packages feed

aws-lambda-haskell-runtime 1.0.4 → 1.0.5

raw patch · 7 files changed

+193/−119 lines, 7 filesdep +uuiddep −QuickCheck

Dependencies added: uuid

Dependencies removed: QuickCheck

Files

LICENSE view
@@ -1,30 +1,13 @@-Copyright Author name here (c) 2018--All rights reserved.--Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions are met:--    * Redistributions of source code must retain the above copyright-      notice, this list of conditions and the following disclaimer.+Copyright 2018 The Agile Monkeys -    * Redistributions in binary form must reproduce the above-      copyright notice, this list of conditions and the following-      disclaimer in the documentation and/or other materials provided-      with the distribution.+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 -    * Neither the name of Author name here nor the names of other-      contributors may be used to endorse or promote products derived-      from this software without specific prior written permission.+    http://www.apache.org/licenses/LICENSE-2.0 -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+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.
README.md view
@@ -1,3 +1,54 @@ # Haskell Runtime for AWS Lambda+[![Hackage](https://img.shields.io/hackage/v/aws-lambda-haskell-runtime.svg)](https://hackage.haskell.org/package/aws-lambda-haskell-runtime)+[![Linter](https://img.shields.io/badge/code%20style-HLint-brightgreen.svg)](https://github.com/ndmitchell/hlint)+[![CircleCI](https://circleci.com/gh/theam/aws-lambda-haskell-runtime/tree/master.svg?style=svg)](https://circleci.com/gh/theam/aws-lambda-haskell-runtime/tree/master) + This package provides a way of running Haskell projects on AWS Lambda.++## Sample lambda function++```+stack new my-haskell-lambda https://github.com/theam/aws-lambda-haskell-runtime/raw/master/stack-template.hsfiles --resolver=lts-12.13 --omit-packages+cd my-haskell-lambda+stack docker pull+```++Then add ++```+packages:+- .++extra-deps:+- aws-lambda-haskell-runtime-1.0.4+```++to your `stack.yaml`++Then run ++```+make+```++Now you should have a `build/function.zip` file that you can upload to your lambda.++## Lambda function configuration++When creating your lambda function you need to provide a layer with the Haskell runtime. We have deployed the layer to our AWS account, you can use it or deploy it to your own AWS account.++The ARN of the runtime layer is:+```+arn:aws:lambda:<YOUR REGION>:785355572843:layer:haskell-runtime:<VERSION>+````++The version of the layer may be different depending of the region, the current values are:++| us-east-2 | Other regions |+|-----------|---------------|+|    10     |       2       |++## Full user guide++Take a look at the [Getting Started with the Haskell AWS Lambda Runtime](https://medium.com/the-theam-journey/getting-started-with-the-haskell-aws-lambda-runtime-951b2322c7a3) guide.
aws-lambda-haskell-runtime.cabal view
@@ -4,12 +4,12 @@ -- -- see: https://github.com/sol/hpack ----- hash: eb0c1a0fc5528fcd3765757dd2c1e92a71d28843c032385383b0cd05e2ca1f58+-- hash: 2ef45c75a139565b825b94e2a0dfb5a1ba2cb921f85ce064de99be29e2c60cfb  name:           aws-lambda-haskell-runtime-version:        1.0.4+version:        1.0.5 synopsis:       Haskell runtime for AWS Lambda-description:    Please see the README on GitHub at <https://github.com/githubuser/aws-lambda-haskell-runtime#readme>+description:    Please see the README on GitHub at <https://github.com/theam/aws-lambda-haskell-runtime#readme> category:       AWS homepage:       https://github.com/theam/aws-lambda-haskell-runtime#readme bug-reports:    https://github.com/theam/aws-lambda-haskell-runtime/issues@@ -53,6 +53,7 @@     , relude     , template-haskell     , text+    , uuid     , wreq   default-language: Haskell2010 @@ -65,22 +66,9 @@   default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables NoImplicitPrelude DeriveGeneric TypeApplications   ghc-options: -Wall -optP-Wno-nonportable-include-path   build-depends:-      aeson-    , aws-lambda-haskell-runtime+      aws-lambda-haskell-runtime     , base >=4.7 && <5-    , bytestring-    , case-insensitive-    , conduit-    , directory-    , filepath-    , microlens-platform-    , mtl-    , optparse-generic-    , process     , relude-    , template-haskell-    , text-    , wreq   default-language: Haskell2010  test-suite aws-lambda-haskell-runtime-test@@ -93,22 +81,7 @@   default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables NoImplicitPrelude DeriveGeneric TypeApplications   ghc-options: -Wall -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N   build-depends:-      QuickCheck-    , aeson-    , aws-lambda-haskell-runtime-    , base >=4.7 && <5-    , bytestring-    , case-insensitive-    , conduit-    , directory-    , filepath+      base >=4.7 && <5     , hspec-    , microlens-platform-    , mtl-    , optparse-generic-    , process     , relude-    , template-haskell-    , text-    , wreq   default-language: Haskell2010
src/Aws/Lambda/Configuration.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-unused-pattern-binds #-} module Aws.Lambda.Configuration   ( LambdaOptions (..)   , configureLambda@@ -18,6 +19,7 @@ import qualified System.Directory as Directory import System.FilePath ((</>)) import System.IO.Error+import System.IO (hFlush)  import Aws.Lambda.ThHelpers @@ -26,10 +28,12 @@   { eventObject     :: Text   , contextObject   :: Text   , functionHandler :: Text+  , executionUuid   :: Text   } deriving (Generic) instance Options.ParseRecord LambdaOptions  +-- This function is the reason why we disable the warning on top of the module mkMain :: Q [Dec] mkMain = [d|   $(pName "main") = getRecord "" >>= run@@ -38,7 +42,7 @@ mkRun :: Q Dec mkRun = do   handlers <- runIO getHandlers-  clause' <- recordQ "LambdaOptions" ["functionHandler", "contextObject", "eventObject"]+  clause' <- recordQ "LambdaOptions" ["functionHandler", "contextObject", "eventObject", "executionUuid"]   body <- dispatcherCaseQ handlers   pure $ FunD (mkName "run") [Clause [clause'] (NormalB body) []] @@ -56,7 +60,7 @@   let pattern = LitP (StringL $ toString lambdaHandler)   body <- [e|do     result <- $(eName qualifiedName) (decodeObj $(eName "eventObject")) (decodeObj $(eName "contextObject"))-    either returnAndFail returnAndSucceed result+    either (returnAndFail $(eName "executionUuid")) (returnAndSucceed $(eName "executionUuid")) result     |]   pure $ Match pattern (NormalB body) []  where@@ -71,7 +75,7 @@ unmatchedCaseQ = do   let pattern = WildP   body <- [e|-    returnAndFail ("Handler " <> $(eName "functionHandler") <> " does not exist on project")+    returnAndFail $(eName "executionUuid") ("Handler " <> $(eName "functionHandler") <> " does not exist on project")     |]   pure $ Match pattern (NormalB body) [] @@ -82,29 +86,41 @@   return $ main <> [run]  -returnAndFail :: ToJSON a => a -> IO ()-returnAndFail v = do- putTextLn (decodeUtf8 $ encode v)- exitFailure+returnAndFail :: ToJSON a => Text -> a -> IO ()+returnAndFail uuid v = do+  hFlush stdout+  putTextLn uuid+  hFlush stdout+  putTextLn (decodeUtf8 $ encode v)+  hFlush stdout+  hFlush stderr+  exitFailure -returnAndSucceed :: ToJSON a => a -> IO ()-returnAndSucceed v = do- putTextLn (decodeUtf8 $ encode v)- exitSuccess+returnAndSucceed :: ToJSON a => Text -> a -> IO ()+returnAndSucceed uuid v = do+  hFlush stdout+  putTextLn uuid+  hFlush stdout+  putTextLn (decodeUtf8 $ encode v)+  hFlush stdout+  exitSuccess  decodeObj :: FromJSON a => Text -> a-decodeObj x = (decode $ encodeUtf8 x) ?: error $ "Could not decode event " <> x+decodeObj x =+  case (eitherDecode $ encodeUtf8 x) of+    Left e -> error $ toText e+    Right v -> v  data DirContent = DirList [FilePath] [FilePath]                 | DirError IOError data DirData = DirData FilePath DirContent  -- Produces directory data-walk :: FilePath -> Conduit.Source IO DirData+walk :: FilePath -> Conduit.ConduitT () DirData IO () walk path = do   result <- lift $ tryIOError listdir   case result of-    Right dl@(DirList subdirs files) -> do+    Right dl@(DirList subdirs _) -> do       Conduit.yield (DirData path dl)       forM_ subdirs (walk . (path </>))     Right e -> Conduit.yield (DirData path e)@@ -122,14 +138,14 @@   -- Consume directories-myVisitor :: Conduit.Sink DirData IO [FilePath]+myVisitor :: Conduit.ConduitT DirData Void IO [FilePath] myVisitor = loop []  where   loop n = do     r <- Conduit.await     case r of       Nothing -> return n-      Just r  -> loop (process r <> n)+      Just result  -> loop (process result <> n)   process (DirData _ (DirError _)) = []   process (DirData dir (DirList _ files)) = map (\f -> dir <> "/" <> f) files
src/Aws/Lambda/Runtime.hs view
@@ -11,6 +11,9 @@ import qualified Network.Wreq as Wreq import qualified System.Environment as Environment import qualified System.Process as Process+import qualified Data.UUID as UUID+import qualified Data.UUID.V4 as UUID+import System.IO (hFlush)   type App a =@@ -71,6 +74,30 @@   LambdaResult Text  +awsLambdaVersion :: String+awsLambdaVersion = "2018-06-01"+++nextInvocationEndpoint :: Text -> String+nextInvocationEndpoint endpoint =+  "http://" <> toString endpoint <> "/"<> awsLambdaVersion <>"/runtime/invocation/next"+++responseEndpoint :: Text -> Text -> String+responseEndpoint lambdaApi requestId =+  "http://"<> toString lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/invocation/"<> toString requestId <> "/response"+++invocationErrorEndpoint :: Text -> Text -> String+invocationErrorEndpoint lambdaApi requestId =+  "http://"<> toString lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/invocation/"<> toString requestId <> "/error"+++runtimeInitErrorEndpoint :: Text -> String+runtimeInitErrorEndpoint lambdaApi =+  "http://"<> toString lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/init/error"++ readEnvironmentVariable :: Text -> App Text readEnvironmentVariable envVar = do   v <- lift (Environment.lookupEnv $ toString envVar)@@ -91,22 +118,14 @@  getApiData :: Text -> App (Wreq.Response LByteString) getApiData endpoint =-  tryIO (Wreq.get nextInvocationEndpoint)+  keepRetrying (Wreq.get $ nextInvocationEndpoint endpoint)  where-  nextInvocationEndpoint :: String-  nextInvocationEndpoint =-    "http://" <> toString endpoint <> "/2018-06-01/runtime/invocation/next"--  tryIO :: IO a -> App a-  tryIO f =-    try f-    & catchApiException--  catchApiException :: IO (Either IOException a) -> App a-  catchApiException action =-    action-    & fmap (first $ const ApiConnectionError)-    & ExceptT+  keepRetrying :: IO (Wreq.Response LByteString) -> App (Wreq.Response LByteString)+  keepRetrying f = do+    result <- (liftIO $ try f) :: App (Either IOException (Wreq.Response LByteString))+    case result of+      Right x -> return x+      _ -> keepRetrying f   extractHeader :: Wreq.Response LByteString -> Text -> Text@@ -157,26 +176,60 @@     }  +getFunctionResult :: UUID.UUID -> Text -> App (Maybe Text)+getFunctionResult u stdOut = do+  let out = stdOut+          & toText+          & lines++  out+   & takeWhile (/= uuid)+   & traverse_ ( \t -> do+    liftIO $ putTextLn t+    liftIO $ hFlush stdout)++  out+   & dropWhile (/= uuid)+   & dropWhile (== uuid)+   & nonEmpty+   & fmap head+   & return+ where+  uuid = toText $ UUID.toString u++ invoke :: Text -> Context -> App LambdaResult invoke event context = do   handlerName <- readEnvironmentVariable "_HANDLER"   runningDirectory <- readEnvironmentVariable "LAMBDA_TASK_ROOT"   let contextJSON = decodeUtf8 $ encode context+  uuid <- liftIO UUID.nextRandom   out <- liftIO $ Process.readProcessWithExitCode (toString runningDirectory <> "/haskell_lambda")                 [ "--eventObject", toString event                 , "--contextObject", contextJSON                 , "--functionHandler", toString handlerName+                , "--executionUuid", UUID.toString uuid                 ]                 ""   case out of-    (ExitSuccess, stdOut, _) -> pure (LambdaResult $ toText stdOut)-    (_, stdOut, _)           -> throwError (InvocationError $ toText stdOut)+    (ExitSuccess, stdOut, _) -> do+      res <- getFunctionResult uuid (toText stdOut)+      case res of+        Nothing -> throwError (ParseError "parsing result" $ toText stdOut)+        Just value -> pure (LambdaResult value)+    (_, stdOut, stdErr)           ->+      if stdErr /= ""+        then throwError (InvocationError $ toText stdErr)+        else do+          res <- getFunctionResult uuid (toText stdOut)+          case res of+            Nothing -> throwError (ParseError "parsing error" $ toText stdOut)+            Just value -> throwError (InvocationError value)   publishResult :: Context -> Text -> LambdaResult -> App ()-publishResult Context {..} lambdaApi (LambdaResult result) = do-  let endpoint = "http://"<> lambdaApi <> "/2018-06-01/runtime/invocation/"<> awsRequestId <> "/response"-  void $ liftIO $ Wreq.post (toString endpoint) (encodeUtf8 @Text @ByteString result)+publishResult Context {..} lambdaApi (LambdaResult result) =+  void $ liftIO $ Wreq.post (responseEndpoint lambdaApi awsRequestId) (encodeUtf8 @Text @ByteString result)   invokeAndPublish :: Context -> Text -> Text -> App ()@@ -186,13 +239,14 @@   publishError :: Context -> Text -> RuntimeError -> App ()-publishError Context {..} lambdaApiEndpoint (InvocationError err) = do-  let endpoint = "http://"<> lambdaApiEndpoint <> "/2018-06-01/runtime/invocation/"<> awsRequestId <> "/error"-  void (liftIO $ Wreq.post (toString endpoint) (encodeUtf8 @Text @ByteString err))+publishError Context {..} lambdaApiEndpoint (InvocationError err) =+  void (liftIO $ Wreq.post (invocationErrorEndpoint lambdaApiEndpoint awsRequestId) (encodeUtf8 @Text @ByteString err)) -publishError Context {..} lambdaApiEndpoint err = do-  let endpoint = "http://"<> lambdaApiEndpoint <> "/2018-06-01/runtime/init/error"-  void (liftIO $ Wreq.post (toString endpoint) (toJSON err))+publishError Context {..} lambdaApiEndpoint (ParseError t t2) =+  void (liftIO $ Wreq.post (invocationErrorEndpoint lambdaApiEndpoint awsRequestId) (toJSON $ ParseError t t2))++publishError Context {..} lambdaApiEndpoint err =+  void (liftIO $ Wreq.post (runtimeInitErrorEndpoint lambdaApiEndpoint) (toJSON err))   lambdaRunner :: App ()
src/Aws/Lambda/ThHelpers.hs view
@@ -1,4 +1,8 @@-module Aws.Lambda.ThHelpers where+module Aws.Lambda.ThHelpers+  ( pName+  , eName+  , recordQ+  ) where  import Relude import Language.Haskell.TH@@ -13,10 +17,6 @@ eName :: Text -> Q Exp eName = pure . VarE . mkName . toString --- | Helper for extracting fields of records--- think of @personAge@ in @myFunction Person { personAge = personAge } = ...@-fName :: Text -> Q FieldPat-fName name = pure (mkName $ toString name, VarP $ mkName $ toString name)  -- | Helper for extracting fields of a specified record -- it expects the constructor name as the first parameter,@@ -27,3 +27,8 @@ recordQ name fields = do   extractedFields <- traverse fName fields   pure $ RecP (mkName $ toString name) extractedFields+ where+  -- | Helper for extracting fields of records+  -- think of @personAge@ in @myFunction Person { personAge = personAge } = ...@+  fName :: Text -> Q FieldPat+  fName n = pure (mkName $ toString n, VarP $ mkName $ toString n)
test/Spec.hs view
@@ -1,16 +1,8 @@-import           Relude                  hiding ( head )-+import Relude import           Test.Hspec -import           Aws.Lambda.Runtime-import           Aws.Lambda.Function --handler :: Text -> c -> IO (Either String Int)-handler t _ = do-  putTextLn t-  return $ Right (42 :: Int)- main :: IO ()-main = hspec $ describe "Impure lambda handler" $ do-  it "runs" $ lambda handler+main = hspec $ describe "Useless test spec" $ do+  it "runs" $ do+    (1 + 1 :: Int) `shouldBe` (2 :: Int)