packages feed

freckle-app 1.9.4.0 → 1.9.5.0

raw patch · 4 files changed

+328/−5 lines, 4 filesdep +bcp47dep +cookiedep +yesod-testdep ~base

Dependencies added: bcp47, cookie, yesod-test

Dependency ranges changed: base

Files

CHANGELOG.md view
@@ -1,4 +1,8 @@-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.9.4.0...main)+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.9.5.0...main)++## [v1.9.5.0](https://github.com/freckle/freckle-app/compare/v1.9.4.0...v1.9.5.0)++- Add module `Freckle.App.Test.Yesod`  ## [v1.9.4.0](https://github.com/freckle/freckle-app/compare/v1.9.3.0...v1.9.4.0)
freckle-app.cabal view
@@ -1,6 +1,6 @@ cabal-version:      1.18 name:               freckle-app-version:            1.9.4.0+version:            1.9.5.0 license:            MIT license-file:       LICENSE maintainer:         Freckle Education@@ -55,6 +55,7 @@         Freckle.App.Test.Hspec.Runner         Freckle.App.Test.Properties.JSON         Freckle.App.Test.Properties.PathPiece+        Freckle.App.Test.Yesod         Freckle.App.Wai         Freckle.App.Yesod         Freckle.App.Yesod.Routes@@ -88,7 +89,8 @@         aeson,         aws-xray-client-persistent,         aws-xray-client-wai,-        base >=4.14.3.0 && <5,+        base,+        bcp47,         bugsnag,         bytestring,         case-insensitive,@@ -96,6 +98,7 @@         conduit,         conduit-extra,         containers,+        cookie,         datadog,         doctest,         dotenv,@@ -147,7 +150,8 @@         wai,         wai-extra,         yaml,-        yesod-core+        yesod-core,+        yesod-test      if impl(ghc >=9.2)         ghc-options: -Wno-missing-kind-signatures
+ library/Freckle/App/Test/Yesod.hs view
@@ -0,0 +1,311 @@+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE UndecidableInstances #-}++-- | Similar to "Yesod.Test" from the yesod-test package+--+-- Actions in the 'YesodExample' monad are generalized to a+-- 'MonadYesodExample' constraint, allowing tests to be written+-- in custom monads more easily.+module Freckle.App.Test.Yesod+  ( -- * Monad class+    MonadYesodExample (..)++    -- * Making requests++    -- ** Via RequestBuilder+  , request+  , RequestBuilder+  , setMethod+  , setUrl+  , setRequestBody+  , addGetParam+  , addPostParam+  , addRequestHeader+  , addJsonHeaders+  , setLanguage+  , addAcceptLanguage+  , addFile++    -- ** Other ways+  , get+  , post+  , followRedirect++    -- * Inspecting the response++    -- ** Getting the body+  , getRawBody+  , getCsvBody+  , getJsonBody++    -- ** Dealing with the response+  , getResponse+  , withResponse+  , SResponse (..)++    -- * Assertions++    -- ** Status+  , statusIs++    -- ** Header fields+  , assertHeader+  , assertHeaderContains+  , assertHeaderSatisfies++    -- ** Body+  , bodyContains++    -- * Cookies+  , getRequestCookies+  , testSetCookie+  , testDeleteCookie+  , testClearCookies++    -- * Foundational details+  , SIO+  , TestApp+  , YesodExample+  , YesodExampleData (..)+  , getTestYesod+  )+where++import Freckle.App.Prelude++import Blammo.Logging (LoggingT)+import Control.Monad.Except (ExceptT)+import Control.Monad.State (StateT)+import Control.Monad.Trans.Maybe (MaybeT)+import Control.Monad.Trans.Resource (ResourceT)+import Control.Monad.Validate (ValidateT)+import Data.Aeson (FromJSON, eitherDecode)+import Data.BCP47 (BCP47)+import qualified Data.BCP47 as BCP47+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BSL+import Data.CaseInsensitive (CI)+import Data.Csv (FromNamedRecord, decodeByName)+import qualified Data.Text as T+import qualified Data.Vector as V+import Network.HTTP.Types.Header (hAccept, hAcceptLanguage, hContentType)+import Network.Wai.Test (SResponse (..))+import Test.Hspec.Expectations.Lifted (expectationFailure)+import UnliftIO.Exception (throwString)+import Web.Cookie (SetCookie)+import Yesod.Core (RedirectUrl, Yesod)+import Yesod.Test+  ( RequestBuilder+  , SIO+  , TestApp+  , YesodExample+  , YesodExampleData (..)+  , addFile+  , addGetParam+  , addPostParam+  , addRequestHeader+  , getRequestCookies+  , setMethod+  , setRequestBody+  , setUrl+  , withResponse+  )+import qualified Yesod.Test++class (MonadIO m, Yesod site) => MonadYesodExample site m | m -> site where+  liftYesodExample :: YesodExample site a -> m a++instance Yesod site => MonadYesodExample site (YesodExample site) where+  liftYesodExample = id++instance MonadYesodExample site m => MonadYesodExample site (StateT s m) where+  liftYesodExample = lift . liftYesodExample++instance MonadYesodExample site m => MonadYesodExample site (ReaderT r m) where+  liftYesodExample = lift . liftYesodExample++instance MonadYesodExample site m => MonadYesodExample site (ValidateT e m) where+  liftYesodExample = lift . liftYesodExample++instance MonadYesodExample site m => MonadYesodExample site (MaybeT m) where+  liftYesodExample = lift . liftYesodExample++instance MonadYesodExample site m => MonadYesodExample site (ExceptT e m) where+  liftYesodExample = lift . liftYesodExample++instance MonadYesodExample site m => MonadYesodExample site (ResourceT m) where+  liftYesodExample = lift . liftYesodExample++instance MonadYesodExample site m => MonadYesodExample site (LoggingT m) where+  liftYesodExample = lift . liftYesodExample++-- | Assert the last response has the given text+--+-- The check is performed using the response body in full text form.+bodyContains :: forall m site. MonadYesodExample site m => String -> m ()+bodyContains = liftYesodExample . Yesod.Test.bodyContains++-- | Clears the current cookies+testClearCookies :: forall m site. MonadYesodExample site m => m ()+testClearCookies = liftYesodExample $ Yesod.Test.testClearCookies++-- | Deletes the cookie of the given name+testDeleteCookie+  :: forall m site. MonadYesodExample site m => ByteString -> m ()+testDeleteCookie = liftYesodExample . Yesod.Test.testDeleteCookie++-- | Sets a cookie+testSetCookie :: forall m site. MonadYesodExample site m => SetCookie -> m ()+testSetCookie = liftYesodExample . Yesod.Test.testSetCookie++-- | Get the body of the most recent response and decode it as JSON+getJsonBody :: forall a m site. (MonadYesodExample site m, FromJSON a) => m a+getJsonBody = either err pure . eitherDecode =<< getRawBody+ where+  err e = throwString $ "Error decoding JSON response body: " <> e++-- | Get the body of the most recent response and decode it as CSV+getCsvBody+  :: forall a m site. (MonadYesodExample site m, FromNamedRecord a) => m [a]+getCsvBody = either err (pure . V.toList . snd) . decodeByName =<< getRawBody+ where+  err e = throwString $ "Error decoding CSV response body: " <> e++-- | Get the body of the most recent response as a byte string+getRawBody :: forall m site. MonadYesodExample site m => m BSL.ByteString+getRawBody =+  fmap simpleBody . maybe (throwString "Test response had no body") pure+    =<< getResponse++-- | Get the most recently provided response value, if available+getResponse :: forall m site. MonadYesodExample site m => m (Maybe SResponse)+getResponse = liftYesodExample getResponse++-- | The general interface for performing requests+--+-- 'request' takes a 'RequestBuilder', constructs a request, and executes it.+--+-- The 'RequestBuilder' allows you to build up attributes of the request,+-- like the headers, parameters, and URL of the request.+request+  :: forall m site. MonadYesodExample site m => RequestBuilder site () -> m ()+request = liftYesodExample . Yesod.Test.request++-- | Set a language for the test Request+--+-- This uses a @_LANG@ query parameter since it's a singleton case, just to+-- exercise that machinery.+setLanguage :: BCP47 -> RequestBuilder site ()+setLanguage = addGetParam "_LANG" . BCP47.toText++-- | Set the @Accept-Language@ header to a list of raw values+--+-- This allows testing with actual quality-factors, etc.+addAcceptLanguage :: [Text] -> RequestBuilder site ()+addAcceptLanguage values =+  addRequestHeader (hAcceptLanguage, encodeUtf8 $ T.intercalate "," values)++-- | Sets both @Content-Type@ and @Accept@ fields to @application/json@+addJsonHeaders :: RequestBuilder site ()+addJsonHeaders = do+  addRequestHeader (hContentType, "application/json")+  addRequestHeader (hAccept, "application/json")++-- | Assert the last response status is as expected+--+-- If the status code doesn't match, a portion of the body is also+-- printed to aid in debugging.+statusIs+  :: forall m site. (HasCallStack, MonadYesodExample site m) => Int -> m ()+statusIs = liftYesodExample . Yesod.Test.statusIs++-- | Assert that the given header field's value satisfied some predicate+assertHeaderSatisfies+  :: forall m site+   . MonadYesodExample site m+  => CI ByteString+  -- ^ Field name+  -> String+  -- ^ Some description of the predicate; this is included+  --   in the error message if the assertion fails+  -> (ByteString -> Bool)+  -- ^ Predicate applied to the field value which is expected+  --   to return 'True'+  -> m ()+assertHeaderSatisfies header predicateDesc predicate = liftYesodExample $ withResponse $ \res ->+  case lookup header $ simpleHeaders res of+    Just value | predicate value -> pure ()+    Just value ->+      expectationFailure $+        concat+          [ "Expected header "+          , show header+          , " "+          , predicateDesc+          , ", but received "+          , show value+          ]+    Nothing ->+      expectationFailure $+        concat+          [ "Expected header "+          , show header+          , predicateDesc+          , ", but it was not present"+          ]++-- | Assert that the given header field's value contains+--   some particular byte string within it+assertHeaderContains+  :: MonadYesodExample site m+  => CI ByteString+  -- ^ Field name+  -> ByteString+  -- ^ Substring that we expect to find anywhere within the field value+  -> m ()+assertHeaderContains header substring =+  assertHeaderSatisfies+    header+    ("to contain " <> show substring)+    (substring `BS.isInfixOf`)++-- | Assert the given header key/value pair was returned+assertHeader+  :: forall m site+   . MonadYesodExample site m+  => CI ByteString+  -- ^ Field name+  -> ByteString+  -- ^ Expected field value+  -> m ()+assertHeader k v = liftYesodExample $ Yesod.Test.assertHeader k v++-- | Follow a redirect, if the last response was a redirect+followRedirect+  :: forall m site+   . MonadYesodExample site m+  => m (Either Text Text)+  -- ^ Left with an error message if not a redirect,+  --   Right with the redirected URL if it was+followRedirect = liftYesodExample Yesod.Test.followRedirect++-- | Perform a GET request to url+get+  :: forall url m site+   . (MonadYesodExample site m, RedirectUrl site url)+  => url+  -> m ()+get = liftYesodExample . Yesod.Test.get++-- | Perform a POST request to url+post+  :: forall url m site+   . (MonadYesodExample site m, RedirectUrl site url)+  => url+  -> m ()+post = liftYesodExample . Yesod.Test.post++-- | Get the foundation value used for the current test+getTestYesod :: forall m site. MonadYesodExample site m => m site+getTestYesod = liftYesodExample Yesod.Test.getTestYesod
package.yaml view
@@ -1,5 +1,5 @@ name: freckle-app-version: 1.9.4.0+version: 1.9.5.0 maintainer: Freckle Education category: Utils github: freckle/freckle-app@@ -74,6 +74,8 @@     - aeson     - aws-xray-client-persistent     - aws-xray-client-wai+    - base+    - bcp47     - bugsnag     - bytestring     - case-insensitive@@ -81,6 +83,7 @@     - conduit     - conduit-extra     - containers+    - cookie     - datadog     - doctest     - dotenv@@ -133,6 +136,7 @@     - wai-extra     - yaml     - yesod-core+    - yesod-test  tests:   spec: