packages feed

aws-lambda-haskell-runtime 1.0.5 → 1.0.6

raw patch · 6 files changed

+85/−64 lines, 6 filesdep −relude

Dependencies removed: relude

Files

app/Main.hs view
@@ -1,6 +1,7 @@ module Main where -import Relude+import Control.Monad+import Control.Monad.Except import Aws.Lambda.Runtime  @@ -9,4 +10,4 @@   res <- runExceptT lambdaRunner   case res of     Right _ -> return ()-    Left err  -> putTextLn $ show err+    Left err  -> putStrLn $ show err
aws-lambda-haskell-runtime.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 2ef45c75a139565b825b94e2a0dfb5a1ba2cb921f85ce064de99be29e2c60cfb+-- hash: 9cd5d02ae2c412f6bd71289bdfefdb72975fabb99e9fb6d271f3074e20ef3e9c  name:           aws-lambda-haskell-runtime-version:        1.0.5+version:        1.0.6 synopsis:       Haskell runtime for AWS Lambda description:    Please see the README on GitHub at <https://github.com/theam/aws-lambda-haskell-runtime#readme> category:       AWS@@ -36,7 +36,7 @@       Paths_aws_lambda_haskell_runtime   hs-source-dirs:       src-  default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables NoImplicitPrelude DeriveGeneric TypeApplications+  default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables DeriveGeneric TypeApplications   ghc-options: -Wall -optP-Wno-nonportable-include-path   build-depends:       aeson@@ -50,7 +50,6 @@     , mtl     , optparse-generic     , process-    , relude     , template-haskell     , text     , uuid@@ -63,12 +62,12 @@       Paths_aws_lambda_haskell_runtime   hs-source-dirs:       app-  default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables NoImplicitPrelude DeriveGeneric TypeApplications+  default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables DeriveGeneric TypeApplications   ghc-options: -Wall -optP-Wno-nonportable-include-path   build-depends:       aws-lambda-haskell-runtime     , base >=4.7 && <5-    , relude+    , mtl   default-language: Haskell2010  test-suite aws-lambda-haskell-runtime-test@@ -78,10 +77,10 @@       Paths_aws_lambda_haskell_runtime   hs-source-dirs:       test-  default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables NoImplicitPrelude DeriveGeneric TypeApplications+  default-extensions: TemplateHaskell OverloadedStrings RecordWildCards ScopedTypeVariables DeriveGeneric TypeApplications   ghc-options: -Wall -optP-Wno-nonportable-include-path -threaded -rtsopts -with-rtsopts=-N   build-depends:       base >=4.7 && <5     , hspec-    , relude+    , mtl   default-language: Haskell2010
src/Aws/Lambda/Configuration.hs view
@@ -10,19 +10,30 @@ where  import Data.Aeson-import Relude  import qualified Data.Text as Text+import Data.Text (Text)+import GHC.Generics+import Data.Function ((&)) import Language.Haskell.TH import qualified Options.Generic as Options import qualified Conduit as Conduit import qualified System.Directory as Directory import System.FilePath ((</>)) import System.IO.Error-import System.IO (hFlush)+import System.IO (hFlush, stdout, stderr)+import System.Exit (exitSuccess, exitFailure)+import Control.Monad.Trans+import Control.Monad+import qualified Data.Text.Encoding    as Encoding+import qualified Data.ByteString.Lazy as LazyByteString ++ import Aws.Lambda.ThHelpers +putTextLn :: Text -> IO ()+putTextLn = putStrLn . Text.unpack  data LambdaOptions = LambdaOptions   { eventObject     :: Text@@ -57,7 +68,7 @@  handlerCaseQ :: Text -> Q Match handlerCaseQ lambdaHandler = do-  let pattern = LitP (StringL $ toString lambdaHandler)+  let pattern = LitP (StringL $ Text.unpack lambdaHandler)   body <- [e|do     result <- $(eName qualifiedName) (decodeObj $(eName "eventObject")) (decodeObj $(eName "contextObject"))     either (returnAndFail $(eName "executionUuid")) (returnAndSucceed $(eName "executionUuid")) result@@ -91,7 +102,7 @@   hFlush stdout   putTextLn uuid   hFlush stdout-  putTextLn (decodeUtf8 $ encode v)+  putTextLn (Encoding.decodeUtf8 $ LazyByteString.toStrict $ encode v)   hFlush stdout   hFlush stderr   exitFailure@@ -101,16 +112,17 @@   hFlush stdout   putTextLn uuid   hFlush stdout-  putTextLn (decodeUtf8 $ encode v)+  putTextLn (Encoding.decodeUtf8 $ LazyByteString.toStrict $ encode v)   hFlush stdout   exitSuccess  decodeObj :: FromJSON a => Text -> a decodeObj x =-  case (eitherDecode $ encodeUtf8 x) of-    Left e -> error $ toText e+  case (eitherDecode $ LazyByteString.fromStrict $ Encoding.encodeUtf8 x) of+    Left e -> error e     Right v -> v + data DirContent = DirList [FilePath] [FilePath]                 | DirError IOError data DirData = DirData FilePath DirContent@@ -134,11 +146,11 @@    where     isFile entry = Directory.doesFileExist (path </> entry)     isDir entry = Directory.doesDirectoryExist (path </> entry)-    filterHidden paths = return $ filter (\p -> head (fromMaybe (error "") $ nonEmpty p) /= '.') paths+    filterHidden paths = return $ filter (\p -> head p /= '.') paths   -- Consume directories-myVisitor :: Conduit.ConduitT DirData Void IO [FilePath]+myVisitor :: Conduit.ConduitT DirData Conduit.Void IO [FilePath] myVisitor = loop []  where   loop n = do@@ -154,7 +166,7 @@ getHandlers = do   files <- Conduit.runConduit $ walk "." Conduit..| myVisitor   handlerFiles <- files-                   & fmap toText+                   & fmap Text.pack                    & filter (Text.isSuffixOf ".hs")                    & filterM containsHandler                    & fmap (fmap $ Text.dropEnd 3)@@ -165,6 +177,5 @@  containsHandler :: Text -> IO Bool containsHandler file = do-  fileContents <- readFile $ toString file-  return $ "handler :: " `Text.isInfixOf` fileContents-        && "IO (Either " `Text.isInfixOf` fileContents+  fileContents <- readFile $ Text.unpack file+  return $ "handler :: " `Text.isInfixOf` Text.pack fileContents
src/Aws/Lambda/Runtime.hs view
@@ -1,10 +1,20 @@ module Aws.Lambda.Runtime where -import Control.Exception (IOException, try)-import Control.Monad.Except (catchError, throwError)+import Control.Exception (Exception, IOException, try)+import Control.Monad.Except (ExceptT, catchError, throwError) import Data.Aeson-import Relude hiding (get, identity) import System.Exit (ExitCode (..))+import qualified Data.Text as Text+import Data.Text (Text)+import GHC.Generics+import qualified Data.ByteString.Lazy as LazyByteString+import qualified Data.ByteString as ByteString+import Control.Monad.Trans+import Text.Read (readMaybe)+import qualified Data.Text.Encoding    as Encoding+import Control.Monad+import Data.Function ((&))+import Data.Maybe (listToMaybe)  import qualified Data.CaseInsensitive as CI import Lens.Micro.Platform hiding ((.=))@@ -13,9 +23,12 @@ import qualified System.Process as Process import qualified Data.UUID as UUID import qualified Data.UUID.V4 as UUID-import System.IO (hFlush)+import System.IO (hFlush, stdout)  +type LByteString = LazyByteString.ByteString+type ByteString = ByteString.ByteString+ type App a =   ExceptT RuntimeError IO a @@ -80,36 +93,36 @@  nextInvocationEndpoint :: Text -> String nextInvocationEndpoint endpoint =-  "http://" <> toString endpoint <> "/"<> awsLambdaVersion <>"/runtime/invocation/next"+  "http://" <> Text.unpack endpoint <> "/"<> awsLambdaVersion <>"/runtime/invocation/next"   responseEndpoint :: Text -> Text -> String responseEndpoint lambdaApi requestId =-  "http://"<> toString lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/invocation/"<> toString requestId <> "/response"+  "http://"<> Text.unpack lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/invocation/"<> Text.unpack requestId <> "/response"   invocationErrorEndpoint :: Text -> Text -> String invocationErrorEndpoint lambdaApi requestId =-  "http://"<> toString lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/invocation/"<> toString requestId <> "/error"+  "http://"<> Text.unpack lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/invocation/"<> Text.unpack requestId <> "/error"   runtimeInitErrorEndpoint :: Text -> String runtimeInitErrorEndpoint lambdaApi =-  "http://"<> toString lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/init/error"+  "http://"<> Text.unpack lambdaApi <> "/" <> awsLambdaVersion <> "/runtime/init/error"   readEnvironmentVariable :: Text -> App Text readEnvironmentVariable envVar = do-  v <- lift (Environment.lookupEnv $ toString envVar)+  v <- lift (Environment.lookupEnv $ Text.unpack envVar)   case v of     Nothing    -> throwError (EnvironmentVariableNotSet envVar)-    Just value -> pure (toText value)+    Just value -> pure (Text.pack value)   readFunctionMemory :: App Int readFunctionMemory = do   let envVar = "AWS_LAMBDA_FUNCTION_MEMORY_SIZE"-  let parseMemory txt = readMaybe (toString txt)+  let parseMemory txt = readMaybe (Text.unpack txt)   memoryValue <- readEnvironmentVariable envVar   case parseMemory memoryValue of     Just value -> pure value@@ -130,25 +143,25 @@  extractHeader :: Wreq.Response LByteString -> Text -> Text extractHeader apiData header =-  decodeUtf8 (apiData ^. Wreq.responseHeader (CI.mk $ encodeUtf8 header))+  Encoding.decodeUtf8 (apiData ^. Wreq.responseHeader (CI.mk $ Encoding.encodeUtf8 header))   extractIntHeader :: Wreq.Response LByteString -> Text -> App Int extractIntHeader apiData headerName = do   let header = extractHeader apiData headerName-  case readMaybe $ toString header of+  case readMaybe $ Text.unpack header of     Nothing    -> throwError (ParseError "deadline" header)     Just value -> pure value   extractBody :: Wreq.Response LByteString -> Text extractBody apiData =-  decodeUtf8 (apiData ^. Wreq.responseBody)+  Encoding.decodeUtf8 $ LazyByteString.toStrict (apiData ^. Wreq.responseBody)   propagateXRayTrace :: Text -> App () propagateXRayTrace xrayTraceId =-  liftIO $ Environment.setEnv "_X_AMZN_TRACE_ID" $ toString xrayTraceId+  liftIO $ Environment.setEnv "_X_AMZN_TRACE_ID" $ Text.unpack xrayTraceId   initializeContext :: Wreq.Response LByteString -> App Context@@ -178,58 +191,55 @@  getFunctionResult :: UUID.UUID -> Text -> App (Maybe Text) getFunctionResult u stdOut = do-  let out = stdOut-          & toText-          & lines+  let out = Text.lines stdOut    out    & takeWhile (/= uuid)-   & traverse_ ( \t -> do-    liftIO $ putTextLn t+   & mapM_ ( \t -> do+    liftIO $ putStrLn $ Text.unpack t     liftIO $ hFlush stdout)    out    & dropWhile (/= uuid)    & dropWhile (== uuid)-   & nonEmpty-   & fmap head+   & listToMaybe    & return  where-  uuid = toText $ UUID.toString u+  uuid = Text.pack $ 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+  let contextJSON = Encoding.decodeUtf8 $ LazyByteString.toStrict $ encode context   uuid <- liftIO UUID.nextRandom-  out <- liftIO $ Process.readProcessWithExitCode (toString runningDirectory <> "/haskell_lambda")-                [ "--eventObject", toString event-                , "--contextObject", contextJSON-                , "--functionHandler", toString handlerName+  out <- liftIO $ Process.readProcessWithExitCode (Text.unpack runningDirectory <> "/haskell_lambda")+                [ "--eventObject", Text.unpack event+                , "--contextObject", Text.unpack contextJSON+                , "--functionHandler", Text.unpack handlerName                 , "--executionUuid", UUID.toString uuid                 ]                 ""   case out of     (ExitSuccess, stdOut, _) -> do-      res <- getFunctionResult uuid (toText stdOut)+      res <- getFunctionResult uuid (Text.pack stdOut)       case res of-        Nothing -> throwError (ParseError "parsing result" $ toText stdOut)+        Nothing -> throwError (ParseError "parsing result" $ Text.pack stdOut)         Just value -> pure (LambdaResult value)     (_, stdOut, stdErr)           ->       if stdErr /= ""-        then throwError (InvocationError $ toText stdErr)+        then throwError (InvocationError $ Text.pack stdErr)         else do-          res <- getFunctionResult uuid (toText stdOut)+          res <- getFunctionResult uuid (Text.pack stdOut)           case res of-            Nothing -> throwError (ParseError "parsing error" $ toText stdOut)+            Nothing -> throwError (ParseError "parsing error" $ Text.pack stdOut)             Just value -> throwError (InvocationError value)   publishResult :: Context -> Text -> LambdaResult -> App () publishResult Context {..} lambdaApi (LambdaResult result) =-  void $ liftIO $ Wreq.post (responseEndpoint lambdaApi awsRequestId) (encodeUtf8 @Text @ByteString result)+  void $ liftIO $ Wreq.post (responseEndpoint lambdaApi awsRequestId) (Encoding.encodeUtf8 result)   invokeAndPublish :: Context -> Text -> Text -> App ()@@ -240,7 +250,7 @@  publishError :: Context -> Text -> RuntimeError -> App () publishError Context {..} lambdaApiEndpoint (InvocationError err) =-  void (liftIO $ Wreq.post (invocationErrorEndpoint lambdaApiEndpoint awsRequestId) (encodeUtf8 @Text @ByteString err))+  void (liftIO $ Wreq.post (invocationErrorEndpoint lambdaApiEndpoint awsRequestId) (Encoding.encodeUtf8 err))  publishError Context {..} lambdaApiEndpoint (ParseError t t2) =   void (liftIO $ Wreq.post (invocationErrorEndpoint lambdaApiEndpoint awsRequestId) (toJSON $ ParseError t t2))
src/Aws/Lambda/ThHelpers.hs view
@@ -4,18 +4,19 @@   , recordQ   ) where -import Relude import Language.Haskell.TH+import qualified Data.Text as Text+import Data.Text (Text)  -- | Helper for defining names in declarations -- think of @myValue@ in @myValue = 2@ pName :: Text -> Q Pat-pName = pure . VarP . mkName . toString+pName = pure . VarP . mkName . Text.unpack  -- | Helper for defining names in expressions -- think of @myFunction@ in @quux = myFunction 3@ eName :: Text -> Q Exp-eName = pure . VarE . mkName . toString+eName = pure . VarE . mkName . Text.unpack   -- | Helper for extracting fields of a specified record@@ -26,9 +27,9 @@ recordQ :: Text -> [Text] -> Q Pat recordQ name fields = do   extractedFields <- traverse fName fields-  pure $ RecP (mkName $ toString name) extractedFields+  pure $ RecP (mkName $ Text.unpack 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)+  fName n = pure (mkName $ Text.unpack n, VarP $ mkName $ Text.unpack n)
test/Spec.hs view
@@ -1,4 +1,3 @@-import Relude import           Test.Hspec