now-haskell (empty) → 0.1.0.0

raw patch · 23 files changed

+3124/−0 lines, 23 filesdep +Cabaldep +QuickCheckdep +aesonsetup-changed

Dependencies added: Cabal, QuickCheck, aeson, aeson-pretty, aws-lambda-runtime, base, base64-bytestring, bytestring, case-insensitive, containers, deepseq, directory, exceptions, filepath, fused-effects, ghc-lib-parser, hspec, http-api-data, http-client, http-client-tls, http-media, http-types, iso8601-time, katip, memory, microlens, monad-logger, mtl, network, random, safe-exceptions, semigroups, stack, text, time, transformers, unordered-containers, vector, wai, yaml

Files

• README.md +201/−0
• Setup.hs +2/−0
• lib/AWSLambdaRuntime.hs +31/−0
• lib/AWSLambdaRuntime/API.hs +19/−0
• lib/AWSLambdaRuntime/API/ApiDefault.hs +151/−0
• lib/AWSLambdaRuntime/Client.hs +217/−0
• lib/AWSLambdaRuntime/Core.hs +544/−0
• lib/AWSLambdaRuntime/Logging.hs +33/−0
• lib/AWSLambdaRuntime/LoggingKatip.hs +118/−0
• lib/AWSLambdaRuntime/LoggingMonadLogger.hs +127/−0
• lib/AWSLambdaRuntime/MimeTypes.hs +203/−0
• lib/AWSLambdaRuntime/Model.hs +180/−0
• lib/AWSLambdaRuntime/ModelLens.hs +79/−0
• lib/Zeit/Now.hs +147/−0
• now-haskell.cabal +140/−0
• openapi.yaml +219/−0
• src/CabalScanner.hs +165/−0
• src/Main.hs +34/−0
• src/ModuleScanner.hs +220/−0
• tests/ApproxEq.hs +81/−0
• tests/Instances.hs +136/−0
• tests/PropMime.hs +51/−0
• tests/Test.hs +26/−0

@@ -0,0 +1,201 @@+## OpenAPI Auto-Generated [http-client](https://www.stackage.org/lts-10.0/package/http-client-0.5.7.1) Bindings to `AWS Lambda Runtime API`++The library in `lib` provides auto-generated-from-OpenAPI [http-client](https://www.stackage.org/lts-10.0/package/http-client-0.5.7.1) bindings to the AWS Lambda Runtime API API.++OpenApi Version: 3.0.0++## Installation++Installation follows the standard approach to installing Stack-based projects.++1. Install the [Haskell `stack` tool](http://docs.haskellstack.org/en/stable/README).+2. To build the package, and generate the documentation (recommended):+```+stack haddock+```+which will generate docs for this lib in the `docs` folder.++To generate the docs in the normal location (to enable hyperlinks to external libs), remove +```+build:+  haddock-arguments:+    haddock-args:+    - "--odir=./docs"+```+from the stack.yaml file and run `stack haddock` again.++3. To run unit tests:+```+stack test+```++## OpenAPI-Generator++The code generator that produced this library, and which explains how+to obtain and use the openapi-generator cli tool lives at++https://openapi-generator.tech++The _generator-name_ argument (`--generator-name`) passed to the cli tool used should be++```+haskell-http-client+```++### Unsupported OpenAPI Features++* Model Inheritance++This is beta software; other cases may not be supported.++### Codegen "additional properties" parameters++These options allow some customization of the code generation process.++**haskell-http-client additional properties:**++| OPTION                          | DESCRIPTION                                                                                                                   | DEFAULT  | ACTUAL                                |+| ------------------------------- | ----------------------------------------------------------------------------------------------------------------------------- | -------- | ------------------------------------- |+| allowFromJsonNulls              | allow JSON Null during model decoding from JSON                                                                               | true     | true              |+| allowNonUniqueOperationIds      | allow *different* API modules to contain the same operationId. Each API must be imported qualified                            | false    | false    |+| allowToJsonNulls                | allow emitting JSON Null during model encoding to JSON                                                                        | false    | false                |+| baseModule                      | Set the base module namespace                                                                                                 |          | AWSLambdaRuntime                      |+| cabalPackage                    | Set the cabal package name, which consists of one or more alphanumeric words separated by hyphens                             |          | aws-lambda-runtime                    |+| cabalVersion                    | Set the cabal version number, consisting of a sequence of one or more integers separated by dots                              | 0.1.0.0  | 0.1.0.0                    |+| customTestInstanceModule        | test module used to provide typeclass instances for types not known by the generator                                          |          |         |+| configType                      | Set the name of the type used for configuration                                                                               |          | AWSLambdaRuntimeConfig                      |+| dateFormat                      | format string used to parse/render a date                                                                                     | %Y-%m-%d | %Y-%m-%d                      |+| dateTimeFormat                  | format string used to parse/render a datetime. (Defaults to [formatISO8601Millis][1] when not provided)                       |          |                   |+| generateEnums                   | Generate specific datatypes for OpenAPI enums                                                                                 | true     | true                   |+| generateFormUrlEncodedInstances | Generate FromForm/ToForm instances for models used by x-www-form-urlencoded operations (model fields must be primitive types) | true     | true |+| generateLenses                  | Generate Lens optics for Models                                                                                               | true     | true                  |+| generateModelConstructors       | Generate smart constructors (only supply required fields) for models                                                          | true     | true       |+| inlineMimeTypes                 | Inline (hardcode) the content-type and accept parameters on operations, when there is only 1 option                           | true     | true                 |+| modelDeriving                   | Additional classes to include in the deriving() clause of Models                                                              |          |                    |+| requestType                     | Set the name of the type used to generate requests                                                                            |          | AWSLambdaRuntimeRequest                     |+| strictFields                    | Add strictness annotations to all model fields                                                                                | true     | true                  |+| useKatip                        | Sets the default value for the UseKatip cabal flag. If true, the katip package provides logging instead of monad-logger       | true     | true                      |++[1]: https://www.stackage.org/haddock/lts-9.0/iso8601-time-0.1.4/Data-Time-ISO8601.html#v:formatISO8601Millis++An example setting _strictFields_ and _dateTimeFormat_:++```+java -jar openapi-generator-cli.jar generate -i petstore.yaml -g haskell-http-client -o output/haskell-http-client -DstrictFields=true -DdateTimeFormat="%Y-%m-%dT%H:%M:%S%Q%z"+```++View the full list of Codegen "config option" parameters with the command:++```+java -jar openapi-generator-cli.jar config-help -g haskell-http-client+```++## Usage Notes++### Example Petstore Haddock documentation++An example of the generated haddock documentation targeting the server http://petstore.swagger.io/ (Petstore) can be found [here][2]++[2]: https://hackage.haskell.org/package/swagger-petstore++### Example Petstore App++An example application using the auto-generated haskell-http-client bindings for the server http://petstore.swagger.io/ can be found [here][3]++[3]: https://github.com/openapitools/openapi-generator/tree/master/samples/client/petstore/haskell-http-client/example-app++This library is intended to be imported qualified.++### Modules++| MODULE              | NOTES                                               |+| ------------------- | --------------------------------------------------- |+| AWSLambdaRuntime.Client    | use the "dispatch" functions to send requests       |+| AWSLambdaRuntime.Core      | core funcions, config and request types             |+| AWSLambdaRuntime.API       | construct api requests                              |+| AWSLambdaRuntime.Model     | describes api models                                |+| AWSLambdaRuntime.MimeTypes | encoding/decoding MIME types (content-types/accept) |+| AWSLambdaRuntime.ModelLens | lenses for model fields                             |+| AWSLambdaRuntime.Logging   | logging functions and utils                         |+++### MimeTypes++This library adds type safety around what OpenAPI specifies as+Produces and Consumes for each Operation (e.g. the list of MIME types an+Operation can Produce (using 'accept' headers) and Consume (using 'content-type' headers).++For example, if there is an Operation named _addFoo_, there will be a+data type generated named _AddFoo_ (note the capitalization), which+describes additional constraints and actions on the _addFoo_ operation+via its typeclass instances. These typeclass instances can be viewed+in GHCi or via the Haddocks.++* required parameters are included as function arguments to _addFoo_+* optional non-body parameters are included by using  `applyOptionalParam`+* optional body parameters are set by using  `setBodyParam`++Example code generated for pretend _addFoo_ operation: ++```haskell+data AddFoo 	+instance Consumes AddFoo MimeJSON+instance Produces AddFoo MimeJSON+instance Produces AddFoo MimeXML+instance HasBodyParam AddFoo FooModel+instance HasOptionalParam AddFoo FooName+instance HasOptionalParam AddFoo FooId+```++this would indicate that:++* the _addFoo_ operation can consume JSON+* the _addFoo_ operation produces JSON or XML, depending on the argument passed to the dispatch function+* the _addFoo_ operation can set it's body param of _FooModel_ via `setBodyParam`+* the _addFoo_ operation can set 2 different optional parameters via `applyOptionalParam`++If the OpenAPI spec doesn't declare it can accept or produce a certain+MIME type for a given Operation, you should either add a Produces or+Consumes instance for the desired MIME types (assuming the server+supports it), use `dispatchLbsUnsafe` or modify the OpenAPI spec and+run the generator again.++New MIME type instances can be added via MimeType/MimeRender/MimeUnrender++Only JSON instances are generated by default, and in some case+x-www-form-urlencoded instances (FromFrom, ToForm) will also be+generated if the model fields are primitive types, and there are+Operations using x-www-form-urlencoded which use those models.++### Authentication++A haskell data type will be generated for each OpenAPI authentication type.++If for example the AuthMethod `AuthOAuthFoo` is generated for OAuth operations, then+`addAuthMethod` should be used to add the AuthMethod config.++When a request is dispatched, if a matching auth method is found in+the config, it will be applied to the request.++### Example++```haskell+mgr <- newManager defaultManagerSettings+config0 <- withStdoutLogging =<< newConfig +let config = config0+    `addAuthMethod` AuthOAuthFoo "secret-key"++let addFooRequest = +  addFoo +    (ContentType MimeJSON) +    (Accept MimeXML) +    (ParamBar paramBar)+    (ParamQux paramQux)+    modelBaz+  `applyOptionalParam` FooId 1+  `applyOptionalParam` FooName "name"+  `setHeader` [("qux_header","xxyy")]+addFooResult <- dispatchMime mgr config addFooRequest+```++See the example app and the haddocks for details.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,31 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime+-}++module AWSLambdaRuntime+  (  module AWSLambdaRuntime.API+  , module AWSLambdaRuntime.Client+  , module AWSLambdaRuntime.Core+  , module AWSLambdaRuntime.Logging+  , module AWSLambdaRuntime.MimeTypes+  , module AWSLambdaRuntime.Model+  , module AWSLambdaRuntime.ModelLens+  ) where++import AWSLambdaRuntime.API+import AWSLambdaRuntime.Client+import AWSLambdaRuntime.Core+import AWSLambdaRuntime.Logging+import AWSLambdaRuntime.MimeTypes+import AWSLambdaRuntime.Model+import AWSLambdaRuntime.ModelLens

@@ -0,0 +1,19 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.API+-}++module AWSLambdaRuntime.API+  ( module AWSLambdaRuntime.API.ApiDefault+  ) where++import AWSLambdaRuntime.API.ApiDefault

@@ -0,0 +1,151 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.API.ApiDefault+-}++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds -fno-warn-unused-imports #-}++module AWSLambdaRuntime.API.ApiDefault where++import AWSLambdaRuntime.Core+import AWSLambdaRuntime.MimeTypes+import AWSLambdaRuntime.Model as M++import qualified Data.Aeson as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)+import qualified Data.Foldable as P+import qualified Data.Map as Map+import qualified Data.Maybe as P+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.Set as Set+import qualified Data.String as P+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Time as TI+import qualified Network.HTTP.Client.MultipartFormData as NH+import qualified Network.HTTP.Media as ME+import qualified Network.HTTP.Types as NH+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Data.Text (Text)+import GHC.Base ((<|>))++import Prelude ((==),(/=),($), (.),(<$>),(<*>),(>>=),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)+import qualified Prelude as P++-- * Operations+++-- ** Default++-- *** runtimeInitErrorPost++-- | @POST \/runtime\/init\/error@+-- +-- Non-recoverable initialization error. Runtime should exit after reporting the error. Error will be served in response to the first invoke. +-- +runtimeInitErrorPost +  :: (Consumes RuntimeInitErrorPost contentType)+  => ContentType contentType -- ^ request content-type ('MimeType')+  -> AWSLambdaRuntimeRequest RuntimeInitErrorPost contentType StatusResponse MimeJSON+runtimeInitErrorPost _ =+  _mkRequest "POST" ["/runtime/init/error"]++data RuntimeInitErrorPost +instance HasBodyParam RuntimeInitErrorPost Body +instance HasOptionalParam RuntimeInitErrorPost LambdaRuntimeFunctionErrorType where+  applyOptionalParam req (LambdaRuntimeFunctionErrorType xs) =+    req `setHeader` toHeader ("Lambda-Runtime-Function-Error-Type", xs)+    +-- | @*/*@+instance MimeType mtype => Consumes RuntimeInitErrorPost mtype++-- | @application/json@+instance Produces RuntimeInitErrorPost MimeJSON+++-- *** runtimeInvocationAwsRequestIdErrorPost++-- | @POST \/runtime\/invocation\/{AwsRequestId}\/error@+-- +-- Runtime makes this request in order to submit an error response. It can be either a function error, or a runtime error. Error will be served in response to the invoke. +-- +runtimeInvocationAwsRequestIdErrorPost +  :: (Consumes RuntimeInvocationAwsRequestIdErrorPost contentType)+  => ContentType contentType -- ^ request content-type ('MimeType')+  -> AwsRequestId -- ^ "awsRequestId"+  -> AWSLambdaRuntimeRequest RuntimeInvocationAwsRequestIdErrorPost contentType StatusResponse MimeJSON+runtimeInvocationAwsRequestIdErrorPost _ (AwsRequestId awsRequestId) =+  _mkRequest "POST" ["/runtime/invocation/",toPath awsRequestId,"/error"]++data RuntimeInvocationAwsRequestIdErrorPost +instance HasBodyParam RuntimeInvocationAwsRequestIdErrorPost Body +instance HasOptionalParam RuntimeInvocationAwsRequestIdErrorPost LambdaRuntimeFunctionErrorType where+  applyOptionalParam req (LambdaRuntimeFunctionErrorType xs) =+    req `setHeader` toHeader ("Lambda-Runtime-Function-Error-Type", xs)+    +-- | @*/*@+instance MimeType mtype => Consumes RuntimeInvocationAwsRequestIdErrorPost mtype++-- | @application/json@+instance Produces RuntimeInvocationAwsRequestIdErrorPost MimeJSON+++-- *** runtimeInvocationAwsRequestIdResponsePost++-- | @POST \/runtime\/invocation\/{AwsRequestId}\/response@+-- +-- Runtime makes this request in order to submit a response.+-- +runtimeInvocationAwsRequestIdResponsePost +  :: (Consumes RuntimeInvocationAwsRequestIdResponsePost contentType)+  => ContentType contentType -- ^ request content-type ('MimeType')+  -> AwsRequestId -- ^ "awsRequestId"+  -> AWSLambdaRuntimeRequest RuntimeInvocationAwsRequestIdResponsePost contentType StatusResponse MimeJSON+runtimeInvocationAwsRequestIdResponsePost _ (AwsRequestId awsRequestId) =+  _mkRequest "POST" ["/runtime/invocation/",toPath awsRequestId,"/response"]++data RuntimeInvocationAwsRequestIdResponsePost +instance HasBodyParam RuntimeInvocationAwsRequestIdResponsePost Body +    +-- | @*/*@+instance MimeType mtype => Consumes RuntimeInvocationAwsRequestIdResponsePost mtype++-- | @application/json@+instance Produces RuntimeInvocationAwsRequestIdResponsePost MimeJSON+++-- *** runtimeInvocationNextGet++-- | @GET \/runtime\/invocation\/next@+-- +-- Runtime makes this HTTP request when it is ready to receive and process a new invoke. +-- +runtimeInvocationNextGet +  :: AWSLambdaRuntimeRequest RuntimeInvocationNextGet MimeNoContent A.Value MimeJSON+runtimeInvocationNextGet =+  _mkRequest "GET" ["/runtime/invocation/next"]++data RuntimeInvocationNextGet  +-- | @application/json@+instance Produces RuntimeInvocationNextGet MimeJSON+

@@ -0,0 +1,217 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.Client+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}++module AWSLambdaRuntime.Client where++import AWSLambdaRuntime.Core+import AWSLambdaRuntime.Logging+import AWSLambdaRuntime.MimeTypes++import qualified Control.Exception.Safe as E+import qualified Control.Monad.IO.Class as P+import qualified Control.Monad as P+import qualified Data.Aeson.Types as A+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BCL+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Client as NH+import qualified Network.HTTP.Client.MultipartFormData as NH+import qualified Network.HTTP.Types as NH+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Data.Function ((&))+import Data.Monoid ((<>))+import Data.Text (Text)+import GHC.Exts (IsString(..))++-- * Dispatch++-- ** Lbs++-- | send a request returning the raw http response+dispatchLbs+  :: (Produces req accept, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> AWSLambdaRuntimeConfig -- ^ config+  -> AWSLambdaRuntimeRequest req contentType res accept -- ^ request+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchLbs manager config request  = do+  initReq <- _toInitRequest config request+  dispatchInitUnsafe manager config initReq++-- ** Mime++-- | pair of decoded http body and http response+data MimeResult res =+  MimeResult { mimeResult :: Either MimeError res -- ^ decoded http body+             , mimeResultResponse :: NH.Response BCL.ByteString -- ^ http response +             }+  deriving (Show, Functor, Foldable, Traversable)++-- | pair of unrender/parser error and http response+data MimeError =+  MimeError {+    mimeError :: String -- ^ unrender/parser error+  , mimeErrorResponse :: NH.Response BCL.ByteString -- ^ http response +  } deriving (Eq, Show)++-- | send a request returning the 'MimeResult'+dispatchMime+  :: forall req contentType res accept. (Produces req accept, MimeUnrender accept res, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> AWSLambdaRuntimeConfig -- ^ config+  -> AWSLambdaRuntimeRequest req contentType res accept -- ^ request+  -> IO (MimeResult res) -- ^ response+dispatchMime manager config request = do+  httpResponse <- dispatchLbs manager config request+  let statusCode = NH.statusCode . NH.responseStatus $ httpResponse+  parsedResult <-+    runConfigLogWithExceptions "Client" config $+    do if (statusCode >= 400 && statusCode < 600)+         then do+           let s = "error statusCode: " ++ show statusCode+           _log "Client" levelError (T.pack s)+           pure (Left (MimeError s httpResponse))+         else case mimeUnrender (P.Proxy :: P.Proxy accept) (NH.responseBody httpResponse) of+           Left s -> do+             _log "Client" levelError (T.pack s)+             pure (Left (MimeError s httpResponse))+           Right r -> pure (Right r)+  return (MimeResult parsedResult httpResponse)++-- | like 'dispatchMime', but only returns the decoded http body+dispatchMime'+  :: (Produces req accept, MimeUnrender accept res, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> AWSLambdaRuntimeConfig -- ^ config+  -> AWSLambdaRuntimeRequest req contentType res accept -- ^ request+  -> IO (Either MimeError res) -- ^ response+dispatchMime' manager config request  = do+    MimeResult parsedResult _ <- dispatchMime manager config request+    return parsedResult++-- ** Unsafe++-- | like 'dispatchReqLbs', but does not validate the operation is a 'Producer' of the "accept" 'MimeType'.  (Useful if the server's response is undocumented)+dispatchLbsUnsafe+  :: (MimeType accept, MimeType contentType)+  => NH.Manager -- ^ http-client Connection manager+  -> AWSLambdaRuntimeConfig -- ^ config+  -> AWSLambdaRuntimeRequest req contentType res accept -- ^ request+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchLbsUnsafe manager config request  = do+  initReq <- _toInitRequest config request+  dispatchInitUnsafe manager config initReq++-- | dispatch an InitRequest+dispatchInitUnsafe+  :: NH.Manager -- ^ http-client Connection manager+  -> AWSLambdaRuntimeConfig -- ^ config+  -> InitRequest req contentType res accept -- ^ init request+  -> IO (NH.Response BCL.ByteString) -- ^ response+dispatchInitUnsafe manager config (InitRequest req) = do+  runConfigLogWithExceptions src config $+    do _log src levelInfo requestLogMsg+       _log src levelDebug requestDbgLogMsg+       res <- P.liftIO $ NH.httpLbs req manager+       _log src levelInfo (responseLogMsg res)+       _log src levelDebug ((T.pack . show) res)+       return res+  where+    src = "Client"+    endpoint =+      T.pack $+      BC.unpack $+      NH.method req <> " " <> NH.host req <> NH.path req <> NH.queryString req+    requestLogMsg = "REQ:" <> endpoint+    requestDbgLogMsg =+      "Headers=" <> (T.pack . show) (NH.requestHeaders req) <> " Body=" <>+      (case NH.requestBody req of+         NH.RequestBodyLBS xs -> T.decodeUtf8 (BL.toStrict xs)+         _ -> "<RequestBody>")+    responseStatusCode = (T.pack . show) . NH.statusCode . NH.responseStatus+    responseLogMsg res =+      "RES:statusCode=" <> responseStatusCode res <> " (" <> endpoint <> ")"++-- * InitRequest++-- | wraps an http-client 'Request' with request/response type parameters+newtype InitRequest req contentType res accept = InitRequest+  { unInitRequest :: NH.Request+  } deriving (Show)++-- |  Build an http-client 'Request' record from the supplied config and request+_toInitRequest+  :: (MimeType accept, MimeType contentType)+  => AWSLambdaRuntimeConfig -- ^ config+  -> AWSLambdaRuntimeRequest req contentType res accept -- ^ request+  -> IO (InitRequest req contentType res accept) -- ^ initialized request+_toInitRequest config req0  = +  runConfigLogWithExceptions "Client" config $ do+    parsedReq <- P.liftIO $ NH.parseRequest $ BCL.unpack $ BCL.append (configHost config) (BCL.concat (rUrlPath req0))+    req1 <- P.liftIO $ _applyAuthMethods req0 config+    P.when+        (configValidateAuthMethods config && (not . null . rAuthTypes) req1)+        (E.throw $ AuthMethodException $ "AuthMethod not configured: " <> (show . head . rAuthTypes) req1)+    let req2 = req1 & _setContentTypeHeader & _setAcceptHeader+        reqHeaders = ("User-Agent", WH.toHeader (configUserAgent config)) : paramsHeaders (rParams req2)+        reqQuery = NH.renderQuery True (paramsQuery (rParams req2))+        pReq = parsedReq { NH.method = (rMethod req2)+                        , NH.requestHeaders = reqHeaders+                        , NH.queryString = reqQuery+                        }+    outReq <- case paramsBody (rParams req2) of+        ParamBodyNone -> pure (pReq { NH.requestBody = mempty })+        ParamBodyB bs -> pure (pReq { NH.requestBody = NH.RequestBodyBS bs })+        ParamBodyBL bl -> pure (pReq { NH.requestBody = NH.RequestBodyLBS bl })+        ParamBodyFormUrlEncoded form -> pure (pReq { NH.requestBody = NH.RequestBodyLBS (WH.urlEncodeForm form) })+        ParamBodyMultipartFormData parts -> NH.formDataBody parts pReq++    pure (InitRequest outReq)++-- | modify the underlying Request+modifyInitRequest :: InitRequest req contentType res accept -> (NH.Request -> NH.Request) -> InitRequest req contentType res accept+modifyInitRequest (InitRequest req) f = InitRequest (f req)++-- | modify the underlying Request (monadic)+modifyInitRequestM :: Monad m => InitRequest req contentType res accept -> (NH.Request -> m NH.Request) -> m (InitRequest req contentType res accept)+modifyInitRequestM (InitRequest req) f = fmap InitRequest (f req)++-- ** Logging ++-- | Run a block using the configured logger instance+runConfigLog+  :: P.MonadIO m+  => AWSLambdaRuntimeConfig -> LogExec m+runConfigLog config = configLogExecWithContext config (configLogContext config)++-- | Run a block using the configured logger instance (logs exceptions)+runConfigLogWithExceptions+  :: (E.MonadCatch m, P.MonadIO m)+  => T.Text -> AWSLambdaRuntimeConfig -> LogExec m+runConfigLogWithExceptions src config = runConfigLog config . logExceptions src

@@ -0,0 +1,544 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.Core+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}++module AWSLambdaRuntime.Core where++import AWSLambdaRuntime.MimeTypes+import AWSLambdaRuntime.Logging++import qualified Control.Arrow as P (left)+import qualified Control.DeepSeq as NF+import qualified Control.Exception.Safe as E+import qualified Data.Aeson as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64.Lazy as BL64+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BCL+import qualified Data.CaseInsensitive as CI+import qualified Data.Data as P (Data, Typeable, TypeRep, typeRep)+import qualified Data.Foldable as P+import qualified Data.Ix as P+import qualified Data.Maybe as P+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Time as TI+import qualified Data.Time.ISO8601 as TI+import qualified GHC.Base as P (Alternative)+import qualified Lens.Micro as L+import qualified Network.HTTP.Client.MultipartFormData as NH+import qualified Network.HTTP.Types as NH+import qualified Prelude as P+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH+import qualified Text.Printf as T++import Control.Applicative ((<|>))+import Control.Applicative (Alternative)+import Data.Function ((&))+import Data.Foldable(foldlM)+import Data.Monoid ((<>))+import Data.Text (Text)+import Prelude (($), (.), (<$>), (<*>), Maybe(..), Bool(..), Char, String, fmap, mempty, pure, return, show, IO, Monad, Functor)++-- * AWSLambdaRuntimeConfig++-- | +data AWSLambdaRuntimeConfig = AWSLambdaRuntimeConfig+  { configHost  :: BCL.ByteString -- ^ host supplied in the Request+  , configUserAgent :: Text -- ^ user-agent supplied in the Request+  , configLogExecWithContext :: LogExecWithContext -- ^ Run a block using a Logger instance+  , configLogContext :: LogContext -- ^ Configures the logger+  , configAuthMethods :: [AnyAuthMethod] -- ^ List of configured auth methods+  , configValidateAuthMethods :: Bool -- ^ throw exceptions if auth methods are not configured+  }++-- | display the config+instance P.Show AWSLambdaRuntimeConfig where+  show c =+    T.printf+      "{ configHost = %v, configUserAgent = %v, ..}"+      (show (configHost c))+      (show (configUserAgent c))++-- | constructs a default AWSLambdaRuntimeConfig+--+-- configHost:+--+-- @http://localhost/2018-06-01@+--+-- configUserAgent:+--+-- @"aws-lambda-runtime/0.1.0.0"@+--+newConfig :: IO AWSLambdaRuntimeConfig+newConfig = do+    logCxt <- initLogContext+    return $ AWSLambdaRuntimeConfig+        { configHost = "http://localhost/2018-06-01"+        , configUserAgent = "aws-lambda-runtime/0.1.0.0"+        , configLogExecWithContext = runDefaultLogExecWithContext+        , configLogContext = logCxt+        , configAuthMethods = []+        , configValidateAuthMethods = True+        }  ++-- | updates config use AuthMethod on matching requests+addAuthMethod :: AuthMethod auth => AWSLambdaRuntimeConfig -> auth -> AWSLambdaRuntimeConfig+addAuthMethod config@AWSLambdaRuntimeConfig {configAuthMethods = as} a =+  config { configAuthMethods = AnyAuthMethod a : as}++-- | updates the config to use stdout logging+withStdoutLogging :: AWSLambdaRuntimeConfig -> IO AWSLambdaRuntimeConfig+withStdoutLogging p = do+    logCxt <- stdoutLoggingContext (configLogContext p)+    return $ p { configLogExecWithContext = stdoutLoggingExec, configLogContext = logCxt }++-- | updates the config to use stderr logging+withStderrLogging :: AWSLambdaRuntimeConfig -> IO AWSLambdaRuntimeConfig+withStderrLogging p = do+    logCxt <- stderrLoggingContext (configLogContext p)+    return $ p { configLogExecWithContext = stderrLoggingExec, configLogContext = logCxt }++-- | updates the config to disable logging+withNoLogging :: AWSLambdaRuntimeConfig -> AWSLambdaRuntimeConfig+withNoLogging p = p { configLogExecWithContext =  runNullLogExec}+ +-- * AWSLambdaRuntimeRequest++-- | Represents a request.+--+--   Type Variables:+--+--   * req - request operation+--   * contentType - 'MimeType' associated with request body+--   * res - response model+--   * accept - 'MimeType' associated with response body+data AWSLambdaRuntimeRequest req contentType res accept = AWSLambdaRuntimeRequest+  { rMethod  :: NH.Method   -- ^ Method of AWSLambdaRuntimeRequest+  , rUrlPath :: [BCL.ByteString] -- ^ Endpoint of AWSLambdaRuntimeRequest+  , rParams   :: Params -- ^ params of AWSLambdaRuntimeRequest+  , rAuthTypes :: [P.TypeRep] -- ^ types of auth methods+  }+  deriving (P.Show)++-- | 'rMethod' Lens+rMethodL :: Lens_' (AWSLambdaRuntimeRequest req contentType res accept) NH.Method+rMethodL f AWSLambdaRuntimeRequest{..} = (\rMethod -> AWSLambdaRuntimeRequest { rMethod, ..} ) <$> f rMethod+{-# INLINE rMethodL #-}++-- | 'rUrlPath' Lens+rUrlPathL :: Lens_' (AWSLambdaRuntimeRequest req contentType res accept) [BCL.ByteString]+rUrlPathL f AWSLambdaRuntimeRequest{..} = (\rUrlPath -> AWSLambdaRuntimeRequest { rUrlPath, ..} ) <$> f rUrlPath+{-# INLINE rUrlPathL #-}++-- | 'rParams' Lens+rParamsL :: Lens_' (AWSLambdaRuntimeRequest req contentType res accept) Params+rParamsL f AWSLambdaRuntimeRequest{..} = (\rParams -> AWSLambdaRuntimeRequest { rParams, ..} ) <$> f rParams+{-# INLINE rParamsL #-}++-- | 'rParams' Lens+rAuthTypesL :: Lens_' (AWSLambdaRuntimeRequest req contentType res accept) [P.TypeRep]+rAuthTypesL f AWSLambdaRuntimeRequest{..} = (\rAuthTypes -> AWSLambdaRuntimeRequest { rAuthTypes, ..} ) <$> f rAuthTypes+{-# INLINE rAuthTypesL #-}++-- * HasBodyParam++-- | Designates the body parameter of a request+class HasBodyParam req param where+  setBodyParam :: forall contentType res accept. (Consumes req contentType, MimeRender contentType param) => AWSLambdaRuntimeRequest req contentType res accept -> param -> AWSLambdaRuntimeRequest req contentType res accept+  setBodyParam req xs =+    req `_setBodyLBS` mimeRender (P.Proxy :: P.Proxy contentType) xs & _setContentTypeHeader++-- * HasOptionalParam++-- | Designates the optional parameters of a request+class HasOptionalParam req param where+  {-# MINIMAL applyOptionalParam | (-&-) #-}++  -- | Apply an optional parameter to a request+  applyOptionalParam :: AWSLambdaRuntimeRequest req contentType res accept -> param -> AWSLambdaRuntimeRequest req contentType res accept+  applyOptionalParam = (-&-)+  {-# INLINE applyOptionalParam #-}++  -- | infix operator \/ alias for 'addOptionalParam'+  (-&-) :: AWSLambdaRuntimeRequest req contentType res accept -> param -> AWSLambdaRuntimeRequest req contentType res accept+  (-&-) = applyOptionalParam+  {-# INLINE (-&-) #-}++infixl 2 -&-++-- | Request Params+data Params = Params+  { paramsQuery :: NH.Query+  , paramsHeaders :: NH.RequestHeaders+  , paramsBody :: ParamBody+  }+  deriving (P.Show)++-- | 'paramsQuery' Lens+paramsQueryL :: Lens_' Params NH.Query+paramsQueryL f Params{..} = (\paramsQuery -> Params { paramsQuery, ..} ) <$> f paramsQuery+{-# INLINE paramsQueryL #-}++-- | 'paramsHeaders' Lens+paramsHeadersL :: Lens_' Params NH.RequestHeaders+paramsHeadersL f Params{..} = (\paramsHeaders -> Params { paramsHeaders, ..} ) <$> f paramsHeaders+{-# INLINE paramsHeadersL #-}++-- | 'paramsBody' Lens+paramsBodyL :: Lens_' Params ParamBody+paramsBodyL f Params{..} = (\paramsBody -> Params { paramsBody, ..} ) <$> f paramsBody+{-# INLINE paramsBodyL #-}++-- | Request Body+data ParamBody+  = ParamBodyNone+  | ParamBodyB B.ByteString+  | ParamBodyBL BL.ByteString+  | ParamBodyFormUrlEncoded WH.Form+  | ParamBodyMultipartFormData [NH.Part]+  deriving (P.Show)++-- ** AWSLambdaRuntimeRequest Utils++_mkRequest :: NH.Method -- ^ Method +          -> [BCL.ByteString] -- ^ Endpoint+          -> AWSLambdaRuntimeRequest req contentType res accept -- ^ req: Request Type, res: Response Type+_mkRequest m u = AWSLambdaRuntimeRequest m u _mkParams []++_mkParams :: Params+_mkParams = Params [] [] ParamBodyNone++setHeader :: AWSLambdaRuntimeRequest req contentType res accept -> [NH.Header] -> AWSLambdaRuntimeRequest req contentType res accept+setHeader req header =+  req `removeHeader` P.fmap P.fst header &+  L.over (rParamsL . paramsHeadersL) (header P.++)++removeHeader :: AWSLambdaRuntimeRequest req contentType res accept -> [NH.HeaderName] -> AWSLambdaRuntimeRequest req contentType res accept+removeHeader req header =+  req &+  L.over+    (rParamsL . paramsHeadersL)+    (P.filter (\h -> cifst h `P.notElem` P.fmap CI.mk header))+  where+    cifst = CI.mk . P.fst+++_setContentTypeHeader :: forall req contentType res accept. MimeType contentType => AWSLambdaRuntimeRequest req contentType res accept -> AWSLambdaRuntimeRequest req contentType res accept+_setContentTypeHeader req =+    case mimeType (P.Proxy :: P.Proxy contentType) of +        Just m -> req `setHeader` [("content-type", BC.pack $ P.show m)]+        Nothing -> req `removeHeader` ["content-type"]++_setAcceptHeader :: forall req contentType res accept. MimeType accept => AWSLambdaRuntimeRequest req contentType res accept -> AWSLambdaRuntimeRequest req contentType res accept+_setAcceptHeader req =+    case mimeType (P.Proxy :: P.Proxy accept) of +        Just m -> req `setHeader` [("accept", BC.pack $ P.show m)]+        Nothing -> req `removeHeader` ["accept"]++setQuery :: AWSLambdaRuntimeRequest req contentType res accept -> [NH.QueryItem] -> AWSLambdaRuntimeRequest req contentType res accept+setQuery req query = +  req &+  L.over+    (rParamsL . paramsQueryL)+    ((query P.++) . P.filter (\q -> cifst q `P.notElem` P.fmap cifst query))+  where+    cifst = CI.mk . P.fst++addForm :: AWSLambdaRuntimeRequest req contentType res accept -> WH.Form -> AWSLambdaRuntimeRequest req contentType res accept+addForm req newform = +    let form = case paramsBody (rParams req) of+            ParamBodyFormUrlEncoded _form -> _form+            _ -> mempty+    in req & L.set (rParamsL . paramsBodyL) (ParamBodyFormUrlEncoded (newform <> form))++_addMultiFormPart :: AWSLambdaRuntimeRequest req contentType res accept -> NH.Part -> AWSLambdaRuntimeRequest req contentType res accept+_addMultiFormPart req newpart = +    let parts = case paramsBody (rParams req) of+            ParamBodyMultipartFormData _parts -> _parts+            _ -> []+    in req & L.set (rParamsL . paramsBodyL) (ParamBodyMultipartFormData (newpart : parts))++_setBodyBS :: AWSLambdaRuntimeRequest req contentType res accept -> B.ByteString -> AWSLambdaRuntimeRequest req contentType res accept+_setBodyBS req body = +    req & L.set (rParamsL . paramsBodyL) (ParamBodyB body)++_setBodyLBS :: AWSLambdaRuntimeRequest req contentType res accept -> BL.ByteString -> AWSLambdaRuntimeRequest req contentType res accept+_setBodyLBS req body = +    req & L.set (rParamsL . paramsBodyL) (ParamBodyBL body)++_hasAuthType :: AuthMethod authMethod => AWSLambdaRuntimeRequest req contentType res accept -> P.Proxy authMethod -> AWSLambdaRuntimeRequest req contentType res accept+_hasAuthType req proxy =+  req & L.over rAuthTypesL (P.typeRep proxy :)++-- ** Params Utils++toPath+  :: WH.ToHttpApiData a+  => a -> BCL.ByteString+toPath = BB.toLazyByteString . WH.toEncodedUrlPiece++toHeader :: WH.ToHttpApiData a => (NH.HeaderName, a) -> [NH.Header]+toHeader x = [fmap WH.toHeader x]++toForm :: WH.ToHttpApiData v => (BC.ByteString, v) -> WH.Form+toForm (k,v) = WH.toForm [(BC.unpack k,v)]++toQuery :: WH.ToHttpApiData a => (BC.ByteString, Maybe a) -> [NH.QueryItem]+toQuery x = [(fmap . fmap) toQueryParam x]+  where toQueryParam = T.encodeUtf8 . WH.toQueryParam++-- *** OpenAPI `CollectionFormat` Utils++-- | Determines the format of the array if type array is used.+data CollectionFormat+  = CommaSeparated -- ^ CSV format for multiple parameters.+  | SpaceSeparated -- ^ Also called "SSV"+  | TabSeparated -- ^ Also called "TSV"+  | PipeSeparated -- ^ `value1|value2|value2`+  | MultiParamArray -- ^ Using multiple GET parameters, e.g. `foo=bar&foo=baz`. This is valid only for parameters in "query" ('NH.Query') or "formData" ('WH.Form')++toHeaderColl :: WH.ToHttpApiData a => CollectionFormat -> (NH.HeaderName, [a]) -> [NH.Header]+toHeaderColl c xs = _toColl c toHeader xs++toFormColl :: WH.ToHttpApiData v => CollectionFormat -> (BC.ByteString, [v]) -> WH.Form+toFormColl c xs = WH.toForm $ fmap unpack $ _toColl c toHeader $ pack xs+  where+    pack (k,v) = (CI.mk k, v)+    unpack (k,v) = (BC.unpack (CI.original k), BC.unpack v)++toQueryColl :: WH.ToHttpApiData a => CollectionFormat -> (BC.ByteString, Maybe [a]) -> NH.Query+toQueryColl c xs = _toCollA c toQuery xs++_toColl :: P.Traversable f => CollectionFormat -> (f a -> [(b, BC.ByteString)]) -> f [a] -> [(b, BC.ByteString)]+_toColl c encode xs = fmap (fmap P.fromJust) (_toCollA' c fencode BC.singleton (fmap Just xs))+  where fencode = fmap (fmap Just) . encode . fmap P.fromJust+        {-# INLINE fencode #-}++_toCollA :: (P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t BC.ByteString)]) -> f (t [a]) -> [(b, t BC.ByteString)]+_toCollA c encode xs = _toCollA' c encode BC.singleton xs++_toCollA' :: (P.Monoid c, P.Traversable f, P.Traversable t, P.Alternative t) => CollectionFormat -> (f (t a) -> [(b, t c)]) -> (Char -> c) -> f (t [a]) -> [(b, t c)]+_toCollA' c encode one xs = case c of+  CommaSeparated -> go (one ',')+  SpaceSeparated -> go (one ' ')+  TabSeparated -> go (one '\t')+  PipeSeparated -> go (one '|')+  MultiParamArray -> expandList+  where+    go sep =+      [P.foldl1 (\(sk, sv) (_, v) -> (sk, (combine sep <$> sv <*> v) <|> sv <|> v)) expandList]+    combine sep x y = x <> sep <> y+    expandList = (P.concatMap encode . (P.traverse . P.traverse) P.toList) xs+    {-# INLINE go #-}+    {-# INLINE expandList #-}+    {-# INLINE combine #-}+  +-- * AuthMethods++-- | Provides a method to apply auth methods to requests+class P.Typeable a =>+      AuthMethod a  where+  applyAuthMethod+    :: AWSLambdaRuntimeConfig+    -> a+    -> AWSLambdaRuntimeRequest req contentType res accept+    -> IO (AWSLambdaRuntimeRequest req contentType res accept)++-- | An existential wrapper for any AuthMethod+data AnyAuthMethod = forall a. AuthMethod a => AnyAuthMethod a deriving (P.Typeable)++instance AuthMethod AnyAuthMethod where applyAuthMethod config (AnyAuthMethod a) req = applyAuthMethod config a req++-- | indicates exceptions related to AuthMethods+data AuthMethodException = AuthMethodException String deriving (P.Show, P.Typeable)++instance E.Exception AuthMethodException++-- | apply all matching AuthMethods in config to request+_applyAuthMethods+  :: AWSLambdaRuntimeRequest req contentType res accept+  -> AWSLambdaRuntimeConfig+  -> IO (AWSLambdaRuntimeRequest req contentType res accept)+_applyAuthMethods req config@(AWSLambdaRuntimeConfig {configAuthMethods = as}) =+  foldlM go req as+  where+    go r (AnyAuthMethod a) = applyAuthMethod config a r+  +-- * Utils++-- | Removes Null fields.  (OpenAPI-Specification 2.0 does not allow Null in JSON)+_omitNulls :: [(Text, A.Value)] -> A.Value+_omitNulls = A.object . P.filter notNull+  where+    notNull (_, A.Null) = False+    notNull _ = True++-- | Encodes fields using WH.toQueryParam+_toFormItem :: (WH.ToHttpApiData a, Functor f) => t -> f a -> f (t, [Text])+_toFormItem name x = (name,) . (:[]) . WH.toQueryParam <$> x++-- | Collapse (Just "") to Nothing+_emptyToNothing :: Maybe String -> Maybe String+_emptyToNothing (Just "") = Nothing+_emptyToNothing x = x+{-# INLINE _emptyToNothing #-}++-- | Collapse (Just mempty) to Nothing+_memptyToNothing :: (P.Monoid a, P.Eq a) => Maybe a -> Maybe a+_memptyToNothing (Just x) | x P.== P.mempty = Nothing+_memptyToNothing x = x+{-# INLINE _memptyToNothing #-}++-- * DateTime Formatting++newtype DateTime = DateTime { unDateTime :: TI.UTCTime }+  deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData,TI.ParseTime,TI.FormatTime)+instance A.FromJSON DateTime where+  parseJSON = A.withText "DateTime" (_readDateTime . T.unpack)+instance A.ToJSON DateTime where+  toJSON (DateTime t) = A.toJSON (_showDateTime t)+instance WH.FromHttpApiData DateTime where+  parseUrlPiece = P.left T.pack . _readDateTime . T.unpack+instance WH.ToHttpApiData DateTime where+  toUrlPiece (DateTime t) = T.pack (_showDateTime t)+instance P.Show DateTime where+  show (DateTime t) = _showDateTime t+instance MimeRender MimeMultipartFormData DateTime where+  mimeRender _ = mimeRenderDefaultMultipartFormData++-- | @_parseISO8601@+_readDateTime :: (TI.ParseTime t, Monad m, Alternative m) => String -> m t+_readDateTime =+  _parseISO8601+{-# INLINE _readDateTime #-}++-- | @TI.formatISO8601Millis@+_showDateTime :: (t ~ TI.UTCTime, TI.FormatTime t) => t -> String+_showDateTime =+  TI.formatISO8601Millis+{-# INLINE _showDateTime #-}++-- | parse an ISO8601 date-time string+_parseISO8601 :: (TI.ParseTime t, Monad m, Alternative m) => String -> m t+_parseISO8601 t =+  P.asum $+  P.flip (TI.parseTimeM True TI.defaultTimeLocale) t <$>+  ["%FT%T%QZ", "%FT%T%Q%z", "%FT%T%Q%Z"]+{-# INLINE _parseISO8601 #-}++-- * Date Formatting++newtype Date = Date { unDate :: TI.Day }+  deriving (P.Enum,P.Eq,P.Data,P.Ord,P.Ix,NF.NFData,TI.ParseTime,TI.FormatTime)+instance A.FromJSON Date where+  parseJSON = A.withText "Date" (_readDate . T.unpack)+instance A.ToJSON Date where+  toJSON (Date t) = A.toJSON (_showDate t)+instance WH.FromHttpApiData Date where+  parseUrlPiece = P.left T.pack . _readDate . T.unpack+instance WH.ToHttpApiData Date where+  toUrlPiece (Date t) = T.pack (_showDate t)+instance P.Show Date where+  show (Date t) = _showDate t+instance MimeRender MimeMultipartFormData Date where+  mimeRender _ = mimeRenderDefaultMultipartFormData++-- | @TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"@+_readDate :: (TI.ParseTime t, Monad m) => String -> m t+_readDate =+  TI.parseTimeM True TI.defaultTimeLocale "%Y-%m-%d"+{-# INLINE _readDate #-}++-- | @TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"@+_showDate :: TI.FormatTime t => t -> String+_showDate =+  TI.formatTime TI.defaultTimeLocale "%Y-%m-%d"+{-# INLINE _showDate #-}++-- * Byte/Binary Formatting++  +-- | base64 encoded characters+newtype ByteArray = ByteArray { unByteArray :: BL.ByteString }+  deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)++instance A.FromJSON ByteArray where+  parseJSON = A.withText "ByteArray" _readByteArray+instance A.ToJSON ByteArray where+  toJSON = A.toJSON . _showByteArray+instance WH.FromHttpApiData ByteArray where+  parseUrlPiece = P.left T.pack . _readByteArray+instance WH.ToHttpApiData ByteArray where+  toUrlPiece = _showByteArray+instance P.Show ByteArray where+  show = T.unpack . _showByteArray+instance MimeRender MimeMultipartFormData ByteArray where+  mimeRender _ = mimeRenderDefaultMultipartFormData++-- | read base64 encoded characters+_readByteArray :: Monad m => Text -> m ByteArray+_readByteArray = P.either P.fail (pure . ByteArray) . BL64.decode . BL.fromStrict . T.encodeUtf8+{-# INLINE _readByteArray #-}++-- | show base64 encoded characters+_showByteArray :: ByteArray -> Text+_showByteArray = T.decodeUtf8 . BL.toStrict . BL64.encode . unByteArray+{-# INLINE _showByteArray #-}++-- | any sequence of octets+newtype Binary = Binary { unBinary :: BL.ByteString }+  deriving (P.Eq,P.Data,P.Ord,P.Typeable,NF.NFData)++instance A.FromJSON Binary where+  parseJSON = A.withText "Binary" _readBinaryBase64+instance A.ToJSON Binary where+  toJSON = A.toJSON . _showBinaryBase64+instance WH.FromHttpApiData Binary where+  parseUrlPiece = P.left T.pack . _readBinaryBase64+instance WH.ToHttpApiData Binary where+  toUrlPiece = _showBinaryBase64+instance P.Show Binary where+  show = T.unpack . _showBinaryBase64+instance MimeRender MimeMultipartFormData Binary where+  mimeRender _ = unBinary++_readBinaryBase64 :: Monad m => Text -> m Binary+_readBinaryBase64 = P.either P.fail (pure . Binary) . BL64.decode . BL.fromStrict . T.encodeUtf8+{-# INLINE _readBinaryBase64 #-}++_showBinaryBase64 :: Binary -> Text+_showBinaryBase64 = T.decodeUtf8 . BL.toStrict . BL64.encode . unBinary+{-# INLINE _showBinaryBase64 #-}++-- * Lens Type Aliases++type Lens_' s a = Lens_ s s a a+type Lens_ s t a b = forall (f :: * -> *). Functor f => (a -> f b) -> s -> f t

@@ -0,0 +1,33 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.Logging+Logging functions+-}+{-# LANGUAGE CPP #-}++#ifdef USE_KATIP++module AWSLambdaRuntime.Logging+  ( module AWSLambdaRuntime.LoggingKatip+  ) where++import AWSLambdaRuntime.LoggingKatip++#else++module AWSLambdaRuntime.Logging+  ( module AWSLambdaRuntime.LoggingMonadLogger+  ) where++import AWSLambdaRuntime.LoggingMonadLogger++#endif

@@ -0,0 +1,118 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.LoggingKatip+Katip Logging functions+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module AWSLambdaRuntime.LoggingKatip where++import qualified Control.Exception.Safe as E+import qualified Control.Monad.IO.Class as P+import qualified Control.Monad.Trans.Reader as P+import qualified Data.Text as T+import qualified Lens.Micro as L+import qualified System.IO as IO++import Data.Text (Text)+import GHC.Exts (IsString(..))++import qualified Katip as LG++-- * Type Aliases (for compatibility)++-- | Runs a Katip logging block with the Log environment+type LogExecWithContext = forall m. P.MonadIO m =>+                                    LogContext -> LogExec m++-- | A Katip logging block+type LogExec m = forall a. LG.KatipT m a -> m a++-- | A Katip Log environment+type LogContext = LG.LogEnv++-- | A Katip Log severity+type LogLevel = LG.Severity++-- * default logger++-- | the default log environment+initLogContext :: IO LogContext+initLogContext = LG.initLogEnv "AWSLambdaRuntime" "dev"++-- | Runs a Katip logging block with the Log environment+runDefaultLogExecWithContext :: LogExecWithContext+runDefaultLogExecWithContext = LG.runKatipT++-- * stdout logger++-- | Runs a Katip logging block with the Log environment+stdoutLoggingExec :: LogExecWithContext+stdoutLoggingExec = runDefaultLogExecWithContext++-- | A Katip Log environment which targets stdout+stdoutLoggingContext :: LogContext -> IO LogContext+stdoutLoggingContext cxt = do+    handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stdout (LG.permitItem LG.InfoS) LG.V2+    LG.registerScribe "stdout" handleScribe LG.defaultScribeSettings cxt++-- * stderr logger++-- | Runs a Katip logging block with the Log environment+stderrLoggingExec :: LogExecWithContext+stderrLoggingExec = runDefaultLogExecWithContext++-- | A Katip Log environment which targets stderr+stderrLoggingContext :: LogContext -> IO LogContext+stderrLoggingContext cxt = do+    handleScribe <- LG.mkHandleScribe LG.ColorIfTerminal IO.stderr (LG.permitItem LG.InfoS) LG.V2+    LG.registerScribe "stderr" handleScribe LG.defaultScribeSettings cxt++-- * Null logger++-- | Disables Katip logging+runNullLogExec :: LogExecWithContext+runNullLogExec le (LG.KatipT f) = P.runReaderT f (L.set LG.logEnvScribes mempty le)++-- * Log Msg++-- | Log a katip message+_log :: (Applicative m, LG.Katip m) => Text -> LogLevel -> Text -> m ()+_log src level msg = do+  LG.logMsg (fromString $ T.unpack src) level (LG.logStr msg)++-- * Log Exceptions++-- | re-throws exceptions after logging them+logExceptions+  :: (LG.Katip m, E.MonadCatch m, Applicative m)+  => Text -> m a -> m a+logExceptions src =+  E.handle+    (\(e :: E.SomeException) -> do+       _log src LG.ErrorS ((T.pack . show) e)+       E.throw e)++-- * Log Level++levelInfo :: LogLevel+levelInfo = LG.InfoS++levelError :: LogLevel+levelError = LG.ErrorS++levelDebug :: LogLevel+levelDebug = LG.DebugS+

@@ -0,0 +1,127 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.LoggingMonadLogger+monad-logger Logging functions+-}++{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++module AWSLambdaRuntime.LoggingMonadLogger where++import qualified Control.Exception.Safe as E+import qualified Control.Monad.IO.Class as P+import qualified Data.Text as T+import qualified Data.Time as TI++import Data.Monoid ((<>))+import Data.Text (Text)++import qualified Control.Monad.Logger as LG++-- * Type Aliases (for compatibility)++-- | Runs a monad-logger  block with the filter predicate+type LogExecWithContext = forall m. P.MonadIO m =>+                                    LogContext -> LogExec m++-- | A monad-logger block+type LogExec m = forall a. LG.LoggingT m a -> m a++-- | A monad-logger filter predicate+type LogContext = LG.LogSource -> LG.LogLevel -> Bool++-- | A monad-logger log level+type LogLevel = LG.LogLevel++-- * default logger++-- | the default log environment+initLogContext :: IO LogContext+initLogContext = pure infoLevelFilter++-- | Runs a monad-logger block with the filter predicate+runDefaultLogExecWithContext :: LogExecWithContext+runDefaultLogExecWithContext = runNullLogExec++-- * stdout logger++-- | Runs a monad-logger block targeting stdout, with the filter predicate+stdoutLoggingExec :: LogExecWithContext+stdoutLoggingExec cxt = LG.runStdoutLoggingT . LG.filterLogger cxt++-- | @pure@+stdoutLoggingContext :: LogContext -> IO LogContext+stdoutLoggingContext = pure++-- * stderr logger++-- | Runs a monad-logger block targeting stderr, with the filter predicate+stderrLoggingExec :: LogExecWithContext+stderrLoggingExec cxt = LG.runStderrLoggingT . LG.filterLogger cxt++-- | @pure@+stderrLoggingContext :: LogContext -> IO LogContext+stderrLoggingContext = pure++-- * Null logger++-- | Disables monad-logger logging+runNullLogExec :: LogExecWithContext+runNullLogExec = const (`LG.runLoggingT` nullLogger)++-- | monad-logger which does nothing+nullLogger :: LG.Loc -> LG.LogSource -> LG.LogLevel -> LG.LogStr -> IO ()+nullLogger _ _ _ _ = return ()++-- * Log Msg++-- | Log a message using the current time+_log :: (P.MonadIO m, LG.MonadLogger m) => Text -> LG.LogLevel -> Text -> m ()+_log src level msg = do+  now <- P.liftIO (formatTimeLog <$> TI.getCurrentTime)+  LG.logOtherNS ("AWSLambdaRuntime." <> src) level ("[" <> now <> "] " <> msg)+ where+  formatTimeLog =+    T.pack . TI.formatTime TI.defaultTimeLocale "%Y-%m-%dT%H:%M:%S%Z"++-- * Log Exceptions++-- | re-throws exceptions after logging them+logExceptions+   :: (LG.MonadLogger m, E.MonadCatch m, P.MonadIO m)+   => Text -> m a -> m a+logExceptions src =+   E.handle+     (\(e :: E.SomeException) -> do+        _log src LG.LevelError ((T.pack . show) e)+        E.throw e)++-- * Log Level++levelInfo :: LogLevel+levelInfo = LG.LevelInfo++levelError :: LogLevel+levelError = LG.LevelError++levelDebug :: LogLevel+levelDebug = LG.LevelDebug++-- * Level Filter++minLevelFilter :: LG.LogLevel -> LG.LogSource -> LG.LogLevel -> Bool+minLevelFilter l _ l' = l' >= l++infoLevelFilter :: LG.LogSource -> LG.LogLevel -> Bool+infoLevelFilter = minLevelFilter LG.LevelInfo

@@ -0,0 +1,203 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.MimeTypes+-}++{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE ExistentialQuantification #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-unused-imports #-}++module AWSLambdaRuntime.MimeTypes where++import qualified Control.Arrow as P (left)+import qualified Data.Aeson as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Builder as BB+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.ByteString.Lazy.Char8 as BCL+import qualified Data.Data as P (Typeable)+import qualified Data.Proxy as P (Proxy(..))+import qualified Data.String as P+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Network.HTTP.Media as ME+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Prelude (($), (.),(<$>),(<*>),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty)+import qualified Prelude as P++-- * ContentType MimeType++data ContentType a = MimeType a => ContentType { unContentType :: a }++-- * Accept MimeType++data Accept a = MimeType a => Accept { unAccept :: a }++-- * Consumes Class++class MimeType mtype => Consumes req mtype where++-- * Produces Class++class MimeType mtype => Produces req mtype where++-- * Default Mime Types++data MimeJSON = MimeJSON deriving (P.Typeable)+data MimeXML = MimeXML deriving (P.Typeable)+data MimePlainText = MimePlainText deriving (P.Typeable)+data MimeFormUrlEncoded = MimeFormUrlEncoded deriving (P.Typeable)+data MimeMultipartFormData = MimeMultipartFormData deriving (P.Typeable)+data MimeOctetStream = MimeOctetStream deriving (P.Typeable)+data MimeNoContent = MimeNoContent deriving (P.Typeable)+data MimeAny = MimeAny deriving (P.Typeable)++-- | A type for responses without content-body.+data NoContent = NoContent+  deriving (P.Show, P.Eq, P.Typeable)+++-- * MimeType Class++class P.Typeable mtype => MimeType mtype  where+  {-# MINIMAL mimeType | mimeTypes #-}++  mimeTypes :: P.Proxy mtype -> [ME.MediaType]+  mimeTypes p =+    case mimeType p of+      Just x -> [x]+      Nothing -> []++  mimeType :: P.Proxy mtype -> Maybe ME.MediaType+  mimeType p =+    case mimeTypes p of+      [] -> Nothing+      (x:_) -> Just x++  mimeType' :: mtype -> Maybe ME.MediaType+  mimeType' _ = mimeType (P.Proxy :: P.Proxy mtype)+  mimeTypes' :: mtype -> [ME.MediaType]+  mimeTypes' _ = mimeTypes (P.Proxy :: P.Proxy mtype)++-- Default MimeType Instances++-- | @application/json; charset=utf-8@+instance MimeType MimeJSON where+  mimeType _ = Just $ P.fromString "application/json"+-- | @application/xml; charset=utf-8@+instance MimeType MimeXML where+  mimeType _ = Just $ P.fromString "application/xml"+-- | @application/x-www-form-urlencoded@+instance MimeType MimeFormUrlEncoded where+  mimeType _ = Just $ P.fromString "application/x-www-form-urlencoded"+-- | @multipart/form-data@+instance MimeType MimeMultipartFormData where+  mimeType _ = Just $ P.fromString "multipart/form-data"+-- | @text/plain; charset=utf-8@+instance MimeType MimePlainText where+  mimeType _ = Just $ P.fromString "text/plain"+-- | @application/octet-stream@+instance MimeType MimeOctetStream where+  mimeType _ = Just $ P.fromString "application/octet-stream"+-- | @"*/*"@+instance MimeType MimeAny where+  mimeType _ = Just $ P.fromString "*/*"+instance MimeType MimeNoContent where+  mimeType _ = Nothing++-- * MimeRender Class++class MimeType mtype => MimeRender mtype x where+    mimeRender  :: P.Proxy mtype -> x -> BL.ByteString+    mimeRender' :: mtype -> x -> BL.ByteString+    mimeRender' _ x = mimeRender (P.Proxy :: P.Proxy mtype) x+++mimeRenderDefaultMultipartFormData :: WH.ToHttpApiData a => a -> BL.ByteString+mimeRenderDefaultMultipartFormData = BL.fromStrict . T.encodeUtf8 . WH.toQueryParam++-- Default MimeRender Instances++-- | `A.encode`+instance A.ToJSON a => MimeRender MimeJSON a where mimeRender _ = A.encode+-- | @WH.urlEncodeAsForm@+instance WH.ToForm a => MimeRender MimeFormUrlEncoded a where mimeRender _ = WH.urlEncodeAsForm++-- | @P.id@+instance MimeRender MimePlainText BL.ByteString where mimeRender _ = P.id+-- | @BL.fromStrict . T.encodeUtf8@+instance MimeRender MimePlainText T.Text where mimeRender _ = BL.fromStrict . T.encodeUtf8+-- | @BCL.pack@+instance MimeRender MimePlainText String where mimeRender _ = BCL.pack++-- | @P.id@+instance MimeRender MimeOctetStream BL.ByteString where mimeRender _ = P.id+-- | @BL.fromStrict . T.encodeUtf8@+instance MimeRender MimeOctetStream T.Text where mimeRender _ = BL.fromStrict . T.encodeUtf8+-- | @BCL.pack@+instance MimeRender MimeOctetStream String where mimeRender _ = BCL.pack++instance MimeRender MimeMultipartFormData BL.ByteString where mimeRender _ = P.id++instance MimeRender MimeMultipartFormData Bool where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Char where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Double where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Float where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Int where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData Integer where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData String where mimeRender _ = mimeRenderDefaultMultipartFormData+instance MimeRender MimeMultipartFormData T.Text where mimeRender _ = mimeRenderDefaultMultipartFormData++-- | @P.Right . P.const NoContent@+instance MimeRender MimeNoContent NoContent where mimeRender _ = P.const BCL.empty+++-- * MimeUnrender Class++class MimeType mtype => MimeUnrender mtype o where+    mimeUnrender :: P.Proxy mtype -> BL.ByteString -> P.Either String o+    mimeUnrender' :: mtype -> BL.ByteString -> P.Either String o+    mimeUnrender' _ x = mimeUnrender (P.Proxy :: P.Proxy mtype) x++-- Default MimeUnrender Instances++-- | @A.eitherDecode@+instance A.FromJSON a => MimeUnrender MimeJSON a where mimeUnrender _ = A.eitherDecode+-- | @P.left T.unpack . WH.urlDecodeAsForm@+instance WH.FromForm a => MimeUnrender MimeFormUrlEncoded a where mimeUnrender _ = P.left T.unpack . WH.urlDecodeAsForm+-- | @P.Right . P.id@++instance MimeUnrender MimePlainText BL.ByteString where mimeUnrender _ = P.Right . P.id+-- | @P.left P.show . TL.decodeUtf8'@+instance MimeUnrender MimePlainText T.Text where mimeUnrender _ = P.left P.show . T.decodeUtf8' . BL.toStrict+-- | @P.Right . BCL.unpack@+instance MimeUnrender MimePlainText String where mimeUnrender _ = P.Right . BCL.unpack++-- | @P.Right . P.id@+instance MimeUnrender MimeOctetStream BL.ByteString where mimeUnrender _ = P.Right . P.id+-- | @P.left P.show . T.decodeUtf8' . BL.toStrict@+instance MimeUnrender MimeOctetStream T.Text where mimeUnrender _ = P.left P.show . T.decodeUtf8' . BL.toStrict+-- | @P.Right . BCL.unpack@+instance MimeUnrender MimeOctetStream String where mimeUnrender _ = P.Right . BCL.unpack++-- | @P.Right . P.const NoContent@+instance MimeUnrender MimeNoContent NoContent where mimeUnrender _ = P.Right . P.const NoContent++

@@ -0,0 +1,180 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.Model+-}++{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeFamilies #-}+{-# OPTIONS_GHC -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}++module AWSLambdaRuntime.Model where++import AWSLambdaRuntime.Core+import AWSLambdaRuntime.MimeTypes++import Data.Aeson ((.:),(.:!),(.:?),(.=))++import qualified Control.Arrow as P (left)+import qualified Data.Aeson as A+import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as BL+import qualified Data.Data as P (Typeable, TypeRep, typeOf, typeRep)+import qualified Data.Foldable as P+import qualified Data.HashMap.Lazy as HM+import qualified Data.Map as Map+import qualified Data.Maybe as P+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Data.Time as TI+import qualified Lens.Micro as L+import qualified Web.FormUrlEncoded as WH+import qualified Web.HttpApiData as WH++import Control.Applicative ((<|>))+import Control.Applicative (Alternative)+import Data.Function ((&))+import Data.Monoid ((<>))+import Data.Text (Text)+import Prelude (($),(/=),(.),(<$>),(<*>),(>>=),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)++import qualified Prelude as P++++-- * Parameter newtypes+++-- ** AwsRequestId+newtype AwsRequestId = AwsRequestId { unAwsRequestId :: Text } deriving (P.Eq, P.Show)++-- ** Body+newtype Body = Body { unBody :: A.Value } deriving (P.Eq, P.Show, A.ToJSON)++-- ** LambdaRuntimeFunctionErrorType+newtype LambdaRuntimeFunctionErrorType = LambdaRuntimeFunctionErrorType { unLambdaRuntimeFunctionErrorType :: Text } deriving (P.Eq, P.Show)++-- * Models+++-- ** ErrorRequest+-- | ErrorRequest+data ErrorRequest = ErrorRequest+  { errorRequestErrorMessage :: !(Maybe Text) -- ^ "errorMessage"+  , errorRequestErrorType :: !(Maybe Text) -- ^ "errorType"+  , errorRequestStackTrace :: !(Maybe [Text]) -- ^ "stackTrace"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON ErrorRequest+instance A.FromJSON ErrorRequest where+  parseJSON = A.withObject "ErrorRequest" $ \o ->+    ErrorRequest+      <$> (o .:? "errorMessage")+      <*> (o .:? "errorType")+      <*> (o .:? "stackTrace")++-- | ToJSON ErrorRequest+instance A.ToJSON ErrorRequest where+  toJSON ErrorRequest {..} =+   _omitNulls+      [ "errorMessage" .= errorRequestErrorMessage+      , "errorType" .= errorRequestErrorType+      , "stackTrace" .= errorRequestStackTrace+      ]+++-- | Construct a value of type 'ErrorRequest' (by applying it's required fields, if any)+mkErrorRequest+  :: ErrorRequest+mkErrorRequest =+  ErrorRequest+  { errorRequestErrorMessage = Nothing+  , errorRequestErrorType = Nothing+  , errorRequestStackTrace = Nothing+  }++-- ** ErrorResponse+-- | ErrorResponse+data ErrorResponse = ErrorResponse+  { errorResponseErrorMessage :: !(Maybe Text) -- ^ "errorMessage"+  , errorResponseErrorType :: !(Maybe Text) -- ^ "errorType"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON ErrorResponse+instance A.FromJSON ErrorResponse where+  parseJSON = A.withObject "ErrorResponse" $ \o ->+    ErrorResponse+      <$> (o .:? "errorMessage")+      <*> (o .:? "errorType")++-- | ToJSON ErrorResponse+instance A.ToJSON ErrorResponse where+  toJSON ErrorResponse {..} =+   _omitNulls+      [ "errorMessage" .= errorResponseErrorMessage+      , "errorType" .= errorResponseErrorType+      ]+++-- | Construct a value of type 'ErrorResponse' (by applying it's required fields, if any)+mkErrorResponse+  :: ErrorResponse+mkErrorResponse =+  ErrorResponse+  { errorResponseErrorMessage = Nothing+  , errorResponseErrorType = Nothing+  }++-- ** StatusResponse+-- | StatusResponse+data StatusResponse = StatusResponse+  { statusResponseStatus :: !(Maybe Text) -- ^ "status"+  } deriving (P.Show, P.Eq, P.Typeable)++-- | FromJSON StatusResponse+instance A.FromJSON StatusResponse where+  parseJSON = A.withObject "StatusResponse" $ \o ->+    StatusResponse+      <$> (o .:? "status")++-- | ToJSON StatusResponse+instance A.ToJSON StatusResponse where+  toJSON StatusResponse {..} =+   _omitNulls+      [ "status" .= statusResponseStatus+      ]+++-- | Construct a value of type 'StatusResponse' (by applying it's required fields, if any)+mkStatusResponse+  :: StatusResponse+mkStatusResponse =+  StatusResponse+  { statusResponseStatus = Nothing+  }+++++

@@ -0,0 +1,79 @@+{-+   AWS Lambda Runtime API++   AWS Lambda Runtime API is an HTTP API for implementing custom runtimes++   OpenAPI Version: 3.0.0+   AWS Lambda Runtime API API version: 1.0.3+   Generated by OpenAPI Generator (https://openapi-generator.tech)+-}++{-|+Module : AWSLambdaRuntime.Lens+-}++{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-matches -fno-warn-unused-binds -fno-warn-unused-imports #-}++module AWSLambdaRuntime.ModelLens where++import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy as BL+import qualified Data.Data as P (Data, Typeable)+import qualified Data.Map as Map+import qualified Data.Set as Set+import qualified Data.Time as TI++import Data.Text (Text)++import Prelude (($), (.),(<$>),(<*>),(=<<),Maybe(..),Bool(..),Char,Double,FilePath,Float,Int,Integer,String,fmap,undefined,mempty,maybe,pure,Monad,Applicative,Functor)+import qualified Prelude as P++import AWSLambdaRuntime.Model+import AWSLambdaRuntime.Core+++-- * ErrorRequest++-- | 'errorRequestErrorMessage' Lens+errorRequestErrorMessageL :: Lens_' ErrorRequest (Maybe Text)+errorRequestErrorMessageL f ErrorRequest{..} = (\errorRequestErrorMessage -> ErrorRequest { errorRequestErrorMessage, ..} ) <$> f errorRequestErrorMessage+{-# INLINE errorRequestErrorMessageL #-}++-- | 'errorRequestErrorType' Lens+errorRequestErrorTypeL :: Lens_' ErrorRequest (Maybe Text)+errorRequestErrorTypeL f ErrorRequest{..} = (\errorRequestErrorType -> ErrorRequest { errorRequestErrorType, ..} ) <$> f errorRequestErrorType+{-# INLINE errorRequestErrorTypeL #-}++-- | 'errorRequestStackTrace' Lens+errorRequestStackTraceL :: Lens_' ErrorRequest (Maybe [Text])+errorRequestStackTraceL f ErrorRequest{..} = (\errorRequestStackTrace -> ErrorRequest { errorRequestStackTrace, ..} ) <$> f errorRequestStackTrace+{-# INLINE errorRequestStackTraceL #-}++++-- * ErrorResponse++-- | 'errorResponseErrorMessage' Lens+errorResponseErrorMessageL :: Lens_' ErrorResponse (Maybe Text)+errorResponseErrorMessageL f ErrorResponse{..} = (\errorResponseErrorMessage -> ErrorResponse { errorResponseErrorMessage, ..} ) <$> f errorResponseErrorMessage+{-# INLINE errorResponseErrorMessageL #-}++-- | 'errorResponseErrorType' Lens+errorResponseErrorTypeL :: Lens_' ErrorResponse (Maybe Text)+errorResponseErrorTypeL f ErrorResponse{..} = (\errorResponseErrorType -> ErrorResponse { errorResponseErrorType, ..} ) <$> f errorResponseErrorType+{-# INLINE errorResponseErrorTypeL #-}++++-- * StatusResponse++-- | 'statusResponseStatus' Lens+statusResponseStatusL :: Lens_' StatusResponse (Maybe Text)+statusResponseStatusL f StatusResponse{..} = (\statusResponseStatus -> StatusResponse { statusResponseStatus, ..} ) <$> f statusResponseStatus+{-# INLINE statusResponseStatusL #-}++

@@ -0,0 +1,147 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+module Zeit.Now+  ( NowInput(..)+  , NowOutput(..)+  , NowOutputBody(..)+  , EventHandler+  , runloop+  , module Network.HTTP.Types.Header+  , module Network.HTTP.Types.Method+  , module Network.HTTP.Types.Status+  ) where++import Control.Exception+import Control.Monad+import qualified Data.Aeson as A+import AWSLambdaRuntime+import Data.ByteString.Char8 (ByteString)+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.CaseInsensitive as CI+import qualified Data.HashMap.Strict as H+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import GHC.Stack+import System.Environment+import Data.ByteArray.Encoding+import Network.HTTP.Client+import Network.HTTP.Types.Header (HeaderName)+import Network.HTTP.Types.Method (Method)+import Network.HTTP.Types.Status+import Network.Wai.Internal+-- import Text.Show.Pretty++type EventHandler i o = i -> IO o++hostPath :: L.ByteString+hostPath = "/2018-06-01"++data NowInput = NowInput+  { nowInputMethod :: Method+  , nowInputHost :: T.Text+  , nowInputPath :: T.Text+  , nowInputHeaders :: H.HashMap HeaderName ByteString+  , nowInputEncoding :: T.Text+  , nowInputBody :: T.Text+  } deriving (Show, Eq)++instance A.FromJSON NowInput where+  parseJSON = A.withObject "NowInput" $ \o -> do+    nowInputMethod <- T.encodeUtf8 <$> o A..: "method"+    nowInputHost <- o A..: "host"+    nowInputPath <- o A..: "path"+    textHeaders' <- o A..: "headers"+    let nowInputHeaders = H.fromList $+          map (\(k, v) ->+                 ( CI.mk $ T.encodeUtf8 k+                 , T.encodeUtf8 v+                 )) $ H.toList textHeaders'+    nowInputEncoding <- o A..: "encoding"+    nowInputBody <- o A..: "body"+    pure $ NowInput{..}+++postRuntimeError :: Manager -> AWSLambdaRuntimeConfig -> AwsRequestId -> SomeException -> IO ()+postRuntimeError man conf req e =+  void $ do+    let cs = callStack+    strTrace <- case getCallStack cs of+      [] -> map T.pack <$> whoCreated e+      items -> pure $ T.lines $ T.pack $ prettyCallStack cs+    void $ dispatchLbs man conf $+      setBodyParam+        (runtimeInvocationAwsRequestIdErrorPost (ContentType MimeJSON) req) $ Body $ A.toJSON $+          ErrorRequest+          { errorRequestErrorMessage = Just $ T.pack $ show e+          , errorRequestErrorType = Nothing+          , errorRequestStackTrace = Just strTrace+          }+    -- print resp++runloop :: EventHandler NowInput NowOutput -> IO ()+runloop h = do+  man <- newManager defaultManagerSettings+  __conf <- newConfig+  apiEndpoint <- getEnv "AWS_LAMBDA_RUNTIME_API"+  let conf = __conf { configHost = "http://" <> L.pack apiEndpoint <> hostPath }+  forever $ do+    nextResp <- dispatchLbs man conf runtimeInvocationNextGet+    let (Just reqIdHdr) = lookup "Lambda-Runtime-Aws-Request-Id" $ responseHeaders nextResp+    let reqId = AwsRequestId $ T.decodeUtf8 reqIdHdr+    let dec = do+          outer <- A.eitherDecode' $ responseBody nextResp+          decodeInvocation outer+          -- pPrint $ responseHeaders nextResp+    handle (postRuntimeError man conf reqId) $ do+      let ok = either error id dec+      b <- h ok+      void $ dispatchLbs man conf $ setBodyParam (runtimeInvocationAwsRequestIdResponsePost (ContentType MimeJSON) reqId) (Body $ A.toJSON b)+    -- print respResp++type Action = T.Text++data Invocation a = Invocation+  { invocationAction :: !Action+  , invocationBody :: a+  } deriving (Show, Eq)++instance A.FromJSON a => A.FromJSON (Invocation a) where+  parseJSON = A.withObject "Invocation" $ \o -> do+    invocationAction <- o A..: "Action"+    invocationBody <- o A..: "body"+    pure $ Invocation{..}++decodeInvocation :: A.FromJSON a => Invocation T.Text -> Either String a+decodeInvocation = A.eitherDecodeStrict' . T.encodeUtf8 . invocationBody++data NowOutputBody+  = TextBody !T.Text+  | BytesBody !ByteString++-- newtype Reversed f a = Reversed (f a)++data NowOutput = NowOutput+  { nowOutputStatus :: Status+  , nowOutputHeaders :: !(H.HashMap HeaderName ByteString)+  -- , nowOutputMultiValueHeaders :: !(H.HashMap T.Text (Reversed [] T.Text))+  , nowOutputBody :: !NowOutputBody+  }++instance A.ToJSON NowOutput where+  toJSON (NowOutput s hs b) = A.object $ concat [statusFields, bodyFields, ["headers" A..= convertedHeaders]]+    where+      -- TODO can this be nicer?+      convertedHeaders = H.fromList . map (\(k, v) -> (T.decodeUtf8 $ CI.foldedCase k, T.decodeUtf8 v)) $ H.toList hs+      statusFields =+        [ "statusCode" A..= statusCode s+        , "statusDescription" A..= (T.decodeUtf8 $ statusMessage s)+        ]+      bodyFields = case b of+        TextBody t ->+          [ "body" A..= t+          , "isBase64Encoded" A..= False+          ]+        BytesBody bs ->+          [ "body" A..= T.decodeUtf8 (convertToBase Base64 bs)+          , "isBase64Encoded" A..= True+          ]

@@ -0,0 +1,140 @@+name:           now-haskell+version:        0.1.0.0+synopsis:       Zeit Now haskell-side integration and introspection tools.+description:    .+                Client library for calling the AWS Lambda Runtime API API based on http-client.+                .+                host: localhost+                .+                base path: http://localhost/2018-06-01+                .+                AWS Lambda Runtime API API version: 1.0.3+                .+                OpenAPI version: 3.0.0+                .+category:       Web+author:         Ian Duncan+maintainer:     ian@iankduncan.com+copyright:      2019 - Ian Duncan+license:        MIT+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md+    openapi.yaml++Flag UseKatip+  Description: Use the katip package to provide logging (if false, use the default monad-logger package)+  Default:     True+  Manual:      True++library+  hs-source-dirs:+      lib+  ghc-options: -Wall -funbox-strict-fields+  build-depends:+      aeson >=1.0 && <2.0+    , base >=4.7 && <5.0+    , base64-bytestring >1.0 && <2.0+    , bytestring >=0.10.0 && <0.11+    , case-insensitive+    , containers >=0.5.0.0 && <0.8+    , deepseq >= 1.4 && <1.6+    , exceptions >= 0.4+    , http-api-data >= 0.3.4 && <0.5+    , http-client >=0.5 && <0.6+    , http-client-tls+    , http-media >= 0.4 && < 0.8+    , http-types >=0.8 && <0.13+    , iso8601-time >=0.1.3 && <0.2.0+    , microlens >= 0.4.3 && <0.5+    , mtl >=2.2.1+    , network >=2.6.2 && <2.9+    , random >=1.1+    , safe-exceptions <0.2+    , text >=0.11 && <1.3+    , time >=1.5 && <1.10+    , transformers >=0.4.0.0+    , unordered-containers+    , vector >=0.10.9 && <0.13+    , memory+    , wai+  other-modules:+      Paths_now_haskell+      AWSLambdaRuntime+      AWSLambdaRuntime.API+      AWSLambdaRuntime.API.ApiDefault+      AWSLambdaRuntime.Client+      AWSLambdaRuntime.Core+      AWSLambdaRuntime.Logging+      AWSLambdaRuntime.MimeTypes+      AWSLambdaRuntime.Model+      AWSLambdaRuntime.ModelLens+  exposed-modules:+      Zeit.Now+  default-language: Haskell2010++  if flag(UseKatip)+      build-depends: katip >=0.8 && < 1.0+      other-modules: AWSLambdaRuntime.LoggingKatip+      cpp-options: -DUSE_KATIP+  else+      build-depends: monad-logger >=0.3 && <0.4+      other-modules: AWSLambdaRuntime.LoggingMonadLogger+      cpp-options: -DUSE_MONAD_LOGGER++test-suite tests+  type: exitcode-stdio-1.0+  main-is: Test.hs+  hs-source-dirs:+      tests+  ghc-options: -Wall -fno-warn-orphans+  build-depends:+      aws-lambda-runtime+    , QuickCheck+    , aeson+    , base >=4.7 && <5.0+    , bytestring >=0.10.0 && <0.11+    , containers+    , hspec >=1.8+    , iso8601-time+    , mtl >=2.2.1+    , semigroups+    , text+    , time+    , transformers >=0.4.0.0+    , unordered-containers+    , vector+  other-modules:+      ApproxEq+      Instances+      PropMime+  default-language: Haskell2010++executable module-scanner+  main-is: Main.hs+  other-modules:       CabalScanner,+                       ModuleScanner+  default-extensions:  OverloadedStrings,+                       FlexibleContexts,+                       FlexibleInstances+  hs-source-dirs:+      src+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.7 && <5.0+    , containers+    , Cabal+    , ghc-lib-parser+    , yaml+    , aeson+    , aeson-pretty+    , stack+    , fused-effects+    , bytestring+    , text+    , filepath+    , directory+  default-language: Haskell2010+

@@ -0,0 +1,219 @@+openapi: 3.0.0+info:+  description: AWS Lambda Runtime API is an HTTP API for implementing custom runtimes+  title: AWS Lambda Runtime API+  version: 1.0.3+servers:+- url: /2018-06-01+paths:+  /runtime/init/error:+    post:+      parameters:+      - explode: false+        in: header+        name: Lambda-Runtime-Function-Error-Type+        required: false+        schema:+          type: string+        style: simple+      requestBody:+        content:+          '*/*':+            schema: {}+      responses:+        202:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/StatusResponse'+          description: Accepted+        403:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/ErrorResponse'+          description: Forbidden+        500:+          description: |+            Container error. Non-recoverable state. Runtime should exit promptly.+      summary: |+        Non-recoverable initialization error. Runtime should exit after reporting the error. Error will be served in response to the first invoke.+  /runtime/invocation/next:+    get:+      responses:+        200:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/EventResponse'+          description: |+            This is an iterator-style blocking API call. Response contains event JSON document, specific to the invoking service.+          headers:+            Lambda-Runtime-Aws-Request-Id:+              description: AWS request ID associated with the request.+              explode: false+              schema:+                type: string+              style: simple+            Lambda-Runtime-Trace-Id:+              description: X-Ray tracing header.+              explode: false+              schema:+                type: string+              style: simple+            Lambda-Runtime-Client-Context:+              description: |+                Information about the client application and device when invoked through the AWS Mobile SDK.+              explode: false+              schema:+                type: string+              style: simple+            Lambda-Runtime-Cognito-Identity:+              description: |+                Information about the Amazon Cognito identity provider when invoked through the AWS Mobile SDK.+              explode: false+              schema:+                type: string+              style: simple+            Lambda-Runtime-Deadline-Ms:+              description: |+                Function execution deadline counted in milliseconds since the Unix epoch.+              explode: false+              schema:+                type: string+              style: simple+            Lambda-Runtime-Invoked-Function-Arn:+              description: |+                The ARN requested. This can be different in each invoke that executes the same version.+              explode: false+              schema:+                type: string+              style: simple+        403:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/ErrorResponse'+          description: Forbidden+        500:+          description: |+            Container error. Non-recoverable state. Runtime should exit promptly.+      summary: |+        Runtime makes this HTTP request when it is ready to receive and process a new invoke.+  /runtime/invocation/{AwsRequestId}/response:+    post:+      parameters:+      - explode: false+        in: path+        name: AwsRequestId+        required: true+        schema:+          type: string+        style: simple+      requestBody:+        content:+          '*/*':+            schema: {}+      responses:+        202:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/StatusResponse'+          description: Accepted+        400:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/ErrorResponse'+          description: Bad Request+        403:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/ErrorResponse'+          description: Forbidden+        413:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/ErrorResponse'+          description: Payload Too Large+        500:+          description: |+            Container error. Non-recoverable state. Runtime should exit promptly.+      summary: Runtime makes this request in order to submit a response.+  /runtime/invocation/{AwsRequestId}/error:+    post:+      parameters:+      - explode: false+        in: path+        name: AwsRequestId+        required: true+        schema:+          type: string+        style: simple+      - explode: false+        in: header+        name: Lambda-Runtime-Function-Error-Type+        required: false+        schema:+          type: string+        style: simple+      requestBody:+        content:+          '*/*':+            schema: {}+      responses:+        202:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/StatusResponse'+          description: Accepted+        400:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/ErrorResponse'+          description: Bad Request+        403:+          content:+            application/json:+              schema:+                $ref: '#/components/schemas/ErrorResponse'+          description: Forbidden+        500:+          description: |+            Container error. Non-recoverable state. Runtime should exit promptly.+      summary: |+        Runtime makes this request in order to submit an error response. It can be either a function error, or a runtime error. Error will be served in response to the invoke.+components:+  schemas:+    StatusResponse:+      example:+        status: status+      properties:+        status:+          type: string+      type: object+    ErrorResponse:+      properties:+        errorMessage:+          type: string+        errorType:+          type: string+      type: object+    ErrorRequest:+      properties:+        errorMessage:+          type: string+        errorType:+          type: string+        stackTrace:+          items:+            type: string+          type: array+      type: object+    EventResponse:+      type: object

@@ -0,0 +1,165 @@+module CabalScanner where++import Data.Aeson+import qualified Data.Text as T++-- Cabal things+import Distribution.Verbosity (normal)+import Distribution.PackageDescription+import Distribution.PackageDescription.Configuration (flattenPackageDescription) -- TODO replace with finalizePD+import Distribution.PackageDescription.Parsec+import Distribution.Types.UnqualComponentName+import Distribution.ModuleName (ModuleName, fromComponents)+import Distribution.Simple.Utils++import Data.List (inits)+import System.Directory+import System.Environment+import System.FilePath+import qualified ModuleScanner as Mod++data Output+  = PackageUsedOutput PackageInfo+  | ModuleUsedOutput ModuleInfo++instance ToJSON Output where+  toJSON o = case o of+    PackageUsedOutput p -> object+      [ "type" .= ("package" :: T.Text)+      , "data" .= p+      ]+    ModuleUsedOutput m -> object+      [ "type" .= ("module" :: T.Text)+      , "data" .= m+      ]++data ModulePackage+  = Dangling+  | InPackageLibrary FilePath+  | InPackageExecutable+    String -- ^ Executable name+    FilePath+  | InOtherPackageStanza FilePath++data ModuleInfo = ModuleInfo+  { moduleInfoPackage :: ModulePackage+  , moduleInfoAnalysis :: Mod.Analyze+  }++instance ToJSON ModuleInfo where+  toJSON (ModuleInfo p a) = object+    [ "package" .= case p of+        Dangling -> Null+        InPackageLibrary fp -> object ["library" .= (takeBaseName fp), "path" .= fp]+        InPackageExecutable e fp -> object ["executable" .= e, "path" .= fp]+        InOtherPackageStanza fp -> object ["path" .= fp]+    , "analysis" .= a+    ]++data PackageInfo = PackageInfo+  { packageInfoExecutables :: [String]+  }++instance ToJSON PackageInfo where+  toJSON (PackageInfo exes) = object+    [ "executables" .= exes+    {-+      From cabal:+        executables[].modulePath :: FilePath+        resolve libraries[].modules with buildInfo+        dataFiles :: [FilePath]+        dataDir :: FilePath+        extraSrcFiles :: [FilePath]+        extraTmpFiles :: [FilePath]+        extraDocFiles :: [FilePath]+    -}+    , "files" .= object+      [ "executableModules" .= ([] :: [FilePath])+      ]+    ]++dispatchFileScan :: FilePath -> IO (Either ModuleInfo PackageInfo)+dispatchFileScan fp = case takeFileName fp of+  "package.yml" -> error "hpack package.yml"+  "package.yaml" -> error "hpack package.yaml"+  other -> case takeExtension other of+    ".hs" -> Left <$> performHaskellModuleScan fp+    ".lhs" -> Left <$> performHaskellModuleScan fp+    -- TODO+    -- "chs" -> _+    ".cabal" -> Right <$> (produceFlatPackage fp >>= performCabalPackageScan)+    unsupported -> error ("." ++ unsupported ++ " file extension is not a supported Haskell builder type.")++performHaskellModuleScan :: FilePath -> IO ModuleInfo+performHaskellModuleScan relFp = do+  fp <- canonicalizePath relFp+  mCabalFile <- findClosestAncestorCabalFile fp+  analysis <- Mod.readDesiredModule relFp++  case mCabalFile of+    Nothing -> do+      pure $ ModuleInfo Dangling analysis+    Just cf -> do+      flatPack <- produceFlatPackage cf+      case library flatPack of+        Nothing -> do+          pure $ ModuleInfo (InOtherPackageStanza cf) analysis+        Just l -> do+          let relativeModulePath = makeRelative (takeDirectory cf) fp+              desiredModule = fileToModule (hsSourceDirs $ libBuildInfo l) relativeModulePath+          if desiredModule `isExposedFromLibrary` l+            then do+              pure $ ModuleInfo (InPackageLibrary cf) analysis+            else error "TODO: not sure what to do here..."++getCabalPackage :: FilePath -> IO PackageDescription+getCabalPackage p = do+  efp <- findPackageDesc p+  let fp = either error id efp+  produceFlatPackage fp++produceFlatPackage :: FilePath -> IO PackageDescription+produceFlatPackage fp = do+  gpd <- readGenericPackageDescription normal fp+  pure $ flattenPackageDescription gpd++performCabalPackageScan :: PackageDescription -> IO PackageInfo+performCabalPackageScan gpd = do+  let exes = map (unUnqualComponentName . exeName) $ executables gpd+  pure $ PackageInfo exes++-- Takes a path and searches for a cabal file up the directory hierarchy. returns a cabal file if found+findClosestAncestorCabalFile :: FilePath -> IO (Maybe FilePath)+findClosestAncestorCabalFile fp = do+  isDir <- doesDirectoryExist fp+  let startingDir = if isDir then fp else takeDirectory fp+  dir <- canonicalizePath startingDir+  let chunkedDir = splitPath dir+      allPaths = map joinPath $ reverse $ tail $ inits chunkedDir+  -- print allPaths+  go allPaths+  where+    go [] = pure Nothing+    go (path:ps) = do+      res <- findPackageDesc path+      case res of+        Left _ -> go ps+        Right p -> pure $ Just p+++fileToModule+  :: [FilePath] -- Search paths+  -- -> [FilePath] -- Extensions+  -> FilePath -- Haskell File+  -> ModuleName+fileToModule searchPs startP = go searchPs+  where+    extensionless = dropExtension startP+    go [] = fromComponents $ splitDirectories extensionless+    go (p:ps) = let rel = makeRelative p extensionless in+      if rel == extensionless+      then go ps+      else fromComponents $ splitDirectories rel++isExposedFromLibrary :: ModuleName -> Library -> Bool+isExposedFromLibrary m l = m `elem` exposedModules l

@@ -0,0 +1,34 @@+module Main where++import CabalScanner++import Data.Aeson.Encode.Pretty+import qualified Data.ByteString.Lazy.Char8 as L+import System.Directory+import System.Environment+++++main :: IO ()+main = do+  (basePath:_) <- getArgs+  isDir <- doesDirectoryExist basePath+  out <- if isDir+    then do+      gpd <- getCabalPackage basePath+      packInfo <- performCabalPackageScan gpd+      -- TODO useful things here+      pure $ PackageUsedOutput packInfo+    else do+      scan <- dispatchFileScan basePath+      case scan of+        Left modInfo -> do+          case modInfo of+            -- (ModuleInfo (InPackageLibrary fp) analysis) ->+            _ -> return ()+          pure $ ModuleUsedOutput modInfo+        Right packInfo -> do+          -- TODO useful things here+          pure $ PackageUsedOutput packInfo+  L.putStrLn $ encodePretty out

@@ -0,0 +1,220 @@+{-# LANGUAGE ViewPatterns #-}+module ModuleScanner where++import Control.Effect+import Control.Effect.Reader+import Control.Monad+import Control.Monad.IO.Class+import Data.Aeson+import Data.Aeson.Encode.Pretty+import Data.Either (either)+import Data.Maybe+import Data.IORef+import qualified Data.Text as T+import qualified Data.ByteString.Lazy.Char8 as L++-- GHC lib tasks+import Config+import DynFlags+import FastString+import Fingerprint+import HeaderInfo+import HsSyn+import Module+import Lexer+import Outputable+import Pretty+import Parser+import Platform+import RdrName+import StringBuffer+import SrcLoc++import qualified Data.Map.Strict as Map+import System.IO++import System.FilePath++{-+TODO figure out how to 'flatten' GenericPackageDescription into PackageDescription+TODO figure out how to *write* package descriptions back out?+-}++fakeLlvmConfig :: (LlvmTargets, LlvmPasses)+fakeLlvmConfig = ([], [])++data Analyze = Analyze+  { moduleName :: T.Text+  -- , moduleType :: ModuleType+  , functionName :: ModuleExports+  , watch :: [FilePath] -- Local modules+  }++instance ToJSON Analyze where+  toJSON (Analyze mn fn w) = object+    [ "moduleName" .= mn+    -- , "moduleType" .= mt+    , "functionName" .= fn+    , "watch" .= w+    ]++fakeSettings :: Settings+fakeSettings =+  Settings+    { sTargetPlatform = platform+    , sPlatformConstants = platformConstants+    , sProjectVersion = cProjectVersion+    , sProgramName = "ghc"+    , sOpt_P_fingerprint = fingerprint0+    , sTmpDir = "."+    }+  where+    platform =+      Platform+        { platformWordSize = 8+        , platformOS = OSUnknown+        , platformUnregisterised = True+        }+    -- This bit may need to be conditional on OS.+    platformConstants =+      PlatformConstants+        { pc_DYNAMIC_BY_DEFAULT = False+        , pc_WORD_SIZE = 8+        , pc_STD_HDR_SIZE = 1+        , pc_TAG_BITS = 3+        , pc_BLOCKS_PER_MBLOCK = 252+        , pc_BLOCK_SIZE = 4096+        , pc_MIN_PAYLOAD_SIZE = 1+        , pc_MAX_Real_Vanilla_REG = 6+        , pc_MAX_Vanilla_REG = 10+        , pc_MAX_Real_Long_REG = 0+        }++++readDesiredModule :: FilePath -> IO Analyze+readDesiredModule file = do+  (flags, res) <- loadModule file+  case res of+    POk _ lm -> runM $ runReader flags $ do+      -- printForUser flags stdout neverQualify (ppr $ unLoc lm)+      r <- findMainOrHandler $ unLoc lm+      let modName = T.pack $ maybe "Main" (moduleNameString . unLoc) $ hsmodName $ unLoc lm+      pure $ Analyze modName r [] -- TODO+    _ -> error "Failed to parse module!"++mkDynFlags :: String -> String -> IO DynFlags+mkDynFlags filename s = do+  dirs_to_clean <- newIORef Map.empty+  files_to_clean <- newIORef emptyFilesToClean+  next_temp_suffix <- newIORef 0+  let baseFlags =+        (defaultDynFlags fakeSettings fakeLlvmConfig) {+          ghcLink = NoLink+        , hscTarget = HscNothing+        , pkgDatabase = Just []+        , dirsToClean = dirs_to_clean+        , filesToClean = files_to_clean+        , nextTempSuffix = next_temp_suffix+        , thisInstalledUnitId = toInstalledUnitId (stringToUnitId "module-scanner")+        }+  parsePragmasIntoDynFlags filename s baseFlags+  where+    parsePragmasIntoDynFlags :: String -> String -> DynFlags -> IO DynFlags+    parsePragmasIntoDynFlags fp contents dflags0 = do+      let opts = getOptions dflags0 (stringToStringBuffer contents) fp+      (dflags, _, _) <- parseDynamicFilePragma dflags0 opts+      return dflags++runParser :: FilePath -> DynFlags -> String -> P a -> Lexer.ParseResult a+runParser p flags str parser = unP parser parseState+  where+    filename = p+    location = mkRealSrcLoc (mkFastString filename) 1 1+    _buf = stringToStringBuffer str+    parseState = mkPState flags _buf location++loadModule :: FilePath -> IO (DynFlags, Lexer.ParseResult (Located (HsModule GhcPs)))+loadModule fp = do+  contents <- readFile fp+  flags <- mkDynFlags fp contents+  pure (flags, runParser fp flags contents parseModule)+++data ModuleExports+  = ExportsMain+  | ExportsHandler+  | NoSupportedExport+  deriving (Show)++instance ToJSON ModuleExports where+  toJSON e = case e of+    ExportsMain -> String "main"+    ExportsHandler -> String "handler"+    NoSupportedExport -> Null++data ModuleType+  = Executable+  | Library+  deriving (Show)++instance ToJSON ModuleType where+  toJSON x = case x of+    Executable -> String "Executable"+    Library -> String "Library"++findMainOrHandler :: (Member (Reader DynFlags) sig, Carrier sig m, MonadIO m) => HsModule GhcPs -> m ModuleExports+findMainOrHandler m = case hsmodExports m of+  Nothing -> scanListDecls $ hsmodDecls m+  Just lExps -> case map unLoc $ unLoc lExps of+    [] -> pure NoSupportedExport+    -- TODO handle other cases+    exps -> do+      expMs <- mapM checkExport exps+      pure $ case expMs of+        (r:_) -> r+        _ -> NoSupportedExport++rdrNameCheck :: RdrName -> ModuleExports+rdrNameCheck name = if mkVarUnqual (mkFastString "main") == name+  then ExportsMain+  else if mkVarUnqual (mkFastString "handler") == name+  then ExportsHandler+  else NoSupportedExport++prettyPrintDump :: (Member (Reader DynFlags) sig, Carrier sig m, MonadIO m, Outputable a) => a -> m ()+prettyPrintDump x = do+  flags <- ask+  liftIO $ printForUser flags stdout neverQualify (ppr x)++checkExport :: (Member (Reader DynFlags) sig, Carrier sig m, MonadIO m) => IE GhcPs -> m ModuleExports+checkExport ie = do+  -- prettyPrintDump ie+  case ie of+    IEVar _ wrappedName -> case unLoc wrappedName of+      IEName name -> pure $ rdrNameCheck $ unLoc name+      IEPattern _ -> pure NoSupportedExport+      IEType _ -> pure NoSupportedExport+    IEThingAbs _ _ -> pure NoSupportedExport+    IEThingAll _ _ -> pure NoSupportedExport -- TODO+    IEThingWith _ _ _ _ _ -> pure NoSupportedExport -- TODO+    IEModuleContents _ _ -> pure NoSupportedExport -- TODO+    IEGroup _ _ _ -> pure NoSupportedExport+    IEDoc _ _ -> pure NoSupportedExport+    IEDocNamed _ _ -> pure NoSupportedExport+    XIE _ -> pure NoSupportedExport++scanListDecls :: (Member (Reader DynFlags) sig, Carrier sig m, MonadIO m) => [LHsDecl GhcPs] -> m ModuleExports+scanListDecls decls = do+  declMs <- mapM (scanDecl . unLoc) decls+  pure $ case declMs of+    [] -> NoSupportedExport+    (r:_) -> r++scanDecl :: (Member (Reader DynFlags) sig, Carrier sig m, MonadIO m) => HsDecl GhcPs -> m ModuleExports+scanDecl (ValD _ bind) = case bind of+  (FunBind _ fid _ _ _) -> do+    -- prettyPrintDump fid+    pure $ rdrNameCheck $ unLoc fid+  _ -> pure NoSupportedExport+scanDecl _ = pure NoSupportedExport

@@ -0,0 +1,81 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module ApproxEq where++import Data.Text (Text)+import Data.Time.Clock+import Test.QuickCheck+import GHC.Generics as G++(==~)+  :: (ApproxEq a, Show a)+  => a -> a -> Property+a ==~ b = counterexample (show a ++ " !=~ " ++ show b) (a =~ b)++class GApproxEq f  where+  gApproxEq :: f a -> f a -> Bool++instance GApproxEq U1 where+  gApproxEq U1 U1 = True++instance (GApproxEq a, GApproxEq b) =>+         GApproxEq (a :+: b) where+  gApproxEq (L1 a) (L1 b) = gApproxEq a b+  gApproxEq (R1 a) (R1 b) = gApproxEq a b+  gApproxEq _ _ = False++instance (GApproxEq a, GApproxEq b) =>+         GApproxEq (a :*: b) where+  gApproxEq (a1 :*: b1) (a2 :*: b2) = gApproxEq a1 a2 && gApproxEq b1 b2++instance (ApproxEq a) =>+         GApproxEq (K1 i a) where+  gApproxEq (K1 a) (K1 b) = a =~ b++instance (GApproxEq f) =>+         GApproxEq (M1 i t f) where+  gApproxEq (M1 a) (M1 b) = gApproxEq a b++class ApproxEq a  where+  (=~) :: a -> a -> Bool+  default (=~) :: (Generic a, GApproxEq (Rep a)) => a -> a -> Bool+  a =~ b = gApproxEq (G.from a) (G.from b)++instance ApproxEq Text where+  (=~) = (==)++instance ApproxEq Char where+  (=~) = (==)++instance ApproxEq Bool where+  (=~) = (==)++instance ApproxEq Int where+  (=~) = (==)++instance ApproxEq Double where+  (=~) = (==)++instance ApproxEq a =>+         ApproxEq (Maybe a)++instance ApproxEq UTCTime where+  (=~) = (==)++instance ApproxEq a =>+         ApproxEq [a] where+  as =~ bs = and (zipWith (=~) as bs)++instance (ApproxEq l, ApproxEq r) =>+         ApproxEq (Either l r) where+  Left a =~ Left b = a =~ b+  Right a =~ Right b = a =~ b+  _ =~ _ = False++instance (ApproxEq l, ApproxEq r) =>+         ApproxEq (l, r) where+  (=~) (l1, r1) (l2, r2) = l1 =~ l2 && r1 =~ r2

@@ -0,0 +1,136 @@+{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-unused-matches #-}++module Instances where++import AWSLambdaRuntime.Model+import AWSLambdaRuntime.Core++import qualified Data.Aeson as A+import qualified Data.ByteString.Lazy as BL+import qualified Data.HashMap.Strict as HM+import qualified Data.Set as Set+import qualified Data.Text as T+import qualified Data.Time as TI+import qualified Data.Vector as V++import Control.Monad+import Data.Char (isSpace)+import Data.List (sort)+import Test.QuickCheck++import ApproxEq++instance Arbitrary T.Text where+  arbitrary = T.pack <$> arbitrary++instance Arbitrary TI.Day where+  arbitrary = TI.ModifiedJulianDay . (2000 +) <$> arbitrary+  shrink = (TI.ModifiedJulianDay <$>) . shrink . TI.toModifiedJulianDay++instance Arbitrary TI.UTCTime where+  arbitrary =+    TI.UTCTime <$> arbitrary <*> (TI.secondsToDiffTime <$> choose (0, 86401))++instance Arbitrary BL.ByteString where+    arbitrary = BL.pack <$> arbitrary+    shrink xs = BL.pack <$> shrink (BL.unpack xs)++instance Arbitrary ByteArray where+    arbitrary = ByteArray <$> arbitrary+    shrink (ByteArray xs) = ByteArray <$> shrink xs++instance Arbitrary Binary where+    arbitrary = Binary <$> arbitrary+    shrink (Binary xs) = Binary <$> shrink xs++instance Arbitrary DateTime where+    arbitrary = DateTime <$> arbitrary+    shrink (DateTime xs) = DateTime <$> shrink xs++instance Arbitrary Date where+    arbitrary = Date <$> arbitrary+    shrink (Date xs) = Date <$> shrink xs++-- | A naive Arbitrary instance for A.Value:+instance Arbitrary A.Value where+  arbitrary = frequency [(3, simpleTypes), (1, arrayTypes), (1, objectTypes)]+    where+      simpleTypes :: Gen A.Value+      simpleTypes =+        frequency+          [ (1, return A.Null)+          , (2, liftM A.Bool (arbitrary :: Gen Bool))+          , (2, liftM (A.Number . fromIntegral) (arbitrary :: Gen Int))+          , (2, liftM (A.String . T.pack) (arbitrary :: Gen String))+          ]+      mapF (k, v) = (T.pack k, v)+      simpleAndArrays = frequency [(1, sized sizedArray), (4, simpleTypes)]+      arrayTypes = sized sizedArray+      objectTypes = sized sizedObject+      sizedArray n = liftM (A.Array . V.fromList) $ replicateM n simpleTypes+      sizedObject n =+        liftM (A.object . map mapF) $+        replicateM n $ (,) <$> (arbitrary :: Gen String) <*> simpleAndArrays+    +-- | Checks if a given list has no duplicates in _O(n log n)_.+hasNoDups+  :: (Ord a)+  => [a] -> Bool+hasNoDups = go Set.empty+  where+    go _ [] = True+    go s (x:xs)+      | s' <- Set.insert x s+      , Set.size s' > Set.size s = go s' xs+      | otherwise = False++instance ApproxEq TI.Day where+  (=~) = (==)+    +arbitraryReduced :: Arbitrary a => Int -> Gen a+arbitraryReduced n = resize (n `div` 2) arbitrary++arbitraryReducedMaybe :: Arbitrary a => Int -> Gen (Maybe a)+arbitraryReducedMaybe 0 = elements [Nothing]+arbitraryReducedMaybe n = arbitraryReduced n++arbitraryReducedMaybeValue :: Int -> Gen (Maybe A.Value)+arbitraryReducedMaybeValue 0 = elements [Nothing]+arbitraryReducedMaybeValue n = do+  generated <- arbitraryReduced n+  if generated == Just A.Null+    then return Nothing+    else return generated++-- * Models+ +instance Arbitrary ErrorRequest where+  arbitrary = sized genErrorRequest++genErrorRequest :: Int -> Gen ErrorRequest+genErrorRequest n =+  ErrorRequest+    <$> arbitraryReducedMaybe n -- errorRequestErrorMessage :: Maybe Text+    <*> arbitraryReducedMaybe n -- errorRequestErrorType :: Maybe Text+    <*> arbitraryReducedMaybe n -- errorRequestStackTrace :: Maybe [Text]+  +instance Arbitrary ErrorResponse where+  arbitrary = sized genErrorResponse++genErrorResponse :: Int -> Gen ErrorResponse+genErrorResponse n =+  ErrorResponse+    <$> arbitraryReducedMaybe n -- errorResponseErrorMessage :: Maybe Text+    <*> arbitraryReducedMaybe n -- errorResponseErrorType :: Maybe Text+  +instance Arbitrary StatusResponse where+  arbitrary = sized genStatusResponse++genStatusResponse :: Int -> Gen StatusResponse+genStatusResponse n =+  StatusResponse+    <$> arbitraryReducedMaybe n -- statusResponseStatus :: Maybe Text+  +++

@@ -0,0 +1,51 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE ConstraintKinds #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}++module PropMime where++import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.Monoid ((<>))+import Data.Typeable (Proxy(..), typeOf, Typeable)+import qualified Data.ByteString.Lazy.Char8 as BL8+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Property+import Test.Hspec.QuickCheck (prop)++import AWSLambdaRuntime.MimeTypes++import ApproxEq++-- * Type Aliases++type ArbitraryMime mime a = ArbitraryRoundtrip (MimeUnrender mime) (MimeRender mime) a++type ArbitraryRoundtrip from to a = (from a, to a, Arbitrary' a)++type Arbitrary' a = (Arbitrary a, Show a, Typeable a)++-- * Mime++propMime+  :: forall a b mime.+     (ArbitraryMime mime a, Testable b)+  => String -> (a -> a -> b) -> mime -> Proxy a -> Spec+propMime eqDescr eq m _ =+  prop+    (show (typeOf (undefined :: a)) <> " " <> show (typeOf (undefined :: mime)) <> " roundtrip " <> eqDescr) $+  \(x :: a) ->+     let rendered = mimeRender' m x+         actual = mimeUnrender' m rendered+         expected = Right x+         failMsg =+           "ACTUAL: " <> show actual <> "\nRENDERED: " <> BL8.unpack rendered+     in counterexample failMsg $+        either reject property (eq <$> actual <*> expected)+  where+    reject = property . const rejected++propMimeEq :: (ArbitraryMime mime a, Eq a) => mime -> Proxy a -> Spec+propMimeEq = propMime "(EQ)" (==)

@@ -0,0 +1,26 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE PartialTypeSignatures #-}++module Main where++import Data.Typeable (Proxy(..))+import Test.Hspec+import Test.Hspec.QuickCheck++import PropMime+import Instances ()++import AWSLambdaRuntime.Model+import AWSLambdaRuntime.MimeTypes++main :: IO ()+main =+  hspec $ modifyMaxSize (const 10) $ do+    describe "JSON instances" $ do+      pure ()+      propMimeEq MimeJSON (Proxy :: Proxy ErrorRequest)+      propMimeEq MimeJSON (Proxy :: Proxy ErrorResponse)+      propMimeEq MimeJSON (Proxy :: Proxy StatusResponse)+