freckle-http 0.1.0.0 → 0.2.0.0

raw patch · 7 files changed

+55/−22 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +8/−1
• freckle-http.cabal +1/−1
• library/Freckle/App/Http.hs +7/−3
• library/Freckle/App/Test/Http.hs +36/−13
• library/Freckle/App/Test/Http/MatchRequest.hs +1/−2
• package.yaml +1/−1
• tests/Freckle/App/Http/CacheSpec.hs +1/−1

@@ -1,4 +1,11 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-http-v0.1.0.0...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/freckle-http-v0.2.0.0...main)++## [v0.2.0.0](https://github.com/freckle/freckle-app/compare/freckle-http-v0.1.0.0...freckle-http-v0.2.0.0)++`MonadHttp.httpLbs` has a `HasCallStack` constraint, and instances throw `AnnotatedException`++Breaking change: `httpStubbed` is now monadic rather than pure. Its errors are thrown into `IO` as+`AnnotatedException`-wrapped `NoStubsMatched`.  ## [v0.1.0.0](https://github.com/freckle/freckle-app/compare/freckle-http-v0.0.0.0...freckle-http-v0.1.0.0) 

@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               freckle-http-version:            0.1.0.0+version:            0.2.0.0 license:            MIT license-file:       LICENSE maintainer:         Freckle Education

@@ -78,7 +78,11 @@ import Prelude  import Conduit (foldC, mapMC, runConduit, (.|))-import Control.Exception.Annotated.UnliftIO (Exception (..), throwWithCallStack)+import Control.Exception.Annotated.UnliftIO+  ( Exception (..)+  , checkpointCallStack+  , throwWithCallStack+  ) import Control.Monad.Except (ExceptT) import Control.Monad.IO.Class (MonadIO) import Control.Monad.Reader (ReaderT)@@ -138,10 +142,10 @@ -- resp <- liftIO $ httpLbs ... -- @ class Monad m => MonadHttp m where-  httpLbs :: Request -> m (Response BSL.ByteString)+  httpLbs :: HasCallStack => Request -> m (Response BSL.ByteString)  instance MonadHttp IO where-  httpLbs = rateLimited HTTP.httpLbs+  httpLbs x = checkpointCallStack $ rateLimited HTTP.httpLbs x  instance MonadHttp m => MonadHttp (MaybeT m) where   httpLbs = lift . httpLbs

@@ -28,6 +28,9 @@     -- * FileSystem stubs   , loadHttpStubsDirectory +    -- * Exception+  , NoStubsMatched(..)+     -- * 'MonadHttp' instances      -- ** For use with @DerivingVia@@@ -42,11 +45,13 @@ import Prelude  import Control.Applicative (asum)+import Control.Exception (Exception (..)) import Control.Lens (Lens', lens, view,  (.~), (<>~)) import Control.Monad.Reader (MonadReader, ReaderT, runReaderT) import Data.Aeson (ToJSON, encode) import Data.Bifunctor (bimap) import Control.Monad(filterM)+import Control.Monad.IO.Class (MonadIO) import Data.ByteString.Lazy qualified as BSL import Data.Either (partitionEithers) import Data.Function ((&))@@ -55,6 +60,7 @@ import Data.String (IsString) import Data.String qualified import Data.Traversable (for)+import Control.Exception.Annotated.UnliftIO (throwWithCallStack) import Freckle.App.Http (MonadHttp (..)) import Freckle.App.Test.Http.MatchRequest import GHC.Stack (HasCallStack)@@ -69,8 +75,8 @@  -- | Respond to a 'Request' with the first 'HttpStub' to match ----- If no stubs match, 'error' is used. If you'd rather experience a 404, add--- a final stub for any request that does that:+-- If no stubs match, 'throwWithCallStack' is used. If you'd rather experience+--  a 404, add a final stub for any request that does that: -- -- @ -- stubs :: ['HttpStub']@@ -83,12 +89,15 @@ --   ] -- @ httpStubbed-  :: HasCallStack+  :: (MonadIO m, HasCallStack)   => [HttpStub]   -> Request-  -> Response BSL.ByteString+  -> m (Response BSL.ByteString) httpStubbed stubs req =-  maybe (error errorMessage) (toResponse req) $ headMay matched+  maybe+    (throwWithCallStack NoStubsMatched{req, unmatched})+    (pure . toResponse req)+    $ headMay matched  where   (unmatched, matched) =     partitionEithers@@ -99,13 +108,27 @@         )         stubs -  errorMessage =+data NoStubsMatched = NoStubsMatched+  { req :: Request+  , unmatched :: [(HttpStub, String)]+  }++instance Show NoStubsMatched where+  show = displayException+++instance Exception NoStubsMatched where+  displayException NoStubsMatched {req, unmatched} =     "No stubs were found that matched:\n"     <> show req     <> "\n"-    <> concatMap (uncurry unmatchedMessage) unmatched--  unmatchedMessage stub err = "\n== " <> stub.label <> " ==\n" <> err+    <> (+      if length unmatched < 4+        then concatMap (uncurry unmatchedMessage) unmatched+        else "\nNumber of stubs: " <> show (length unmatched)+    )+   where+    unmatchedMessage stub err = "\n== " <> stub.label <> " ==\n" <> err  -- | Fields that can be defined for a response data HttpStubResponse = HttpStubResponse@@ -241,16 +264,16 @@   httpStubsL = id  newtype ReaderHttpStubs m a = ReaderHttpStubs {unwrap :: m a}-  deriving newtype (Functor, Applicative, Monad, MonadReader env)+  deriving newtype (Functor, Applicative, Monad, MonadIO, MonadReader env) -instance (MonadReader env m, HasHttpStubs env) => MonadHttp (ReaderHttpStubs m) where+instance (MonadReader env m, HasHttpStubs env, MonadIO m) => MonadHttp (ReaderHttpStubs m) where   httpLbs req = do     stubs <- view httpStubsL-    pure $ httpStubbed stubs req+    httpStubbed stubs req  newtype HttpStubsT m a = HttpStubsT {unwrap :: ReaderT [HttpStub] m a}   deriving newtype (Functor, Applicative, Monad, MonadReader [HttpStub])-  deriving (MonadHttp) via ReaderHttpStubs (HttpStubsT m)+  deriving (MonadIO, MonadHttp) via ReaderHttpStubs (HttpStubsT m)  runHttpStubsT :: HttpStubsT m a -> [HttpStub] -> m a runHttpStubsT f = runReaderT f.unwrap

@@ -28,7 +28,6 @@ import Data.ByteString (ByteString) import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Lazy qualified as BSL-import Data.Foldable (toList) import Data.List (isPrefixOf) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.List.NonEmpty qualified as NE@@ -121,7 +120,7 @@ showMatchRequestWithMismatches mr mismatches =   showMatchRequest mr     <> "\nMismatches {"-    <> concatMap ("\n  " <>) (toList mismatches)+    <> concatMap ("\n  " <>) mismatches     <> "\n}"     <> "\n" 

@@ -1,5 +1,5 @@ name: freckle-http-version: 0.1.0.0+version: 0.2.0.0 maintainer: Freckle Education category: HTTP github: freckle/freckle-app

@@ -362,7 +362,7 @@   -> Request   -> StateT Cache IO BSL.ByteString requestBodyCached ss stubs req =-  getResponseBody <$> httpCached ss (pure . httpStubbed stubs) req+  getResponseBody <$> httpCached ss (httpStubbed stubs) req  settings :: CacheSettings settings = stateHttpCacheSettings