diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/aws-lambda-haskell-runtime.cabal b/aws-lambda-haskell-runtime.cabal --- a/aws-lambda-haskell-runtime.cabal +++ b/aws-lambda-haskell-runtime.cabal @@ -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 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 diff --git a/src/Aws/Lambda/Configuration.hs b/src/Aws/Lambda/Configuration.hs --- a/src/Aws/Lambda/Configuration.hs +++ b/src/Aws/Lambda/Configuration.hs @@ -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 diff --git a/src/Aws/Lambda/Runtime.hs b/src/Aws/Lambda/Runtime.hs --- a/src/Aws/Lambda/Runtime.hs +++ b/src/Aws/Lambda/Runtime.hs @@ -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)) diff --git a/src/Aws/Lambda/ThHelpers.hs b/src/Aws/Lambda/ThHelpers.hs --- a/src/Aws/Lambda/ThHelpers.hs +++ b/src/Aws/Lambda/ThHelpers.hs @@ -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) diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,4 +1,3 @@ -import Relude import Test.Hspec