sydtest-yesod 0.3.0.0 → 0.3.0.1

raw patch · 9 files changed

+203/−70 lines, 9 filesdep +pathdep +path-iodep −blaze-builderdep −persistent-templatedep −pretty-showPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: path, path-io

Dependencies removed: blaze-builder, persistent-template, pretty-show, resourcet, wai, yesod-form

API changes (from Hackage documentation)

Files

• CHANGELOG.md +49/−0
• blog-example/Example/Blog.hs +11/−3
• blog-example/Example/BlogSpec.hs +16/−3
• src/Test/Syd/Yesod.hs +9/−1
• src/Test/Syd/Yesod/Client.hs +36/−2
• src/Test/Syd/Yesod/Request.hs +38/−33
• sydtest-yesod.cabal +12/−9
• test/Test/Syd/Yesod/App.hs +4/−2
• test/Test/Syd/YesodSpec.hs +28/−17

@@ -0,0 +1,49 @@+# Changelog++## [0.3.0.1] - 2022-08-21++### Added++* `followRedirect_`+* `getStatus`+* `requireLast`+* `requireLocation`+* `requireRequest`+* `requireResponse`+* `requireStatus`+* `statusShouldBe`++## [0.3.0.0] - 2021-06-29++### Added++* End-to-end testing support:++  * `yesodE2ESpec`+  * `yesodE2ESpec'`+  * `E2E (..)`+  * `localToE2ESpec`+  * `localToE2EClient`++### Changed++* A `YesodClient site` now contains a base `URI` instead of a `PortNumber`.+* The types of `getLocation` and `locationShouldBe` are now more general, to support end-to-end testing.+++## [0.2.0.1] - 2021-06-17++### Changed++* Fixed that the error message for `locationShouldBe` was backwards.++## [0.2.0.0] - 2021-06-17++### Added++* Added `IsTest` instances for `YesodClientM site`++### Changed++* Simplified `yit` using the new `ReaderT` instance in sydtest.+  It now requires the test to return `()`.

@@ -8,6 +8,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-}@@ -36,7 +37,8 @@ |]  data App = App-  { appConnectionPool :: ConnectionPool+  { appConnectionPool :: !ConnectionPool,+    appSessionKeyFile :: !FilePath   }  mkYesod@@ -49,7 +51,8 @@  type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget) -instance Yesod App+instance Yesod App where+  makeSessionBackend App {..} = Just <$> defaultClientSessionBackend 30 appSessionKeyFile  instance YesodPersist App where   type YesodPersistBackend App = SqlBackend@@ -123,4 +126,9 @@ main = runStderrLoggingT $   withSqlitePool "example.sqlite3" 1 $ \pool -> do     runSqlPool (runMigration migrateThoughts) pool-    liftIO $ Yesod.warp 3000 $ App {appConnectionPool = pool}+    liftIO $+      Yesod.warp 3000 $+        App+          { appConnectionPool = pool,+            appSessionKeyFile = "client_session_key.aes"+          }

@@ -7,13 +7,26 @@ import Database.Persist (selectList) import Database.Persist.Sql (Entity (..), SqlPersistT) import Example.Blog+import Network.HTTP.Client as HTTP+import Path+import Path.IO import Test.QuickCheck import Test.Syd+import Test.Syd.Path import Test.Syd.Persistent.Sqlite+import Test.Syd.Wai (managerSpec) import Test.Syd.Yesod -appSupplier :: (App -> IO r) -> IO r-appSupplier func = withConnectionPool migrateThoughts $ \pool -> func App {appConnectionPool = pool}+appSetupFunc :: HTTP.Manager -> SetupFunc App+appSetupFunc _ = do+  tdir <- tempDirSetupFunc "sydtest-yesod"+  sessionKeyFile <- resolveFile tdir "client_session_key.aes"+  pool <- connectionPoolSetupFunc migrateThoughts+  pure $+    App+      { appSessionKeyFile = fromAbsFile sessionKeyFile,+        appConnectionPool = pool+      }  testDB :: SqlPersistT IO a -> YesodClientM App a testDB func = do@@ -21,7 +34,7 @@   liftIO $ runSqlPool func pool  spec :: Spec-spec = yesodSpecWithSiteSupplier appSupplier $ do+spec = managerSpec . modifyMaxSuccess (`div` 20) . yesodSpecWithSiteSetupFunc appSetupFunc $ do   -- A simple read-only test: We can request the home page succesfully.   it "can GET the home page" $ do     get HomeR

@@ -45,6 +45,7 @@     get,     post,     followRedirect,+    followRedirect_,      -- ** Using the request builder     request,@@ -72,15 +73,22 @@     addTokenFromCookieNamedToHeaderNamed,      -- *** Queries+    getStatus,+    requireStatus,     getRequest,+    requireRequest,     getResponse,+    requireResponse,     getLocation,+    requireLocation,     getLast,+    requireLast,      -- * Declaring assertions-    statusIs,+    statusShouldBe,     locationShouldBe,     bodyContains,+    statusIs,      -- * Just to be sure we didn't forget any exports     module Test.Syd.Yesod.Client,

@@ -93,16 +93,42 @@  -- | Get the most recently sent request. getRequest :: YesodClientM site (Maybe Request)-getRequest = State.gets (fmap fst . yesodClientStateLast)+getRequest = fmap fst <$> getLast +-- | Get the most recently sent request.+requireRequest :: YesodClientM site Request+requireRequest = fst <$> requireLast+ -- | Get the most recently received response. getResponse :: YesodClientM site (Maybe (Response LB.ByteString))-getResponse = State.gets (fmap snd . yesodClientStateLast)+getResponse = fmap snd <$> getLast +-- | Get the most recently received response, and assert that it already exists.+requireResponse :: YesodClientM site (Response LB.ByteString)+requireResponse = snd <$> requireLast+ -- | Get the most recently sent request and the response to it. getLast :: YesodClientM site (Maybe (Request, Response LB.ByteString)) getLast = State.gets yesodClientStateLast +-- | Get the most recently sent request and the response to it, and assert that they already exist.+requireLast :: YesodClientM site (Request, Response LB.ByteString)+requireLast = do+  mTup <- getLast+  case mTup of+    Nothing -> liftIO $ expectationFailure "Should have had a latest request/response pair by now."+    Just tup -> pure tup++-- | Get the status of the most recently received response.+getStatus :: YesodClientM site (Maybe Int)+getStatus = do+  mResponse <- getResponse+  pure $ statusCode . responseStatus <$> mResponse++-- | Get the status of the most recently received response, and assert that it already exists.+requireStatus :: YesodClientM site Int+requireStatus = statusCode . responseStatus <$> requireResponse+ -- | Get the 'Location' header of most recently received response. getLocation :: ParseRoute site => YesodClientM localSite (Either Text (Route site)) getLocation = do@@ -121,6 +147,14 @@        in (ss, map unJust $ queryToQueryText q)     unJust (a, Just b) = (a, b)     unJust (a, Nothing) = (a, mempty)++-- | Get the 'Location' header of most recently received response, and assert that it is a valid Route.+requireLocation :: ParseRoute site => YesodClientM localSite (Route site)+requireLocation = do+  errOrLocation <- getLocation+  case errOrLocation of+    Left err -> liftIO $ expectationFailure $ T.unpack err+    Right location -> pure location  -- | Annotate the given test code with the last request and its response, if one has been made already. withLastRequestContext :: YesodClientM site a -> YesodClientM site a

@@ -64,19 +64,20 @@   setUrl route   setMethod method +-- | Synonym of 'statusShouldBe' for compatibility with yesod-test+statusIs :: HasCallStack => Int -> YesodClientM site ()+statusIs = statusShouldBe+ -- | Assert the status of the most recently received response. -- -- > it "returns 200 on the home route" $ do -- >   get HomeR--- >   statusIs 200-statusIs :: HasCallStack => Int -> YesodClientM site ()-statusIs i = do-  mLast <- getLast-  case mLast of-    Nothing -> liftIO $ expectationFailure "statusIs: No request made yet."-    Just (_, resp) ->-      let c = statusCode (responseStatus resp)-       in withLastRequestContext $ liftIO $ c `shouldBe` i+-- >   statusShouldBe 200+statusShouldBe :: HasCallStack => Int -> YesodClientM site ()+statusShouldBe expected =+  withLastRequestContext $ do+    actual <- requireStatus+    liftIO $ actual `shouldBe` expected  -- | Assert the redirect location of the most recently received response. --@@ -87,23 +88,21 @@ locationShouldBe :: (ParseRoute site, Show (Route site)) => Route site -> YesodClientM localSite () locationShouldBe expected =   withLastRequestContext $ do-    errOrLoc <- getLocation-    liftIO $ case errOrLoc of-      Left err -> expectationFailure (T.unpack err)-      Right actual -> actual `shouldBe` expected+    actual <- requireLocation+    liftIO $ actual `shouldBe` expected  -- | Assert the last response has the given text. -- -- The check is performed using the response body in full text form without any html parsing. bodyContains :: HasCallStack => String -> YesodExample site ()-bodyContains text = do-  mResp <- getLast-  case mResp of-    Nothing -> liftIO $ expectationFailure "bodyContains: No request made yet."-    Just (_, resp) ->-      withLastRequestContext $-        liftIO $-          shouldSatisfyNamed (responseBody resp) (unwords ["bodyContains", show text]) (\body -> TE.encodeUtf8 (T.pack text) `SB.isInfixOf` LB.toStrict body)+bodyContains text =+  withLastRequestContext $ do+    resp <- requireResponse+    liftIO $+      shouldSatisfyNamed+        (responseBody resp)+        (unwords ["bodyContains", show text])+        (\body -> TE.encodeUtf8 (T.pack text) `SB.isInfixOf` LB.toStrict body)  -- | A request builder monad that allows you to monadically build a request using `runRequestBuilder`. --@@ -424,15 +423,21 @@   -- | 'Left' with an error message if not a redirect, 'Right' with the redirected URL if it was   YesodExample site (Either Text Text) followRedirect = do-  mr <- getResponse-  case mr of-    Nothing -> return $ Left "followRedirect called, but there was no previous response, so no redirect to follow"-    Just r -> do-      if HTTP.statusCode (responseStatus r) `notElem` [301, 302, 303, 307, 308]-        then return $ Left "followRedirect called, but previous request was not a redirect"-        else do-          case lookup "Location" (responseHeaders r) of-            Nothing -> return $ Left "followRedirect called, but no location header set"-            Just h ->-              let url = TE.decodeUtf8 h-               in get url >> return (Right url)+  r <- requireResponse+  if HTTP.statusCode (responseStatus r) `notElem` [301, 302, 303, 307, 308]+    then return $ Left "followRedirect called, but previous request was not a redirect"+    else do+      case lookup "Location" (responseHeaders r) of+        Nothing -> return $ Left "followRedirect called, but no location header set"+        Just h ->+          let url = TE.decodeUtf8 h+           in get url >> return (Right url)++followRedirect_ ::+  Yesod site =>+  YesodExample site ()+followRedirect_ = do+  errOrRedirect <- followRedirect+  case errOrRedirect of+    Left err -> liftIO $ expectationFailure (T.unpack err)+    Right _ -> pure ()

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.34.7. -- -- see: https://github.com/sol/hpack  name:           sydtest-yesod-version:        0.3.0.0+version:        0.3.0.1 synopsis:       A yesod companion library for sydtest category:       Testing homepage:       https://github.com/NorfairKing/sydtest#readme@@ -16,6 +16,9 @@ license:        OtherLicense license-file:   LICENSE.md build-type:     Simple+extra-source-files:+    LICENSE.md+    CHANGELOG.md  source-repository head   type: git@@ -35,7 +38,6 @@   build-depends:       base >=4.7 && <5     , binary-    , blaze-builder     , bytestring     , case-insensitive     , containers@@ -47,12 +49,10 @@     , mtl     , network     , network-uri-    , pretty-show     , sydtest >=0.3.0.0     , sydtest-wai     , text     , time-    , wai     , xml-conduit     , yesod-core     , yesod-test@@ -76,15 +76,16 @@     , http-client     , monad-logger     , mtl+    , path+    , path-io     , persistent     , persistent-sqlite-    , persistent-template     , sydtest     , sydtest-persistent-sqlite+    , sydtest-wai     , sydtest-yesod     , text     , yesod-    , yesod-form   default-language: Haskell2010  test-suite sydtest-yesod-test@@ -104,12 +105,14 @@     , bytestring     , conduit     , cookie+    , http-client     , http-types-    , resourcet+    , path+    , path-io     , sydtest+    , sydtest-wai     , sydtest-yesod     , text     , yesod     , yesod-core-    , yesod-form   default-language: Haskell2010

@@ -1,6 +1,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} @@ -12,7 +13,7 @@ import Web.Cookie import Yesod -data App = App+data App = App {appSessionKeyFile :: !FilePath}  mkYesod   "App"@@ -34,7 +35,8 @@     /form FormR GET POST |] -instance Yesod App+instance Yesod App where+  makeSessionBackend App {..} = Just <$> defaultClientSessionBackend 30 appSessionKeyFile  instance RenderMessage App FormMessage where   renderMessage _ _ = defaultFormMessage

@@ -4,68 +4,79 @@ module Test.Syd.YesodSpec (spec) where  import Data.Text (Text)+import Network.HTTP.Client as HTTP+import Path+import Path.IO import Test.Syd+import Test.Syd.Path+import Test.Syd.Wai (managerSpec) import Test.Syd.Yesod import Test.Syd.Yesod.App import Yesod.Core  spec :: Spec-spec = yesodSpec App $ do+spec = managerSpec . modifyMaxSuccess (`div` 20) . yesodSpecWithSiteSetupFunc appSetupFunc $ do   describe "Local" blogSpec   describe "E2E" $ localToE2ESpec blogSpec +appSetupFunc :: HTTP.Manager -> SetupFunc App+appSetupFunc _ = do+  tdir <- tempDirSetupFunc "sydtest-yesod"+  sessionKeyFile <- resolveFile tdir "client_session_key.aes"+  pure $ App {appSessionKeyFile = fromAbsFile sessionKeyFile}+ blogSpec :: (Yesod site, RedirectUrl site (Route App)) => YesodSpec site blogSpec = do   it "responds 200 OK to GET HomeR" $ do     get HomeR-    statusIs 200+    statusShouldBe 200   it "responds 200 OK to GET HomeR using the request builder" $ do     request $ do       setUrl HomeR       setMethod "GET"-    statusIs 200+    statusShouldBe 200   it "responds 200 OK to GET /" $ do     get ("/" :: Text)-    statusIs 200+    statusShouldBe 200   it "responds 200 OK to POST HomeR" $ do     post HomeR-    statusIs 200+    statusShouldBe 200   it "responds 200 OK to POST HomeR using the request builder" $ do     request $ do       setUrl HomeR       setMethod "POST"-    statusIs 200+    statusShouldBe 200   it "responds 200 OK to POST /" $ do     post ("/" :: Text)-    statusIs 200+    statusShouldBe 200   it "is able to add a header" $ do     request $ do       setUrl ExpectsHeaderR       addRequestHeader ("TEST_HEADER", "test")-    statusIs 200+    statusShouldBe 200   it "is able to add a get param" $ do     request $ do       setUrl ExpectsGetParamR       addGetParam "TEST_PARAM" "test"-    statusIs 200+    statusShouldBe 200   it "is able to add a post param" $ do     request $ do       setUrl ExpectsPostParamR       setMethod "POST"       addPostParam "TEST_PARAM" "test"-    statusIs 200+    statusShouldBe 200   it "is able to add a raw post body" $ do     request $ do       setUrl ExpectsPostBodyR       setMethod "POST"       setRequestBody "test"-    statusIs 200+    statusShouldBe 200   it "is able to add a post file" $ do     request $ do       setUrl ExpectsPostFileR       setMethod "POST"       addFileWith "TEST_PARAM" "filename" "test" (Just "text/plain")-    statusIs 200+    statusShouldBe 200   it "can check for redirects" $ do     get RedirectHomeR     locationShouldBe HomeR@@ -73,18 +84,18 @@     liftIO $ case errOrDestination of       Left err -> expectationFailure (show err)       Right _ -> pure ()-    statusIs 200+    statusShouldBe 200   it "retains cookies" $ do     get SetCookieR-    statusIs 200+    statusShouldBe 200     get ExpectsCookieR-    statusIs 200+    statusShouldBe 200   it "can do forms" $ do     get FormR-    statusIs 200+    statusShouldBe 200     request $ do       setUrl FormR       setMethod "POST"       addToken       addPostParam "testKey" "testVal"-    statusIs 200+    statusShouldBe 200