hal 0.4.7 → 0.4.8

raw patch · 10 files changed

+699/−30 lines, 10 filesdep +hashabledep +hedgehogdep +hspec-hedgehogdep ~http-typesPVP ok

version bump matches the API change (PVP)

Dependencies added: hashable, hedgehog, hspec-hedgehog, scientific, transformers, vector

Dependency ranges changed: http-types

API changes (from Hackage documentation)

Files

• CHANGELOG.md +74/−0
• hal.cabal +59/−6
• src/AWS/Lambda/Events/ApiGateway/ProxyRequest.hs +60/−8
• src/AWS/Lambda/Events/ApiGateway/ProxyResponse.hs +44/−14
• test/AWS/Lambda/Events/ApiGateway/ProxyRequest/Gen.hs +113/−0
• test/AWS/Lambda/Events/ApiGateway/ProxyRequest/Gen/Parameters.hs +39/−0
• test/AWS/Lambda/Events/ApiGateway/ProxyRequest/Gen/Resource.hs +65/−0
• test/AWS/Lambda/Events/ApiGateway/ProxyResponse/Gen.hs +93/−0
• test/Gen/Header.hs +123/−0
• test/Spec.hs +29/−2

@@ -0,0 +1,74 @@+# Change log++All notable changes to this project will be documented in this file.++The format is based on [Keep a Changelog][chg] and this project adheres to+[Haskell's Package Versioning Policy][pvp]++## `0.4.8` - 2021-05-07++  - Add `ToJSON` instances for `ProxyRequest` types, and test+    round-tripping as much as possible+  - Add `FromJSON` instance for `ProxyResponse`, and test+    round-tripping as much as possible++## `0.4.7` - 2021-04-12++  - Drop http-conduit as a dependency for potentially smaller binaries+  - Add more detailed error messages to context parsing failures+  - Increase compatibility by loosening envy version bounds+  - Add mRuntimeWithContext' and mRuntime+  - Deprecate withIoInterface, withFallibleInterface, withPureInterface, HasLambdaContext, runRaderTLambdaContext, mRuntimeWithContext++## `0.4.2` - 2020-07-23++  - Fix an issue where errors from the runtime were not retried++## `0.4.1` - 2020-01-22++  - Constrain the envy version for correctly building with Cabal+  - Fix documentation examples for Runtime and Combinators++## `0.4.0` - 2020-01-22++  - Add support for Value-based runtimes for handling JSON conversion errors explicitly++## `0.3.1` - 2020-07-23++  - Fix an issue where errors from the runtime were not retried++## `0.3.0` - 2019-02-26++  - Add support for triggered S3 events++## `0.2.1` - 2020-07-23++  - Fix an issue where errors from the runtime were not retried++## `0.2.0` - 2019-02-07++  - Expose `AWS.Lambda.Combinators` package for building other runtimes+  (e.g. to support Lambda Event triggers)++## `0.1.3` - 2020-07-23++  - Fix an issue where errors from the runtime were not retried++## `0.1.2` - 2019-01-10++  - Fix PVP bounds when building/uploading the package++## `0.1.1` - 2019-01-08++### Fixed++  - Incorrect error message when getting events from AWS++## `0.1.0` - 2018-12-20++### Added++  - Initial release!++[chg]: http://keepachangelog.com+[pvp]: http://pvp.haskell.org

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: ac72c27a2329613830cbbdeaf5c590a17af49cb9f6987d444b538ded08a8d451+-- hash: e76a8db81a6c7a721b849d1efca110b833ece7559f999740e5ac5c2d6cdd36e1  name:           hal-version:        0.4.7+version:        0.4.8 synopsis:       A runtime environment for Haskell applications running on AWS Lambda. description:    This library uniquely supports different types of AWS Lambda Handlers for your                 needs/comfort with advanced Haskell. Instead of exposing a single function@@ -23,6 +23,7 @@ build-type:     Simple extra-source-files:     README.md+    CHANGELOG.md  source-repository head   type: git@@ -45,7 +46,25 @@       Paths_hal   hs-source-dirs:       src-  default-extensions: OverloadedStrings BangPatterns DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DuplicateRecordFields EmptyCase GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf OverloadedStrings PatternSynonyms ScopedTypeVariables+  default-extensions:+      OverloadedStrings+      BangPatterns+      DefaultSignatures+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DuplicateRecordFields+      EmptyCase+      GeneralizedNewtypeDeriving+      InstanceSigs+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      OverloadedStrings+      PatternSynonyms+      ScopedTypeVariables   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-partial-type-signatures -fno-warn-name-shadowing -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-incomplete-patterns   build-depends:       aeson@@ -58,6 +77,7 @@     , containers     , envy     , exceptions+    , hashable     , http-client     , http-types     , mtl@@ -70,18 +90,51 @@   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:+      AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen+      AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen.Parameters+      AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen.Resource+      AWS.Lambda.Events.ApiGateway.ProxyResponse.Gen+      Gen.Header       Paths_hal   hs-source-dirs:       test-  default-extensions: OverloadedStrings BangPatterns DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveLift DeriveTraversable DuplicateRecordFields EmptyCase GeneralizedNewtypeDeriving InstanceSigs LambdaCase MultiParamTypeClasses MultiWayIf OverloadedStrings PatternSynonyms ScopedTypeVariables+  default-extensions:+      OverloadedStrings+      BangPatterns+      DefaultSignatures+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DuplicateRecordFields+      EmptyCase+      GeneralizedNewtypeDeriving+      InstanceSigs+      LambdaCase+      MultiParamTypeClasses+      MultiWayIf+      OverloadedStrings+      PatternSynonyms+      ScopedTypeVariables   ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -fno-warn-partial-type-signatures -fno-warn-name-shadowing -fwarn-tabs -fwarn-unused-imports -fwarn-missing-signatures -fwarn-incomplete-patterns -threaded -rtsopts -with-rtsopts=-N   build-depends:       aeson     , base >=4.7 && <5+    , base64-bytestring+    , bytestring+    , case-insensitive     , containers     , hal+    , hedgehog >=1.0.3 && <1.1     , hspec+    , hspec-hedgehog     , http-client-    , http-types+    , http-types >=0.12.2 && <0.13+    , scientific+    , text     , time+    , transformers+    , unordered-containers+    , vector   default-language: Haskell2010

@@ -18,13 +18,16 @@     , StrictlyNoAuthorizer     ) where -import           Data.Aeson                  (FromJSON, Value, parseJSON,-                                              withObject, (.:), (.:?))-import           Data.ByteString.Base64.Lazy (decodeLenient)+import           Data.Aeson                  (FromJSON(..), ToJSON(..),+                                              Value(..), object, withObject,+                                              (.=), (.:), (.:?))+import           Data.ByteString.Base64.Lazy (decodeLenient, encode) import           Data.ByteString.Lazy        (ByteString)-import           Data.CaseInsensitive        (CI, mk)+import           Data.CaseInsensitive        (CI, FoldCase, mk, original) import           Data.Foldable               (fold)+import           Data.Hashable               (Hashable) import           Data.HashMap.Strict         (HashMap, foldrWithKey, insert)+import           Data.Maybe                  (catMaybes) import           Data.Text                   (Text) import qualified Data.Text.Lazy              as TL import qualified Data.Text.Lazy.Encoding     as TLE@@ -52,9 +55,10 @@     , apiKeyId                      :: Maybe Text     , userAgent                     :: Maybe Text     , user                          :: Maybe Text-    } deriving (Generic)+    } deriving (Eq, Generic, Show)  instance FromJSON Identity+instance ToJSON Identity  data RequestContext a = RequestContext     { path              :: Text@@ -70,7 +74,7 @@     , httpMethod        :: Text     , extendedRequestId :: Maybe Text     , apiId             :: Text-    }+    } deriving (Eq, Generic, Show)  instance FromJSON a => FromJSON (RequestContext a) where     parseJSON = withObject "ProxyRequest" $ \v ->@@ -87,6 +91,24 @@         v .:? "extendedRequestId" <*>         v .: "apiId" +-- | @since 0.4.8+instance ToJSON a => ToJSON (RequestContext a) where+    toJSON r = object $ catMaybes+        [ Just $ "path" .= path (r :: RequestContext a)+        , Just $ "accountId" .= accountId (r :: RequestContext a)+        , ("authorizer" .=) <$> authorizer r+        , Just $ "resourceId" .= resourceId r+        , Just $ "stage" .= stage r+        , ("domainPrefix" .=) <$> domainPrefix r+        , Just $ "requestId" .= requestId r+        , Just $ "identity" .= identity r+        , ("domainName" .=) <$> domainName r+        , Just $ "resourcePath" .= resourcePath r+        , Just $ "httpMethod" .= httpMethod (r :: RequestContext a)+        , ("extendedRequestId" .=) <$> extendedRequestId r+        , Just $ "apiId" .= apiId r+        ]+ -- TODO: Should also include websocket fields -- | This type is for representing events that come from API Gateway via the -- Lambda Proxy integration (forwarding HTTP data directly, rather than a@@ -141,17 +163,23 @@     , queryStringParameters           :: HashMap Text Text     , multiValueQueryStringParameters :: HashMap Text [Text]     , body                            :: ByteString-    } deriving (Generic)+    } deriving (Eq, Generic, Show) -toCIHashMap :: HashMap Text a -> HashMap (CI Text) a+toCIHashMap :: (Eq k, FoldCase k, Hashable k) => HashMap k a -> HashMap (CI k) a toCIHashMap = foldrWithKey (insert . mk) mempty +fromCIHashMap :: (Eq k, Hashable k) => HashMap (CI k) a -> HashMap k a+fromCIHashMap = foldrWithKey (insert . original) mempty+ toByteString :: Bool -> TL.Text -> ByteString toByteString isBase64Encoded =     if isBase64Encoded         then decodeLenient . TLE.encodeUtf8         else TLE.encodeUtf8 +toMaybe :: Bool -> a -> Maybe a+toMaybe b a = if b then Just a else Nothing+ -- | For ignoring API Gateway custom authorizer values type NoAuthorizer = Value @@ -172,3 +200,27 @@         (v .:? "queryStringParameters" <&> fold) <*>         (v .:? "multiValueQueryStringParameters" <&> fold) <*>         (toByteString <$> v .: "isBase64Encoded" <*> (v .:? "body" <&> fold))++-- | @since 0.4.8+instance ToJSON a => ToJSON (ProxyRequest a) where+    toJSON r = object $ catMaybes+        [ Just $ "path" .= path (r :: ProxyRequest a)+        , toMaybe (not . null $ headers r) $+              "headers" .= fromCIHashMap (headers r)+        , toMaybe (not . null $ multiValueHeaders r) $+              "multiValueHeaders" .= fromCIHashMap (multiValueHeaders r)+        , toMaybe (not . null $ pathParameters r) $+              "pathParameters" .= pathParameters r+        , toMaybe (not . null $ stageVariables r) $+              "stageVariables" .= stageVariables r+        , Just $ "requestContext" .= requestContext r+        , Just $ "resource" .= resource r+        , Just $ "httpMethod" .= httpMethod (r :: ProxyRequest a)+        , toMaybe (not . null $ queryStringParameters r) $+              "queryStringParameters" .= queryStringParameters r+        , toMaybe (not . null $ multiValueQueryStringParameters r) $+              "multiValueQueryStringParameters" .=+                  multiValueQueryStringParameters r+        , Just $ "isBase64Encoded" .= True+        , Just $ "body" .= TLE.decodeUtf8 (encode (body r))+        ]

@@ -24,18 +24,23 @@     , module Network.HTTP.Types.Status     ) where -import           Data.Aeson                (ToJSON, encode, object, toJSON,-                                            (.=))+import           Data.Aeson                (FromJSON(..), ToJSON, encode,+                                            object, toJSON, withObject, (.:),+                                            (.:?), (.=)) import           Data.ByteString           (ByteString) import qualified Data.ByteString.Base64    as B64-import           Data.CaseInsensitive      (CI, mk, original)-import           Data.HashMap.Strict       (HashMap, foldrWithKey, insert,-                                            insertWith)+import           Data.CaseInsensitive      (CI, FoldCase, mk, original)+import qualified Data.CaseInsensitive      as CI+import           Data.Foldable             (fold)+import           Data.Hashable             (Hashable)+import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as H import           Data.Semigroup            ((<>)) import qualified Data.Text                 as T import qualified Data.Text.Encoding        as TE import qualified Data.Text.Lazy            as TL import qualified Data.Text.Lazy.Encoding   as TLE+import           Network.HTTP.Types.Header (hContentType) import           Network.HTTP.Types.Status (Status (..), accepted202,                                             badGateway502, badRequest400,                                             conflict409, continue100,@@ -88,7 +93,15 @@                                             unprocessableEntity422,                                             unsupportedMediaType415,                                             upgradeRequired426, useProxy305)+import           GHC.Generics               (Generic (..)) +-- This function is available in Data.Functor as of base 4.11, but we define it+-- here for compatibility.+(<&>) :: Functor f => f a -> (a -> b) -> f b+(<&>) x f = f <$> x++infixl 1 <&>+ -- | Type that represents the body returned to an API Gateway when using HTTP -- Lambda Proxy integration.  It is highly recommended that you do not use this -- type directly, and instead use the smart constructors exposed such as@@ -98,7 +111,7 @@     { contentType     :: T.Text     , serialized      :: T.Text     , isBase64Encoded :: Bool-    } deriving (Show)+    } deriving (Eq, Generic, Show)  -- | A response returned to an API Gateway when using the HTTP Lambda Proxy -- integration.  ContentType will be set based on the ProxyBody (recommended)@@ -141,8 +154,11 @@     { status            :: Status     , multiValueHeaders :: HashMap (CI T.Text) [T.Text]     , body              :: ProxyBody-    } deriving (Show)+    } deriving (Eq, Generic, Show) +toCIHashMap :: (Eq k, FoldCase k, Hashable k) => HashMap k a -> HashMap (CI k) a+toCIHashMap = H.foldrWithKey (H.insert . mk) mempty+ -- | Smart constructor for creating a ProxyResponse from a status and a body response :: Status -> ProxyBody -> ProxyResponse response =@@ -154,13 +170,13 @@ -- previous headers or their values. addHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse addHeader header value (ProxyResponse s mvh b) =-  ProxyResponse s (insertWith (<>) (mk header) [value] mvh) b+  ProxyResponse s (H.insertWith (<>) (mk header) [value] mvh) b  -- | Set a header to the ProxyResponse.  If there were any previous values for -- this header they are __all replaced__ by this new value. setHeader :: T.Text -> T.Text -> ProxyResponse -> ProxyResponse setHeader header value (ProxyResponse s mvh b) =-  ProxyResponse s (insert (mk header) [value] mvh) b+  ProxyResponse s (H.insert (mk header) [value] mvh) b  -- | Smart constructor for creating a ProxyBody with an arbitrary ByteString of -- the chosen content type.  Use this smart constructor to avoid invalid JSON@@ -191,16 +207,13 @@         (TL.toStrict $ TLE.decodeUtf8 $ encode x)         False --- | Smart constructor for creating a simple body of a GIF (that has already--- been converted to a ByteString).- instance ToJSON ProxyResponse where     toJSON (ProxyResponse status mvh (ProxyBody contentType body isBase64Encoded)) =-        let unCI = foldrWithKey (insert . original) mempty+        let unCI = H.foldrWithKey (H.insert . original) mempty         in object                [ "statusCode" .= statusCode status                , "multiValueHeaders" .=-                     insertWith+                     H.insertWith                          (\_ old -> old)                          ("Content-Type" :: T.Text)                          [contentType]@@ -208,3 +221,20 @@                , "body" .= body                , "isBase64Encoded" .= isBase64Encoded                ]++-- | @since 0.4.8+instance FromJSON ProxyResponse where+    parseJSON = withObject "ProxyResponse" $ \v -> do+        headers <- v .:? "multiValueHeaders" <&> toCIHashMap . fold+        -- Move the "Content-Type" header into the ProxyBody. This is+        -- necessary to ensure round-tripping.+        let contentTypeHeader = CI.map TE.decodeUtf8 hContentType+            contentType = case H.lookup contentTypeHeader headers of+                Just (h:_) -> h+                _ -> "application/octet-stream"+            headers' = H.delete contentTypeHeader headers+        status <- v .: "statusCode" <&> toEnum+        proxyBody <- ProxyBody contentType+            <$> v .: "body"+            <*> v .: "isBase64Encoded"+        pure $ ProxyResponse status headers' proxyBody

@@ -0,0 +1,113 @@+module AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen where++import qualified AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen.Resource as Resource+import qualified AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen.Parameters as Parameters+import           AWS.Lambda.Events.ApiGateway.ProxyRequest+import           Control.Applicative                        (liftA2)+import           Data.Aeson                                 (Value(..))+import qualified Data.ByteString.Lazy                       as BL+import qualified Data.HashMap.Strict                        as H+import           Data.Scientific                            (fromFloatDigits)+import qualified Data.Vector                                as V+import qualified Gen.Header                                 as Header+import           Hedgehog                                   (Gen)+import qualified Hedgehog.Gen                               as Gen+import qualified Hedgehog.Range                             as Range+import           Network.HTTP.Types                         (renderStdMethod)+import           Data.Text                                  (Text)+import qualified Data.Text.Encoding                         as TE++proxyRequest :: Gen (ProxyRequest NoAuthorizer)+proxyRequest = do+  segments <- Resource.segments+  pathParameters <- Resource.vars segments+  let path = Resource.path pathParameters segments+      resource = Resource.resource segments+  multiValueHeaders <- Header.multiValueHeaders+  let headers = head <$> multiValueHeaders+  stageVariables <- fmap head <$> Parameters.multiParameters+  httpMethod <- method+  requestContext <- context path resource httpMethod+  multiValueQueryStringParameters <- Parameters.multiParameters+  let queryStringParameters = head <$> multiValueQueryStringParameters+  body <- BL.fromStrict <$> Gen.bytes (Range.exponential 1 1000)+  pure $ ProxyRequest+      { path = path+      , headers = headers+      , multiValueHeaders = multiValueHeaders+      , pathParameters = pathParameters+      , stageVariables = stageVariables+      , requestContext = requestContext+      , resource = resource+      , httpMethod = httpMethod+      , queryStringParameters = queryStringParameters+      , multiValueQueryStringParameters = multiValueQueryStringParameters+      , body = body+      }++method :: Gen Text+method = TE.decodeUtf8 . renderStdMethod <$> Gen.enumBounded++context :: Text -> Text -> Text -> Gen (RequestContext NoAuthorizer)+context path resourcePath httpMethod = do+  accountId <- Gen.text (Range.singleton 12) Gen.digit+  authorizer <- Gen.maybe authJson+  resourceId <- text+  stage <- text+  domainPrefix <- Gen.maybe $ Gen.text (Range.linear 1 15) Gen.alphaNum+  requestId <- text+  identity <- ident+  domainName <- Gen.maybe text+  extendedRequestId <- Gen.maybe text+  apiId <- text+  pure $ RequestContext+      { path = path+      , accountId = accountId+      , authorizer = authorizer+      , resourceId = resourceId+      , stage = stage+      , domainPrefix = domainPrefix+      , requestId = requestId+      , identity = identity+      , domainName = domainName+      , resourcePath = resourcePath+      , httpMethod = httpMethod+      , extendedRequestId = extendedRequestId+      , apiId = apiId+      }++ident :: Gen Identity+ident = Identity+  <$> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text+  <*> Gen.maybe text++text :: Gen Text+text = Gen.text (Range.linear 1 15) Gen.unicode++-- | Generate JSON for an authorizer blob.+--+-- __NOTE:__ We do not generate @null@s, because they kill+-- round-tripping: '.:?' deserializes both @null@ and missing keys to+-- @Nothing@.+authJson :: Gen Value+authJson = Gen.recursive Gen.choice+    [string, number, Bool <$> Gen.bool]+    [object, array]+    where+        object = Object . H.fromList <$> Gen.list (Range.linear 1 50) entry+        entry = liftA2 (,) text authJson+        array = Array . V.fromList <$> Gen.list (Range.linear 1 50) authJson+        string = String <$> Gen.text (Range.exponential 1 200) Gen.unicode+        number = Number . fromFloatDigits <$>+            Gen.double (Range.exponentialFloatFrom 0 (-10**23) (10**23))

@@ -0,0 +1,39 @@+module AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen.Parameters where++import           Control.Monad.Trans.State+import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as H+import           Data.Semigroup            ((<>))+import           Data.Set                  (Set)+import qualified Data.Set                  as S+import           Data.Text                 (Text)+import           Hedgehog+import qualified Hedgehog.Gen              as Gen+import qualified Hedgehog.Range            as Range++multiParameters :: Gen (HashMap Text [Text])+multiParameters = H.fromListWith (<>) <$>+    evalStateT (Gen.list (Range.linear 1 10) parameter) S.empty++parameter :: StateT (Set Text) Gen (Text, [Text])+parameter = Gen.choice [fresh, clash] where+    fresh = do+        vars <- get+        newVar <- Gen.filterT (not . (`S.member` vars)) var+        put $ S.insert newVar vars+        v <- val+        pure (newVar, [v])+    clash = do+        vars <- get+        if null vars+        then fresh+        else do+            var <- Gen.element $ S.toList vars+            v <- val+            pure (var, [v])++var :: MonadGen g => g Text+var = Gen.text (Range.linear 1 10) Gen.alpha++val :: MonadGen g => g Text+val = Gen.text (Range.linear 1 15) Gen.unicode

@@ -0,0 +1,65 @@+{-# LANGUAGE LambdaCase #-}++module AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen.Resource where++import           Control.Monad             (foldM)+import           Control.Monad.Trans.State (StateT, evalStateT, get, put)+import           Data.Foldable             (toList)+import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as H+import           Data.List.NonEmpty        (NonEmpty)+import qualified Data.List.NonEmpty        as NE+import           Data.Semigroup            ((<>))+import qualified Data.Set                  as S+import           Data.Text                 (Text)+import qualified Data.Text                 as T+import           Hedgehog+import qualified Hedgehog.Gen              as Gen+import qualified Hedgehog.Range            as Range++data ResourceSegment = Literal Text | Variable Text deriving (Eq, Show)++segments :: Gen (NonEmpty ResourceSegment)+segments = flip evalStateT S.empty+    . fmap NE.fromList+    . Gen.list (Range.linear 1 10)+    $ Gen.choice+        [ Literal <$> Gen.text (Range.linear 1 10) Gen.alpha+        , Variable <$> var+        ]++-- | Generate a variable mapping for a resource path.+vars :: Foldable t => t ResourceSegment -> Gen (HashMap Text Text)+vars = foldM addVar H.empty+    where+        addVar m = \case+            Literal{} -> pure m+            Variable v -> do+                value <- Gen.text (Range.linear 1 20) Gen.unicode+                pure $ H.insert v value m++-- | Instantiate vars in a resource path.+path :: HashMap Text Text -> NonEmpty ResourceSegment -> Text+path vars = ("/" <>) . T.intercalate "/" . toList . fmap toText+    where+        toText = \case+            Literal t -> t+            Variable v -> vars H.! v++-- | Render a resource path with @{var}@ to indicate variables+resource :: NonEmpty ResourceSegment -> Text+resource = ("/" <>) . T.intercalate "/" . toList . fmap toText+    where+        toText = \case+            Literal t -> t+            Variable v -> "{" <> v <> "}"++-- | Generate one variable name for a resource path, and don't reuse+-- variable names.+var :: StateT (S.Set Text) Gen Text+var = do+    vars <- get+    newVar <- Gen.filterT (not . (`S.member` vars)) $+        Gen.text (Range.linear 1 10) Gen.alpha+    put $ S.insert newVar vars+    pure newVar

@@ -0,0 +1,93 @@+{-# LANGUAGE TupleSections #-}++module AWS.Lambda.Events.ApiGateway.ProxyResponse.Gen where++import           AWS.Lambda.Events.ApiGateway.ProxyResponse+import qualified Data.ByteString.Base64                     as B64+import           Data.CaseInsensitive                       (CI)+import qualified Data.CaseInsensitive                       as CI+import           Data.HashMap.Strict                        (HashMap)+import qualified Data.Set                                   as S+import           Data.Text                                  (Text)+import qualified Data.Text.Encoding                         as TE+import qualified Gen.Header                                 as Header+import           Hedgehog+import qualified Hedgehog.Gen                               as Gen+import qualified Hedgehog.Range                             as Range+import           Network.HTTP.Types                         (hContentType)++proxyResponse :: Gen ProxyResponse+proxyResponse = ProxyResponse+    <$> responseStatus+    <*> responseHeaders+    <*> responseBody++responseStatus :: Gen Status+responseStatus = Gen.element+    [ continue100+    , switchingProtocols101+    , ok200+    , created201+    , accepted202+    , nonAuthoritative203+    , noContent204+    , resetContent205+    , partialContent206+    , multipleChoices300+    , movedPermanently301+    , found302+    , seeOther303+    , notModified304+    , useProxy305+    , temporaryRedirect307+    , permanentRedirect308+    , badRequest400+    , unauthorized401+    , paymentRequired402+    , forbidden403+    , notFound404+    , methodNotAllowed405+    , notAcceptable406+    , proxyAuthenticationRequired407+    , requestTimeout408+    , conflict409+    , gone410+    , lengthRequired411+    , preconditionFailed412+    , requestEntityTooLarge413+    , requestURITooLong414+    , unsupportedMediaType415+    , requestedRangeNotSatisfiable416+    , expectationFailed417+    , imATeapot418+    , unprocessableEntity422+    , upgradeRequired426+    , preconditionRequired428+    , tooManyRequests429+    , requestHeaderFieldsTooLarge431+    , internalServerError500+    , notImplemented501+    , badGateway502+    , serviceUnavailable503+    , gatewayTimeout504+    , httpVersionNotSupported505+    , networkAuthenticationRequired511+    ]++-- | Do not generate @Content-Type@ headers, as they will break+-- round-tripping: the 'ToJSON' instance for 'ProxyResponse' drops the+-- 'contentType' of the 'ProxyBody' if such a header is present.+responseHeaders :: Gen (HashMap (CI Text) [Text])+responseHeaders = Header.multiValueHeadersExcept+    . S.singleton+    $ CI.map TE.decodeUtf8 hContentType++responseBody :: Gen ProxyBody+responseBody = do+  contentType <- Gen.text (Range.linear 1 20) Gen.latin1+  (serialized, isBase64Encoded) <- Gen.choice+      [ (, False) <$> Gen.text (Range.exponential 1 2000) Gen.unicode+      , (, True) . TE.decodeUtf8 . B64.encode <$>+            Gen.bytes (Range.exponential 1 2000)+      ]+  pure $ ProxyBody contentType serialized isBase64Encoded

@@ -0,0 +1,123 @@+module Gen.Header where++import           Control.Monad.Trans.State+import           Data.CaseInsensitive      (CI)+import qualified Data.CaseInsensitive      as CI+import           Data.Char                 (toUpper, toLower)+import           Data.HashMap.Strict       (HashMap)+import qualified Data.HashMap.Strict       as H+import           Data.Semigroup            ((<>))+import           Data.Set                  (Set)+import qualified Data.Set                  as S+import           Data.Text                 (Text)+import qualified Data.Text                 as T+import qualified Data.Text.Encoding        as TE+import           Data.Traversable          (for)+import           Hedgehog+import qualified Hedgehog.Gen              as Gen+import qualified Hedgehog.Range            as Range+import           Network.HTTP.Types.Header++multiValueHeaders :: Gen (HashMap (CI Text) [Text])+multiValueHeaders = multiValueHeadersExcept S.empty++multiValueHeadersExcept :: Set (CI Text) -> Gen (HashMap (CI Text) [Text])+multiValueHeadersExcept exclusions = H.fromListWith (<>) <$>+    evalStateT+        (Gen.list (Range.linear 1 30) $ singleHeaderExcept exclusions)+        S.empty++singleHeaderExcept :: Set (CI Text) -> StateT (Set (CI Text)) Gen (CI Text, [Text])+singleHeaderExcept exclusions = Gen.choice [fresh, clash] where+    fresh = do+        headers <- get+        newHeader <- Gen.filterT+            (\h -> not $ S.member h headers || S.member h exclusions)+            header+        put $ S.insert newHeader headers+        headerVal <- val+        pure (newHeader, [headerVal])+    clash = do+        headers <- get+        if null headers+        then fresh+        else do+            header <- Gen.filterT+                (\h -> not $ S.member h exclusions)+                (Gen.element (S.toList headers))+                >>= unfoldCase+            headerVal <- val+            pure (header, [headerVal])++header :: MonadGen g => g (CI Text)+header = Gen.choice+    [ CI.mk <$> Gen.text (Range.linear 1 15) Gen.alpha+    , standardHeader+    ]++standardHeader :: MonadGen g => g (CI Text)+standardHeader = CI.map TE.decodeUtf8 <$> Gen.element+    [ hAccept+    , hAcceptCharset+    , hAcceptEncoding+    , hAcceptLanguage+    , hAcceptRanges+    , hAge+    , hAllow+    , hAuthorization+    , hCacheControl+    , hConnection+    , hContentEncoding+    , hContentLanguage+    , hContentLength+    , hContentLocation+    , hContentMD5+    , hContentRange+    , hContentType+    , hDate+    , hETag+    , hExpect+    , hExpires+    , hFrom+    , hHost+    , hIfMatch+    , hIfModifiedSince+    , hIfNoneMatch+    , hIfRange+    , hIfUnmodifiedSince+    , hLastModified+    , hLocation+    , hMaxForwards+    , hOrigin+    , hPragma+    , hPrefer+    , hPreferenceApplied+    , hProxyAuthenticate+    , hProxyAuthorization+    , hRange+    , hReferer+    , hRetryAfter+    , hServer+    , hTE+    , hTrailer+    , hTransferEncoding+    , hUpgrade+    , hUserAgent+    , hVary+    , hVia+    , hWWWAuthenticate+    , hWarning+    , hContentDisposition+    , hMIMEVersion+    , hCookie+    , hSetCookie+    ]++-- | Create some permutation of the input text, that compares as equal+-- under 'CI'.+unfoldCase :: MonadGen g => CI Text -> g (CI Text)+unfoldCase t = CI.mk . T.pack <$> for (T.unpack $ CI.original t) flipCase+    where flipCase c = Gen.element [toUpper c, toLower c]++val :: MonadGen g => g Text+val = Gen.text (Range.linear 1 15) Gen.unicode

@@ -2,16 +2,24 @@                                                     ClientContext (..),                                                     CognitoIdentity (..),                                                     LambdaContext (..))+import qualified Gen.Header                        as Header+import qualified AWS.Lambda.Events.ApiGateway.ProxyRequest.Gen as ProxyRequest+import qualified AWS.Lambda.Events.ApiGateway.ProxyResponse.Gen as ProxyResponse import           AWS.Lambda.Internal               (StaticContext (..)) import           AWS.Lambda.RuntimeClient.Internal (eventResponseToNextData)-import           Data.Aeson                        (Value (Null))+import           Data.Aeson                        (Value (Null), decode, encode)+import qualified Data.CaseInsensitive              as CI import           Data.Map                          (singleton) import           Data.Semigroup                    ((<>)) import           Data.Time.Clock.POSIX             (posixSecondsToUTCTime)+import           Hedgehog+import qualified Hedgehog.Gen                      as Gen+import qualified Hedgehog.Range                    as Range import           Network.HTTP.Client.Internal      (Response (..)) import           Network.HTTP.Types                (Header) import           Test.Hspec                        (describe, it, shouldBe,-                                                    shouldStartWith)+                                                    shouldStartWith, specify)+import           Test.Hspec.Hedgehog               (hedgehog) import           Test.Hspec.Runner                 (hspec)  main :: IO ()@@ -198,6 +206,25 @@         context `shouldBe`           (Left              "Runtime Error: Unable to decode Context from event response.\nCould not parse deadline")++    describe "properties" $ do+        specify "Header.unfoldCase preserves equality" $+            hedgehog $ do+                -- CI only promises equality over the Latin-1 set+                s <- forAll $ CI.mk <$> Gen.text (Range.linear 1 100) Gen.latin1+                t <- forAll $ Header.unfoldCase s+                s === t++        specify "ProxyRequest tripping" $+            hedgehog $ do+                request <- forAll ProxyRequest.proxyRequest+                tripping request encode decode++        specify "ProxyResponse tripping" $+            hedgehog $ do+                request <- forAll ProxyResponse.proxyResponse+                tripping request encode decode+  minResponse :: [Header] -> a -> Response a minResponse headers body =