add Freckle.Test.Yesod and related modules

Extracted from megarepo, organized and documented a bit better,
and added the MonadYesodExample class.

CHANGELOG.md

@@ -1,4 +1,8 @@
-## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.9.1.1...main)
+## [_Unreleased_](https://github.com/freckle/freckle-app/compare/v1.9.2.0...main)
+
+## [v1.9.2.0](https://github.com/freckle/freckle-app/compare/v1.9.1.1...v1.9.2.0)
+
+- Add `Freckle.Test.Yesod{.*}`
 
 ## [v1.9.1.1](https://github.com/freckle/freckle-app/compare/v1.9.1.0...v1.9.1.1)
 

freckle-app.cabal

@@ -1,11 +1,11 @@
 cabal-version: 1.18
 
--- This file has been generated from package.yaml by hpack version 0.35.1.
+-- This file has been generated from package.yaml by hpack version 0.35.2.
 --
 -- see: https://github.com/sol/hpack
 
 name:           freckle-app
-version:        1.9.1.1
+version:        1.9.2.0
 synopsis:       Haskell application toolkit used at Freckle
 description:    Please see README.md
 category:       Utils
@@ -61,6 +61,19 @@ library
       Freckle.App.Wai
       Freckle.App.Yesod
       Freckle.App.Yesod.Routes
+      Freckle.Test.Yesod
+      Freckle.Test.Yesod.BodyAssertions
+      Freckle.Test.Yesod.Cookies
+      Freckle.Test.Yesod.Foundation
+      Freckle.Test.Yesod.GeneralAssertions
+      Freckle.Test.Yesod.GetBody
+      Freckle.Test.Yesod.HeaderAssertions
+      Freckle.Test.Yesod.JsonAssertions
+      Freckle.Test.Yesod.MakingRequests
+      Freckle.Test.Yesod.MonadYesodExample
+      Freckle.Test.Yesod.RequestBuilder
+      Freckle.Test.Yesod.SResponse
+      Freckle.Test.Yesod.StatusAssertions
       Network.HTTP.Link.Compat
       Network.Wai.Middleware.Cors
       Network.Wai.Middleware.Stats
@@ -98,18 +111,21 @@ library
   build-depends:
       Blammo
     , Glob
+    , HUnit
     , MonadRandom
     , aeson
     , aws-xray-client-persistent
     , aws-xray-client-wai
-    , base <5
+    , base
+    , bcp47
     , bugsnag
     , bytestring
     , case-insensitive
     , cassava
     , conduit
     , conduit-extra
     , containers
+    , cookie
     , datadog
     , doctest
     , dotenv
@@ -122,6 +138,7 @@ library
     , hashable
     , hspec >=2.8.1
     , hspec-core >=2.8.1
+    , hspec-expectations-json
     , hspec-expectations-lifted
     , hspec-junit-formatter >=1.1.0.1
     , http-client
@@ -131,6 +148,7 @@ library
     , hw-kafka-client
     , immortal
     , lens
+    , lens-aeson
     , memcache
     , monad-control
     , monad-validate
@@ -162,6 +180,7 @@ library
     , wai-extra
     , yaml
     , yesod-core
+    , yesod-test
   default-language: Haskell2010
   if impl(ghc >= 9.2)
     ghc-options: -Wno-missing-kind-signatures

library/Freckle/Test/Yesod.hs

@@ -0,0 +1,23 @@
+-- | Similar to "Yesod.Test" from the yesod-test package.
+--
+-- Differences:
+--
+-- * Contains a few additional conveniences, notably
+--   "Freckle.Test.Yesod.JsonAssertions"
+-- * Actions in the 'YesodExample' monad are generalized to a
+--   'MonadYesodExample' constraint, allowing tests to be written
+--   in custom monads more easily.
+module Freckle.Test.Yesod (module X) where
+
+import Freckle.Test.Yesod.BodyAssertions as X
+import Freckle.Test.Yesod.Cookies as X
+import Freckle.Test.Yesod.Foundation as X
+import Freckle.Test.Yesod.GeneralAssertions as X
+import Freckle.Test.Yesod.GetBody as X
+import Freckle.Test.Yesod.HeaderAssertions as X
+import Freckle.Test.Yesod.JsonAssertions as X
+import Freckle.Test.Yesod.MakingRequests as X
+import Freckle.Test.Yesod.MonadYesodExample as X
+import Freckle.Test.Yesod.RequestBuilder as X
+import Freckle.Test.Yesod.SResponse as X
+import Freckle.Test.Yesod.StatusAssertions as X

library/Freckle/Test/Yesod/BodyAssertions.hs

@@ -0,0 +1,29 @@
+module Freckle.Test.Yesod.BodyAssertions
+  ( bodyContains
+  , bodyEquals
+  , bodyNotContains
+  )
+where
+
+import Freckle.App.Prelude
+import Freckle.Test.Yesod.MonadYesodExample
+
+import qualified Yesod.Test
+
+-- | 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
+
+-- | Assert the last response is exactly equal to the given text
+--
+-- This is useful for testing API responses.
+bodyEquals :: forall m site. MonadYesodExample site m => String -> m ()
+bodyEquals = liftYesodExample . Yesod.Test.bodyEquals
+
+-- | Assert the last response doesn't have the given text
+--
+-- The check is performed using the response body in full text form.
+bodyNotContains :: forall m site. MonadYesodExample site m => String -> m ()
+bodyNotContains = liftYesodExample . Yesod.Test.bodyNotContains

library/Freckle/Test/Yesod/Cookies.hs

@@ -0,0 +1,28 @@
+module Freckle.Test.Yesod.Cookies
+  ( getRequestCookies
+  , testSetCookie
+  , testDeleteCookie
+  , testClearCookies
+  )
+where
+
+import Freckle.App.Prelude
+import Freckle.Test.Yesod.MonadYesodExample
+
+import Data.ByteString (ByteString)
+import Web.Cookie (SetCookie)
+import Yesod.Test (getRequestCookies)
+import qualified Yesod.Test
+
+-- | 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

library/Freckle/Test/Yesod/Foundation.hs

@@ -0,0 +1,24 @@
+module Freckle.Test.Yesod.Foundation
+  ( TestApp
+  , YesodExample
+  , YesodExampleData (..)
+  , SIO
+  , testApp
+  , getTestYesod
+  )
+where
+
+import Freckle.Test.Yesod.MonadYesodExample
+
+import Yesod.Test
+  ( SIO
+  , TestApp
+  , YesodExample
+  , YesodExampleData (..)
+  , testApp
+  )
+import qualified Yesod.Test
+
+-- | Get the foundation value used for the current test
+getTestYesod :: forall m site. MonadYesodExample site m => m site
+getTestYesod = liftYesodExample Yesod.Test.getTestYesod

library/Freckle/Test/Yesod/GeneralAssertions.hs

@@ -0,0 +1,40 @@
+module Freckle.Test.Yesod.GeneralAssertions
+  ( assertEq
+  , assertEqualNoShow
+  , assertNotEq
+  )
+where
+
+import Freckle.App.Prelude
+import Freckle.Test.Yesod.MonadYesodExample
+
+import qualified Yesod.Test
+
+-- | Asserts that the two given values are equal
+--
+-- The error message includes the values.
+assertEq
+  :: forall a m site
+   . (MonadYesodExample site m, Eq a, Show a)
+  => String
+  -> a
+  -> a
+  -> m ()
+assertEq s a b = liftYesodExample $ Yesod.Test.assertEq s a b
+
+-- | Like 'assertEq' but the error message does not include the values
+assertEqualNoShow
+  :: forall a m site. (MonadYesodExample site m, Eq a) => String -> a -> a -> m ()
+assertEqualNoShow s a b = liftYesodExample $ Yesod.Test.assertEqualNoShow s a b
+
+-- | Asserts that the two given values are not equal
+--
+-- In case they are equal, the error message includes the values.
+assertNotEq
+  :: forall a m site
+   . (Eq a, Show a, MonadYesodExample site m)
+  => String
+  -> a
+  -> a
+  -> m ()
+assertNotEq s a b = liftYesodExample $ Yesod.Test.assertNotEq s a b

library/Freckle/Test/Yesod/GetBody.hs

@@ -0,0 +1,35 @@
+module Freckle.Test.Yesod.GetBody
+  ( getRawBody
+  , getCsvBody
+  , getJsonBody
+  )
+where
+
+import Freckle.App.Prelude
+import Freckle.Test.Yesod.MonadYesodExample
+import Freckle.Test.Yesod.SResponse
+
+import Data.Aeson (FromJSON, eitherDecode)
+import qualified Data.ByteString.Lazy as BSL
+import Data.Csv (FromNamedRecord, decodeByName)
+import qualified Data.Vector as V
+import UnliftIO.Exception (throwString)
+
+-- | 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

library/Freckle/Test/Yesod/HeaderAssertions.hs

@@ -0,0 +1,87 @@
+module Freckle.Test.Yesod.HeaderAssertions
+  ( assertHeader
+  , assertHeaderContains
+  , assertHeaderSatisfies
+  , assertNoHeader
+  )
+where
+
+import Freckle.App.Prelude
+import Freckle.Test.Yesod.MonadYesodExample
+import Freckle.Test.Yesod.SResponse
+
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as BS
+import Data.CaseInsensitive (CI)
+import Test.Hspec.Expectations.Lifted (expectationFailure)
+import qualified Yesod.Test
+
+-- | 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
+
+-- | Assert the given header was __not__ included in the response
+assertNoHeader
+  :: forall m site
+   . MonadYesodExample site m
+  => CI ByteString
+  -- ^ Field name
+  -> m ()
+assertNoHeader = liftYesodExample . Yesod.Test.assertNoHeader