amazonka-mtl (empty) → 0.1.0.0

raw patch · 15 files changed

+1154/−0 lines, 15 filesdep +Blammodep +amazonkadep +amazonka-core

Dependencies added: Blammo, amazonka, amazonka-core, amazonka-mtl, amazonka-s3, base, conduit, hspec, lens, markdown-unlit, mtl, resourcet, text, time, unliftio-core

Files

CHANGELOG.md +5/−0
LICENSE +21/−0
README.lhs +105/−0
README.md +105/−0
amazonka-mtl.cabal +187/−0
library/Control/Monad/AWS.hs +76/−0
library/Control/Monad/AWS/Class.hs +33/−0
library/Control/Monad/AWS/EnvT.hs +51/−0
library/Control/Monad/AWS/Matchers.hs +121/−0
library/Control/Monad/AWS/MockT.hs +62/−0
library/Control/Monad/AWS/ViaMock.hs +78/−0
library/Control/Monad/AWS/ViaReader.hs +104/−0
package.yaml +142/−0
tests/Control/Monad/AWSSpec.hs +63/−0
tests/Spec.hs +1/−0

+ CHANGELOG.md view

@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/amazonka-mtl/compare/v0.1.0.0...main)++## [v0.1.0.0](https://github.com/freckle/amazonka-mtl/tree/v0.1.0.0)++First tagged pre-release.

+ LICENSE view

@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2021 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

+ README.lhs view

@@ -0,0 +1,105 @@+# amazonka-mtl++[![Hackage](https://img.shields.io/hackage/v/amazonka-mtl.svg?style=flat)](https://hackage.haskell.org/package/amazonka-mtl)+[![Stackage Nightly](http://stackage.org/package/amazonka-mtl/badge/nightly)](http://stackage.org/nightly/package/amazonka-mtl)+[![Stackage LTS](http://stackage.org/package/amazonka-mtl/badge/lts)](http://stackage.org/lts/package/amazonka-mtl)+[![CI](https://github.com/freckle/amazonka-mtl/actions/workflows/ci.yml/badge.svg)](https://github.com/freckle/amazonka-mtl/actions/workflows/ci.yml)++MTL-style type-class and deriving-via newtypes for Amazonka.++## Example++This package allows incorporation of AWS actions into any MTL-style function,++<!--+```haskell+{-# OPTIONS_GHC -Wno-unused-top-binds #-}++module Main (main) where++import Prelude++import Amazonka.S3 (BucketName)+import Control.Monad.Reader (MonadReader)+import Text.Markdown.Unlit ()+```+-->++```haskell+import Amazonka.Data.Text (ToText(..))+import Amazonka.S3.ListObjects+import Amazonka.S3.Types.Object+import Blammo.Logging+import Conduit+import Control.Lens hiding ((.=))+import Control.Monad.AWS as AWS+```++<!--+```haskell+data Settings = Settings+  { settingsBucketName :: BucketName+  }++class HasSettings env where+  settingsL :: Lens' env Settings++instance HasSettings Settings where+  settingsL = id+```+-->++```haskell+someAction+  :: ( MonadIO m+     , MonadLogger m+     , MonadAWS m+     , MonadReader env m+     , HasSettings env+     )+  => m ()+someAction = do+  Settings {..} <- view settingsL++  keys <-+    runConduit+      $ paginate (newListObjects settingsBucketName)+      .| concatMapC (^. listObjectsResponse_contents)+      .| concatC+      .| mapC (^. object_key . to toText)+      .| iterMC (\k -> logDebug $ k :# [])+      .| sinkList++  logInfo $ "Bucket contents" :# ["keys" .= keys]+```++<!--+```haskell+main :: IO ()+main = pure ()+```+-->++This package also provides a number of options for execution:++- Through a concrete transformer: `Control.Monad.AWS.EnvT`+- Through your own reader env and deriving-via: `Control.Monad.AWS.ViaReader`++This package also provides mechanisms for mocking AWS in tests:++- Through a concrete transformer: `Control.Monad.AWS.MockT`+- Through your own reader env and deriving-via: `Control.Monad.AWS.ViaMock`++Please see the [documentation on hackage][hackage] for all the details.++[hackage]: https://hackage.haskell.org/package/amazonka-mtl++## Development & Tests++```console+stack build --fast --pedantic --test --file-watch+```++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)

+ README.md view

@@ -0,0 +1,105 @@+# amazonka-mtl++[![Hackage](https://img.shields.io/hackage/v/amazonka-mtl.svg?style=flat)](https://hackage.haskell.org/package/amazonka-mtl)+[![Stackage Nightly](http://stackage.org/package/amazonka-mtl/badge/nightly)](http://stackage.org/nightly/package/amazonka-mtl)+[![Stackage LTS](http://stackage.org/package/amazonka-mtl/badge/lts)](http://stackage.org/lts/package/amazonka-mtl)+[![CI](https://github.com/freckle/amazonka-mtl/actions/workflows/ci.yml/badge.svg)](https://github.com/freckle/amazonka-mtl/actions/workflows/ci.yml)++MTL-style type-class and deriving-via newtypes for Amazonka.++## Example++This package allows incorporation of AWS actions into any MTL-style function,++<!--+```haskell+{-# OPTIONS_GHC -Wno-unused-top-binds #-}++module Main (main) where++import Prelude++import Amazonka.S3 (BucketName)+import Control.Monad.Reader (MonadReader)+import Text.Markdown.Unlit ()+```+-->++```haskell+import Amazonka.Data.Text (ToText(..))+import Amazonka.S3.ListObjects+import Amazonka.S3.Types.Object+import Blammo.Logging+import Conduit+import Control.Lens hiding ((.=))+import Control.Monad.AWS as AWS+```++<!--+```haskell+data Settings = Settings+  { settingsBucketName :: BucketName+  }++class HasSettings env where+  settingsL :: Lens' env Settings++instance HasSettings Settings where+  settingsL = id+```+-->++```haskell+someAction+  :: ( MonadIO m+     , MonadLogger m+     , MonadAWS m+     , MonadReader env m+     , HasSettings env+     )+  => m ()+someAction = do+  Settings {..} <- view settingsL++  keys <-+    runConduit+      $ paginate (newListObjects settingsBucketName)+      .| concatMapC (^. listObjectsResponse_contents)+      .| concatC+      .| mapC (^. object_key . to toText)+      .| iterMC (\k -> logDebug $ k :# [])+      .| sinkList++  logInfo $ "Bucket contents" :# ["keys" .= keys]+```++<!--+```haskell+main :: IO ()+main = pure ()+```+-->++This package also provides a number of options for execution:++- Through a concrete transformer: `Control.Monad.AWS.EnvT`+- Through your own reader env and deriving-via: `Control.Monad.AWS.ViaReader`++This package also provides mechanisms for mocking AWS in tests:++- Through a concrete transformer: `Control.Monad.AWS.MockT`+- Through your own reader env and deriving-via: `Control.Monad.AWS.ViaMock`++Please see the [documentation on hackage][hackage] for all the details.++[hackage]: https://hackage.haskell.org/package/amazonka-mtl++## Development & Tests++```console+stack build --fast --pedantic --test --file-watch+```++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)

+ amazonka-mtl.cabal view

@@ -0,0 +1,187 @@+cabal-version:      1.18+name:               amazonka-mtl+version:            0.1.0.0+license:            MIT+license-file:       LICENSE+maintainer:         Freckle Education+homepage:           https://github.com/freckle/amazonka-mtl#readme+bug-reports:        https://github.com/freckle/amazonka-mtl/issues+synopsis:           MTL-style type-class and deriving-via newtypes for Amazonka+description:+    This package allows incorporation of AWS actions into any MTL-style function,+    .+    > import Amazonka.Data.Text (ToText(..))+    > import Amazonka.S3.ListObjects+    > import Amazonka.S3.Types.Object+    > import Blammo.Logging+    > import Conduit+    > import Control.Lens hiding ((.=))+    > import Control.Monad.AWS as AWS+    >+    > someAction+    >   :: ( MonadIO m+    >      , MonadLogger m+    >      , MonadAWS m+    >      , MonadReader env m+    >      , HasSettings env+    >      )+    >   => m ()+    > someAction = do+    >   Settings {..} <- view settingsL+    >+    >   keys <-+    >     runConduit+    >       $ paginate (newListObjects settingsBucketName)+    >       .| concatMapC (^. listObjectsResponse_contents)+    >       .| concatC+    >       .| mapC (^. object_key . to toText)+    >       .| iterMC (\k -> logDebug $ k :# [])+    >       .| sinkList+    >+    >   logInfo $ "Bucket contents" :# ["keys" .= keys]+    .+    This package also provides a number of options for execution:+    .+    * Through a concrete transformer: "Control.Monad.AWS.EnvT"+    * Through your own reader env and deriving-via: "Control.Monad.AWS.ViaReader"+    .+    This package also provides mechanisms for mocking AWS in tests:+    .+    * Through a concrete transformer: "Control.Monad.AWS.MockT"+    * Through your own reader env and deriving-via: "Control.Monad.AWS.ViaMock"+    .+    Please see individual module documentation for all the details.++category:           Utils+build-type:         Simple+extra-source-files: package.yaml+extra-doc-files:+    README.md+    CHANGELOG.md++source-repository head+    type:     git+    location: https://github.com/freckle/amazonka-mtl++library+    exposed-modules:+        Control.Monad.AWS+        Control.Monad.AWS.Class+        Control.Monad.AWS.EnvT+        Control.Monad.AWS.Matchers+        Control.Monad.AWS.MockT+        Control.Monad.AWS.ViaMock+        Control.Monad.AWS.ViaReader++    hs-source-dirs:     library+    other-modules:      Paths_amazonka_mtl+    default-language:   Haskell2010+    default-extensions:+        BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+        DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+        FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+        LambdaCase MultiParamTypeClasses NoImplicitPrelude+        NoMonomorphismRestriction OverloadedStrings RankNTypes+        RecordWildCards ScopedTypeVariables StandaloneDeriving+        TypeApplications TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe++    build-depends:+        amazonka,+        amazonka-core,+        base >=4.14.3.0 && <5,+        conduit,+        lens,+        mtl,+        resourcet,+        unliftio-core++    if impl(ghc >=9.2)+        ghc-options: -Wno-missing-kind-signatures++    if impl(ghc >=8.10)+        ghc-options:+            -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++test-suite readme+    type:               exitcode-stdio-1.0+    main-is:            README.lhs+    other-modules:      Paths_amazonka_mtl+    default-language:   Haskell2010+    default-extensions:+        BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+        DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+        FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+        LambdaCase MultiParamTypeClasses NoImplicitPrelude+        NoMonomorphismRestriction OverloadedStrings RankNTypes+        RecordWildCards ScopedTypeVariables StandaloneDeriving+        TypeApplications TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe -pgmL+        markdown-unlit++    build-depends:+        Blammo,+        amazonka-core,+        amazonka-mtl,+        amazonka-s3,+        base >=4.14.3.0 && <5,+        conduit,+        lens,+        markdown-unlit,+        mtl++    if impl(ghc >=9.2)+        ghc-options: -Wno-missing-kind-signatures++    if impl(ghc >=8.10)+        ghc-options:+            -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++test-suite spec+    type:               exitcode-stdio-1.0+    main-is:            Spec.hs+    hs-source-dirs:     tests+    other-modules:+        Control.Monad.AWSSpec+        Paths_amazonka_mtl++    default-language:   Haskell2010+    default-extensions:+        BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+        DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+        FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+        LambdaCase MultiParamTypeClasses NoImplicitPrelude+        NoMonomorphismRestriction OverloadedStrings RankNTypes+        RecordWildCards ScopedTypeVariables StandaloneDeriving+        TypeApplications TypeFamilies++    ghc-options:+        -Weverything -Wno-missing-exported-signatures+        -Wno-missing-import-lists -Wno-missing-local-signatures+        -Wno-monomorphism-restriction -Wno-unsafe -Wno-safe -threaded+        -rtsopts -with-rtsopts=-N++    build-depends:+        amazonka-core,+        amazonka-mtl,+        amazonka-s3,+        base >=4.14.3.0 && <5,+        hspec,+        lens,+        text,+        time++    if impl(ghc >=9.2)+        ghc-options: -Wno-missing-kind-signatures++    if impl(ghc >=8.10)+        ghc-options:+            -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module

+ library/Control/Monad/AWS.hs view

@@ -0,0 +1,76 @@+module Control.Monad.AWS+  ( MonadAWS (..)+  , send+  , paginate+  , paginateEither+  , await++    -- * Concrete transformers+  , EnvT+  , runEnvT+  , MockT+  , runMockT+  ) where++import Amazonka.Prelude++import Amazonka.Core (AWSPager, AWSRequest, AWSResponse, Error)+import qualified Amazonka.Pager as Pager+import qualified Amazonka.Waiter as Waiter+import qualified Control.Exception as Exception+import Control.Monad.AWS.Class+import Control.Monad.AWS.EnvT+import Control.Monad.AWS.MockT+import Data.Conduit (ConduitM)+import qualified Data.Conduit as Conduit+import Data.Typeable (Typeable)++-- | Version of 'Amazonka.send' built on our 'sendEither'+send+  :: ( MonadIO m+     , MonadAWS m+     , AWSRequest a+     , Typeable a+     , Typeable (AWSResponse a)+     )+  => a+  -> m (AWSResponse a)+send = sendEither >=> hoistEither++-- | Version of 'Amazonka.paginateEither' built on our 'sendEither'+paginateEither+  :: (MonadAWS m, AWSPager a, Typeable a, Typeable (AWSResponse a))+  => a+  -> ConduitM () (AWSResponse a) m (Either Error ())+paginateEither = go+ where+  go rq =+    lift (sendEither rq) >>= \case+      Left err -> pure (Left err)+      Right rs -> do+        Conduit.yield rs+        maybe (pure (Right ())) go (Pager.page rq rs)++-- | Version of 'Amazonka.paginate' built on our 'paginateEither'+paginate+  :: ( MonadIO m+     , MonadAWS m+     , AWSPager a+     , Typeable a+     , Typeable (AWSResponse a)+     )+  => a+  -> ConduitM () (AWSResponse a) m ()+paginate =+  paginateEither >=> hoistEither++-- | Version of 'Amazonka.await' built on our 'awaitEither'+await+  :: (MonadIO m, MonadAWS m, AWSRequest a, Typeable a)+  => Waiter.Wait a+  -> a+  -> m Waiter.Accept+await wait = awaitEither wait >=> hoistEither++hoistEither :: MonadIO m => Either Error a -> m a+hoistEither = either (liftIO . Exception.throwIO) pure

+ library/Control/Monad/AWS/Class.hs view

@@ -0,0 +1,33 @@+module Control.Monad.AWS.Class+  ( MonadAWS (..)+  )+where++import Amazonka.Prelude++import Amazonka.Core (AWSRequest, AWSResponse, Error)+import qualified Amazonka.Waiter as Waiter+import Data.Typeable (Typeable)++-- | Typeclass for making AWS requests via "Amazonka"+--+-- For out-of-the-box transformers, see:+--+-- - "Control.Monad.AWS.EnvT"+-- - "Control.Monad.AWS.MockT"+--+-- For @DerivingVia@ usage, see:+--+-- - "Control.Monad.AWS.ViaReader"+-- - "Control.Monad.AWS.ViaMock"+class Monad m => MonadAWS m where+  sendEither+    :: (AWSRequest a, Typeable a, Typeable (AWSResponse a))+    => a+    -> m (Either Error (AWSResponse a))++  awaitEither+    :: (AWSRequest a, Typeable a)+    => Waiter.Wait a+    -> a+    -> m (Either Error Waiter.Accept)

+ library/Control/Monad/AWS/EnvT.hs view

@@ -0,0 +1,51 @@+{-# LANGUAGE DerivingVia #-}++-- | Concrete reader monad over 'Env'+--+-- Its 'MonadAWS' instance can be used in situations where you don't have or+-- want your own app transformer:+--+-- @+-- import qualified "Amazonka"+-- import "Amazonka.S3"+-- import "Control.Monad.AWS"+--+-- main :: IO ()+-- main = do+--   env <- 'Amazonka.newEnv' 'Amazonka.discover'+--   'runEnvT' someAction env+--+-- someAction :: (MonadIO m, 'MonadAWS' m) => m ()+-- someAction = do+--   resp <- 'send' 'newListBuckets'+--   liftIO $ print resp+-- @+module Control.Monad.AWS.EnvT+  ( EnvT+  , runEnvT+  )+where++import Prelude++import Control.Monad.AWS.Class+import Control.Monad.AWS.ViaReader+import Control.Monad.Reader+import Control.Monad.Trans.Resource++newtype EnvT m a = EnvT+  { unEnvT :: ReaderT Env (ResourceT m) a+  }+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadUnliftIO+    , MonadResource+    , MonadReader Env+    )+  deriving (MonadAWS) via (ReaderAWS (EnvT m))++runEnvT :: MonadUnliftIO m => EnvT m a -> Env -> m a+runEnvT f = runResourceT . runReaderT (unEnvT f)

+ library/Control/Monad/AWS/Matchers.hs view

@@ -0,0 +1,121 @@+{-# LANGUAGE AllowAmbiguousTypes #-}++module Control.Monad.AWS.Matchers+  ( Matchers+  , HasMatchers (..)+  , Matcher (..)+  , withMatcher+  , withMatchers+  , matchSend+  , matchAwait+  , UnmatchedRequestError (..)+  ) where++import Prelude++import Amazonka (AWSRequest, AWSResponse, Error)+import qualified Amazonka.Waiter as Waiter+import Control.Exception (Exception (..), throwIO)+import Control.Lens (Lens', view, (<>~))+import Control.Monad (guard)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Reader (MonadReader (..))+import Data.Maybe (listToMaybe, mapMaybe)+import Data.Typeable++-- | Define a response to provide for any matched requests+data Matcher where+  -- Matches calls to 'send' where the given predicate holds+  SendMatcher+    :: forall a+     . (AWSRequest a, Typeable a, Typeable (AWSResponse a))+    => (a -> Bool)+    -> Either Error (AWSResponse a)+    -> Matcher+  -- Matches calls to 'await' where the given predicate holds+  AwaitMatcher+    :: forall a+     . (AWSRequest a, Typeable a)+    => (Waiter.Wait a -> a -> Bool)+    -> Either Error Waiter.Accept+    -> Matcher++newtype Matchers = Matchers+  { unMatchers :: [Matcher]+  }+  deriving newtype (Semigroup, Monoid)++class HasMatchers env where+  matchersL :: Lens' env Matchers++instance HasMatchers Matchers where+  matchersL = id++-- | Add a 'Matcher' for the duration of the block+withMatcher :: (MonadReader env m, HasMatchers env) => Matcher -> m a -> m a+withMatcher = withMatchers . pure++-- | Add multiple 'Matcher's for the duration of the block+withMatchers :: (MonadReader env m, HasMatchers env) => [Matcher] -> m a -> m a+withMatchers ms = local $ matchersL <>~ Matchers ms++matchSend+  :: forall m env a+   . ( MonadIO m+     , MonadReader env m+     , HasMatchers env+     , Typeable a+     , Typeable (AWSResponse a)+     )+  => a+  -> m (Either Error (AWSResponse a))+matchSend req = throwUnmatched @a =<< firstMatcher go+ where+  go = \case+    SendMatcher matchReq resp -> do+      guard . matchReq =<< cast req+      cast resp+    AwaitMatcher {} -> Nothing++matchAwait+  :: forall m env a+   . (MonadIO m, MonadReader env m, HasMatchers env, Typeable a)+  => Waiter.Wait a+  -> a+  -> m (Either Error Waiter.Accept)+matchAwait w req = throwUnmatched @a =<< firstMatcher go+ where+  go = \case+    SendMatcher {} -> Nothing+    AwaitMatcher matchReq acc -> do+      guard =<< matchReq <$> cast w <*> cast req+      cast acc++firstMatcher+  :: (MonadReader env m, HasMatchers env)+  => (Matcher -> Maybe a)+  -> m (Maybe a)+firstMatcher f = do+  matchers <- view matchersL+  pure $ listToMaybe $ mapMaybe f $ unMatchers matchers++newtype UnmatchedRequestError = UnmatchedRequestError+  { unmatchedRequestType :: String+  }+  deriving anyclass (Exception)++-- Morally-speaking, Show should be reserved for a Haskell-like string+-- representation (derived is best), and displayException is where you make it+-- human-readable. Sadly, too many tools (*cough* hspec) use show instead of+-- displayException, and we want it to look nice there. Sigh.+instance Show UnmatchedRequestError where+  show ex =+    "Unexpected AWS request made within MockT: "+      <> unmatchedRequestType ex+      <> "\nUse withMatcher to add a Matcher for this request"++throwUnmatched :: forall req m a. (MonadIO m, Typeable req) => Maybe a -> m a+throwUnmatched =+  maybe+    (liftIO $ throwIO $ UnmatchedRequestError $ show $ typeRep $ Proxy @req)+    pure

+ library/Control/Monad/AWS/MockT.hs view

@@ -0,0 +1,62 @@+{-# LANGUAGE DerivingVia #-}++-- | Concrete reader monad over 'Matchers'+--+-- Its 'MonadAWS' instance can be used in tests where you don't have or+-- want your own test-app transformer:+--+-- @+-- import "Amazonka.S3"+-- import "Control.Monad.AWS"+--+-- spec :: Spec+-- spec = do+--   describe "someAction" $ do+--     it "works" $ do+--       let matcher = 'SendMatcher' (const True) -- match all calls+--            $ 'newListBucketsResponse'          -- return no buckets+--            & 'listBucketsResponse_buckets' ?~ []+--+--       names <- 'runMockT' $ 'withMatcher' matcher $ someAction+--       names `shouldBe` []+--+-- someAction :: (MonadIO m, 'MonadAWS') m => m [BucketName]+-- someAction = do+--   resp <- 'send' 'newListBuckets'+--   pure+--     $ maybe [] (map (^. bucket_name))+--     $ resp ^. listBucketsResponse_buckets+-- @+module Control.Monad.AWS.MockT+  ( MockT+  , runMockT++    -- * Setting up 'Matchers'+  , Matcher (..)+  , withMatcher+  , withMatchers+  ) where++import Prelude++import Control.Monad.AWS.Class+import Control.Monad.AWS.Matchers+import Control.Monad.AWS.ViaMock+import Control.Monad.IO.Unlift+import Control.Monad.Reader++newtype MockT m a = MockT+  { unMockT :: ReaderT Matchers m a+  }+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadUnliftIO+    , MonadReader Matchers+    )+  deriving (MonadAWS) via (MockAWS (MockT m))++runMockT :: MockT m a -> m a+runMockT f = runReaderT (unMockT f) mempty

+ library/Control/Monad/AWS/ViaMock.hs view

@@ -0,0 +1,78 @@+{-# LANGUAGE UndecidableInstances #-}++-- | @DerivingVia@ machinery for mocking AWS interactions in tests+--+-- This module assumes your specs run in a custom transformer that can provide a+-- reader environment. If you define 'HasMatchers' for that environment, you can+-- then derive 'MonadAWS' for this transformer via 'MockAWS'.+--+-- For a more explicit alternative, see "Control.Monad.AWS.MockT".+--+-- === Example:+--+-- Assuming you have some implementation you wanted to test:+--+-- @+-- getBucketsByPrefix :: (MonadIO m, MonadAWS) m => Text -> m [Bucket]+-- getBucketsByPrefix p = do+--   resp <- send newListBuckets+--   pure+--    $ maybe [] (filter matchesPrefix)+--    $ resp ^. listBucketsResponse_buckets+--  where+--   matchesPrefix b = p `T.isPrefixOf` toText (b ^. bucket_name)+-- @+--+-- And assuming you've set up your example monad with 'MonadAWS' via 'MockAWS',+-- you can now test it without talking to AWS:+--+-- @+-- describe "getBucketsByPrefix" $ do+--   it "works" $ do+--     now <- getCurrentTime+--+--     let+--       bucketA = newBucket now "a-bucket"+--       bucketB = newBucket now "b-bucket"+--       bucketC = newBucket now "c-bucket"+--       buckets = [bucketA, bucketB, bucketC]+--       matcher =+--         SendMatcher (== newListBuckets)+--          $ Right+--          $ newListBucketsResponse 200+--          & listBucketsResponse_buckets ?~ buckets+--+--     withMatcher matcher $ do+--       buckets <- getBucketsByPrefix "b-"+--       buckets `shouldBe` [bucketB]+-- @+module Control.Monad.AWS.ViaMock+  ( Matchers+  , HasMatchers (..)+  , Matcher (..)+  , withMatcher+  , withMatchers+  , MockAWS (..)+  ) where++import Prelude++import Control.Monad.AWS.Class+import Control.Monad.AWS.Matchers+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Reader (MonadReader (..))++newtype MockAWS m a = MockAWS+  { unMockAWS :: m a+  }+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadReader env+    )++instance (MonadIO m, MonadReader env m, HasMatchers env) => MonadAWS (MockAWS m) where+  sendEither = matchSend+  awaitEither = matchAwait

+ library/Control/Monad/AWS/ViaReader.hs view

@@ -0,0 +1,104 @@+{-# LANGUAGE UndecidableInstances #-}++-- | @DerivingVia@ machinery for adding Amazonka functionality to a reader-like+-- transformer+--+-- This is useful when you have a /ReaderT-IO/-like stack implemented with an+-- @AppT@ wrapper to which you will add the 'MonadAWS' instance:+--+-- @+-- newtype AppT m a = AppT+--   -- ...+--   deriving MonadAWS via (ReaderAWS (AppT m))+-- @+--+-- Complete example:+--+-- @+-- {-# LANGUAGE DerivingVia #-}+--+-- module Main (main) where+--+-- import qualified "Amazonka"+-- import "Control.Lens"+-- import "Control.Monad.AWS"+-- import "Control.Monad.AWS.ViaReader"+-- import "Control.Monad.Reader"+-- import "Control.Monad.Trans.Resource"+--+-- data App = App+--   { -- ...+--   , appAWS :: 'Amazonka.Env'+--   }+--+-- instance HasEnv App where+--   envL = lens appAWS $ \x y -> x { appAWS = y }+--+-- newtype AppT m a = AppT+--   { unAppT :: ReaderT App (ResourceT m) a+--   }+--   deriving newtype+--     ( Functor+--     , Applicative+--     , Monad+--     , MonadIO+--     , MonadUnliftIO+--     , MonadResource+--     , MonadReader App+--     )+--   deriving 'MonadAWS' via ('ReaderAWS' (AppT m))+--+-- runAppT :: MonadUnliftIO m => AppT m a -> App -> m a+-- runAppT f app = runResourceT $ runReaderT (unAppT f) app+--+-- main :: IO ()+-- main = do+--   app <- undefined+--   runAppT someAction app+--+-- someAction :: (MonadIO m, 'MonadAWS' m) => m ()+-- someAction = do+--   resp <- 'send' 'newListBuckets'+--   liftIO $ print resp+-- @+module Control.Monad.AWS.ViaReader+  ( Env+  , HasEnv (..)+  , ReaderAWS (..)+  ) where++import Prelude++import Amazonka.Env+import qualified Amazonka.Send as Amazonka+import Control.Lens (Lens', view)+import Control.Monad.AWS.Class+import Control.Monad.Reader+import Control.Monad.Trans.Resource (MonadResource)++class HasEnv env where+  envL :: Lens' env Env++instance HasEnv Env where+  envL = id++newtype ReaderAWS m a = ReaderAWS+  { unReaderAWS :: m a+  }+  deriving newtype+    ( Functor+    , Applicative+    , Monad+    , MonadIO+    , MonadResource+    , MonadReader env+    )++instance (MonadResource m, MonadReader env m, HasEnv env) => MonadAWS (ReaderAWS m) where+  sendEither req = do+    env <- view envL+    Amazonka.sendEither env req++  awaitEither w a = do+    env <- view envL+    Amazonka.awaitEither env w a

+ package.yaml view

@@ -0,0 +1,142 @@+name: amazonka-mtl+version: 0.1.0.0+maintainer: Freckle Education+category: Utils+github: freckle/amazonka-mtl+synopsis: MTL-style type-class and deriving-via newtypes for Amazonka+description: |+  This package allows incorporation of AWS actions into any MTL-style function,++  > import Amazonka.Data.Text (ToText(..))+  > import Amazonka.S3.ListObjects+  > import Amazonka.S3.Types.Object+  > import Blammo.Logging+  > import Conduit+  > import Control.Lens hiding ((.=))+  > import Control.Monad.AWS as AWS+  >+  > someAction+  >   :: ( MonadIO m+  >      , MonadLogger m+  >      , MonadAWS m+  >      , MonadReader env m+  >      , HasSettings env+  >      )+  >   => m ()+  > someAction = do+  >   Settings {..} <- view settingsL+  >+  >   keys <-+  >     runConduit+  >       $ paginate (newListObjects settingsBucketName)+  >       .| concatMapC (^. listObjectsResponse_contents)+  >       .| concatC+  >       .| mapC (^. object_key . to toText)+  >       .| iterMC (\k -> logDebug $ k :# [])+  >       .| sinkList+  >+  >   logInfo $ "Bucket contents" :# ["keys" .= keys]++  This package also provides a number of options for execution:++  * Through a concrete transformer: "Control.Monad.AWS.EnvT"+  * Through your own reader env and deriving-via: "Control.Monad.AWS.ViaReader"++  This package also provides mechanisms for mocking AWS in tests:++  * Through a concrete transformer: "Control.Monad.AWS.MockT"+  * Through your own reader env and deriving-via: "Control.Monad.AWS.ViaMock"++  Please see individual module documentation for all the details.++extra-doc-files:+  - README.md+  - CHANGELOG.md++extra-source-files:+  - package.yaml++ghc-options:+  - -Weverything+  - -Wno-missing-exported-signatures # re-enables missing-signatures+  - -Wno-missing-import-lists+  - -Wno-missing-local-signatures+  - -Wno-monomorphism-restriction+  - -Wno-unsafe+  - -Wno-safe++when:+  - condition: "impl(ghc >= 9.2)"+    ghc-options:+      - -Wno-missing-kind-signatures+  - condition: "impl(ghc >= 8.10)"+    ghc-options:+      - -Wno-missing-safe-haskell-mode+      - -Wno-prepositive-qualified-module++dependencies:+  - base < 5++default-extensions:+  - BangPatterns+  - DataKinds+  - DeriveAnyClass+  - DeriveFoldable+  - DeriveFunctor+  - DeriveGeneric+  - DeriveLift+  - DeriveTraversable+  - DerivingStrategies+  - FlexibleContexts+  - FlexibleInstances+  - GADTs+  - GeneralizedNewtypeDeriving+  - LambdaCase+  - MultiParamTypeClasses+  - NoImplicitPrelude+  - NoMonomorphismRestriction+  - OverloadedStrings+  - RankNTypes+  - RecordWildCards+  - ScopedTypeVariables+  - StandaloneDeriving+  - TypeApplications+  - TypeFamilies++library:+  source-dirs: library+  dependencies:+    - amazonka+    - amazonka-core+    - conduit+    - lens+    - mtl+    - resourcet+    - unliftio-core++tests:+  spec:+    main: Spec.hs+    source-dirs: tests+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N"+    dependencies:+      - amazonka-core+      - amazonka-mtl+      - amazonka-s3+      - hspec+      - lens+      - text+      - time++  readme:+    main: README.lhs+    ghc-options: -pgmL markdown-unlit+    dependencies:+      - Blammo+      - amazonka-core+      - amazonka-mtl+      - amazonka-s3+      - conduit+      - lens+      - markdown-unlit+      - mtl

+ tests/Control/Monad/AWSSpec.hs view

@@ -0,0 +1,63 @@+{-# LANGUAGE DerivingVia #-}++module Control.Monad.AWSSpec+  ( spec+  ) where++import Prelude++import Amazonka.Data.Text (ToText (..))+import Amazonka.S3.ListBuckets+import Amazonka.S3.Types.Bucket+import Control.Exception (Exception (..), try)+import Control.Lens ((&), (?~), (^.))+import Control.Monad.AWS+import Control.Monad.AWS.Matchers+import Control.Monad.IO.Class (MonadIO (..))+import Data.Text (Text)+import qualified Data.Text as T+import Data.Time (getCurrentTime)+import Test.Hspec++listBucketsMatching :: (MonadIO m, MonadAWS m) => Text -> m [Bucket]+listBucketsMatching p = do+  resp <- send newListBuckets+  pure $ maybe [] (filter match) $ resp ^. listBucketsResponse_buckets+ where+  match b = p `T.isPrefixOf` toText (b ^. bucket_name)++spec :: Spec+spec = do+  describe "MockT" $ do+    it "can mock send" $ do+      now <- getCurrentTime++      let+        bucketA = newBucket now "a-bucket"+        bucketB = newBucket now "b-bucket"+        bucketC = newBucket now "c-bucket"+        buckets = [bucketA, bucketB, bucketC]+        matcher =+          SendMatcher (== newListBuckets) $+            Right $+              newListBucketsResponse 200 & listBucketsResponse_buckets ?~ buckets++      result <-+        runMockT $ withMatcher matcher $ listBucketsMatching "b-"++      result `shouldBe` [bucketB]++    it "reports useful failures on un-matched requests" $ do+      result <- try @UnmatchedRequestError $ runMockT (listBucketsMatching "b-")++      case result of+        Left ex ->+          displayException ex+            `shouldBe` mconcat+              [ "Unexpected AWS request made within MockT: ListBuckets\n"+              , "Use withMatcher to add a Matcher for this request"+              ]+        Right resp ->+          expectationFailure $+            "UnmatchedRequestError expected, but got response: "+              <> show resp

+ tests/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -Wno-missing-export-lists #-}