sydtest-yesod 0.2.0.1 → 0.3.0.0

raw patch · 7 files changed

+187/−28 lines, 7 filesdep +binarydep +http-client-tlsdep +network-uriPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, http-client-tls, network-uri

API changes (from Hackage documentation)

Files

• src/Test/Syd/Yesod.hs +11/−0
• src/Test/Syd/Yesod/Client.hs +4/−3
• src/Test/Syd/Yesod/Def.hs +19/−3
• src/Test/Syd/Yesod/E2E.hs +97/−0
• src/Test/Syd/Yesod/Request.hs +42/−20
• sydtest-yesod.cabal +7/−2
• test/Test/Syd/YesodSpec.hs +7/−0

@@ -9,6 +9,8 @@ -- For a fully-worked example, see sydtest-yesod/blog-example. module Test.Syd.Yesod   ( -- * Functions to run a test suite++    -- ** Tests against a local instance of a site     yesodSpec,     yesodSpecWithSiteGenerator,     yesodSpecWithSiteGeneratorAndArgument,@@ -20,6 +22,13 @@     -- *** Setup functions     yesodClientSetupFunc, +    -- ** Tests against a remote instance of a site+    yesodE2ESpec,+    yesodE2ESpec',+    E2E (..),+    localToE2ESpec,+    localToE2EClient,+     -- ** Core     YesodSpec,     YesodClient (..),@@ -77,6 +86,7 @@     module Test.Syd.Yesod.Client,     module Test.Syd.Yesod.Def,     module Test.Syd.Yesod.Request,+    module Test.Syd.Yesod.E2E,      -- * Reexports     module HTTP,@@ -87,4 +97,5 @@ import Network.HTTP.Types as HTTP import Test.Syd.Yesod.Client import Test.Syd.Yesod.Def+import Test.Syd.Yesod.E2E import Test.Syd.Yesod.Request

@@ -24,6 +24,7 @@ import Network.HTTP.Client as HTTP import Network.HTTP.Types as HTTP import Network.Socket (PortNumber)+import Network.URI import Test.Syd import Test.Syd.Wai.Client (lastRequestResponseContext) import Yesod.Core as Yesod@@ -34,8 +35,8 @@     yesodClientSite :: !site,     -- | The 'HTTP.Manager' to make the requests     yesodClientManager :: !HTTP.Manager,-    -- | The port that the site is running on, using @warp@-    yesodClientSitePort :: !PortNumber+    -- | The base 'URI' that the site is running on+    yesodClientSiteURI :: !URI   }   deriving (Generic) @@ -103,7 +104,7 @@ getLast = State.gets yesodClientStateLast  -- | Get the 'Location' header of most recently received response.-getLocation :: ParseRoute site => YesodClientM site (Either Text (Route site))+getLocation :: ParseRoute site => YesodClientM localSite (Either Text (Route site)) getLocation = do   mr <- getResponse   case mr of

@@ -23,6 +23,7 @@  import GHC.Stack (HasCallStack) import Network.HTTP.Client as HTTP+import Network.URI import Test.Syd import Test.Syd.Wai import Test.Syd.Yesod.Client@@ -167,14 +168,29 @@         YesodClient           { yesodClientManager = man,             yesodClientSite = site,-            yesodClientSitePort = p+            yesodClientSiteURI =+              nullURI+                { uriScheme = "http:",+                  uriAuthority =+                    Just $+                      URIAuth+                        { uriUserInfo = "",+                          uriRegName = "localhost",+                          uriPort = ':' : show p+                        }+                }           }   pure client  -- | For backward compatibility with yesod-test type YesodSpec site = TestDef '[HTTP.Manager] (YesodClient site) --- | Define a test in the 'YesodClientM site' monad instead of 'IO'.+-- | Define a test in the @YesodClientM site@ monad instead of 'IO'.+--+-- The @YesodClientM site ()@ type is a member of 'IsTest', so 'yit' is defined as 'it'.+-- This function is only here for backward compatibility.+--+-- > yit = it yit ::   forall site.   HasCallStack =>@@ -183,7 +199,7 @@   YesodSpec site yit = it --- | For compatibility with `yesod-test`+-- | For compatibility with @yesod-test@ -- -- > ydescribe = describe ydescribe :: String -> YesodSpec site -> YesodSpec site

@@ -0,0 +1,97 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}++module Test.Syd.Yesod.E2E where++import Control.Arrow (second)+import qualified Data.Binary.Builder as BB+import qualified Data.ByteString.Lazy as LB+import Data.Function+import qualified Data.Text.Encoding as TE+import GHC.Generics (Generic)+import Network.HTTP.Client as HTTP+import Network.HTTP.Client.TLS+import Network.HTTP.Types as HTTP+import Network.URI+import Test.Syd+import Test.Syd.Yesod.Client+import Test.Syd.Yesod.Def+import Yesod.Core++-- | Run an end-to-end yesod test suite against a remote server at the given 'URI'.+--+-- If you would like to write tests that can be run against both a local and a remote instance of your site, you can use the following type:+--+-- > mySpec :: (Yesod site, RedirectUrl site (Route App)) => YesodSpec site+-- > mySpec = do+-- >   it "responds 200 OK to GET HomeR" $ do+-- >     get HomeR+-- >     statusIs 200+yesodE2ESpec :: URI -> YesodSpec (E2E site) -> Spec+yesodE2ESpec uri = beforeAll newTlsManager . yesodE2ESpec' uri++-- | Like 'yesodE2ESpec', but doesn't set up the 'HTTP.Manager' for you.+--+-- If you are running the end-to-end test against a server that uses+-- @https://@, make sure to use a TLS-enabled 'HTTP.Manager'.+--+-- You can do this using @beforeAll newTlsManager@.+yesodE2ESpec' :: URI -> YesodSpec (E2E site) -> TestDef '[HTTP.Manager] ()+yesodE2ESpec' uri =+  beforeWith'+    ( \man () -> do+        pure+          YesodClient+            { yesodClientManager = man,+              yesodClientSite = E2E,+              yesodClientSiteURI = uri+            }+    )++-- | Turn a local 'YesodClient site' into a remote 'YesodClient (E2E site)'.+localToE2EClient :: YesodClient site -> YesodClient (E2E site)+localToE2EClient yc = yc {yesodClientSite = E2E}++-- | See 'localToE2EClient'+--+-- Turn an end-to-end yesod test suite into a local yesod test suite by+-- treating a local instance as remote.+localToE2ESpec :: YesodSpec (E2E site) -> YesodSpec site+localToE2ESpec = beforeWith (\yc -> pure $ localToE2EClient yc)++-- | A dummy type that is an instance of 'Yesod', with as a phantom type, the app that it represents.+--+-- That is to say, @E2E site@ is an instance of 'Yesod' that pretends to be a+-- @site@. You can treat it as a @site@ in end-to-end tests, except that you+-- cannot use the @site@ value because there is none in there.+data E2E site = E2E+  deriving (Show, Eq, Generic)++instance Yesod site => Yesod (E2E site)++instance (Eq (Route site), RenderRoute site) => RenderRoute (E2E site) where+  data Route (E2E site) = E2ERoute {unE2ERoute :: Route site}+    deriving (Generic)+  renderRoute (E2ERoute route) = renderRoute route++instance Show (Route site) => Show (Route (E2E site)) where+  show = show . unE2ERoute++instance Eq (Route site) => Eq (Route (E2E site)) where+  (==) = (==) `on` unE2ERoute++instance RenderRoute site => RedirectUrl (E2E site) (Route site) where+  toTextUrl route = do+    let (urlPieces, queryParams) = renderRoute (E2ERoute route)+        q = queryTextToQuery $ map (second Just) queryParams+        pathBS = encodePath urlPieces q+    pure $ TE.decodeUtf8 (LB.toStrict (BB.toLazyByteString pathBS)) -- Not safe, but it will fail during testing (if at all) so should be ok.++instance ParseRoute site => ParseRoute (E2E site) where+  parseRoute = fmap E2ERoute . parseRoute

@@ -30,7 +30,7 @@ import Data.Time import GHC.Stack import Network.HTTP.Client as HTTP-import Network.HTTP.Client.Internal (httpRaw)+import Network.HTTP.Client.Internal (httpRaw, toHttpException) import Network.HTTP.Client.MultipartFormData import Network.HTTP.Types as HTTP import Test.Syd@@ -84,7 +84,7 @@ -- >   get HomeR -- >   statusIs 301 -- >   locationShouldBe OverviewR-locationShouldBe :: (ParseRoute site, Show (Route site)) => Route site -> YesodClientM site ()+locationShouldBe :: (ParseRoute site, Show (Route site)) => Route site -> YesodClientM localSite () locationShouldBe expected =   withLastRequestContext $ do     errOrLoc <- getLocation@@ -167,14 +167,21 @@ -- | Run a 'RequestBuilder' to make the 'Request' that it defines. runRequestBuilder :: RequestBuilder site a -> YesodClientM site Request runRequestBuilder (RequestBuilder func) = do-  p <- asks yesodClientSitePort-  cj <- State.gets yesodClientStateCookies+  baseURI <- asks yesodClientSiteURI   RequestBuilderData {..} <- execStateT func initialRequestBuilderData   let requestStr = T.unpack requestBuilderDataUrl -  req <- case parseRequest requestStr <|> parseRequest ("http://localhost" <> requestStr) of-    Nothing -> liftIO $ expectationFailure $ "Failed to parse url: " <> requestStr+  -- We try without the base URI first, just in case:+  --+  -- There is an absolute URI in a redirect that we're following+  -- OR+  -- you want to contact any URI other than the server under test+  req <- case parseRequest requestStr of     Just req -> pure req+    Nothing ->+      case parseRequest $ show baseURI <> requestStr of+        Nothing -> liftIO $ expectationFailure $ "Failed to parse url: " <> requestStr+        Just req -> pure req   boundary <- liftIO webkitBoundary   (body, contentTypeHeader) <- liftIO $ case requestBuilderDataPostData of     MultipleItemsPostData [] -> pure (RequestBodyBS SB.empty, Nothing)@@ -205,12 +212,12 @@               Just "application/x-www-form-urlencoded"             )     BinaryPostData sb -> pure (RequestBodyBS sb, Nothing)+  cj <- State.gets yesodClientStateCookies   now <- liftIO getCurrentTime   let (req', cj') =         insertCookiesIntoRequest           ( req-              { port = fromIntegral p, -- Safe because it is PortNumber -> Int-                method = requestBuilderDataMethod,+              { method = requestBuilderDataMethod,                 requestHeaders =                   concat                     [ requestBuilderDataHeaders,@@ -353,21 +360,29 @@ -- | Perform the given request as-is. -- -- Note that this function does not check whether you are making a request to the site under test.--- You could make a request to https://google.com if you wanted.+-- You could make a request to https://example.com if you wanted. performRequest :: Request -> YesodClientM site () performRequest req = do   man <- asks yesodClientManager-  resp <- liftIO $ httpRaw req man >>= traverse (fmap LB.fromChunks . brConsume)-  cj <- State.gets yesodClientStateCookies-  now <- liftIO getCurrentTime-  let (cj', _) = updateCookieJar resp req now cj-  State.modify'-    ( \s ->-        s-          { yesodClientStateLast = Just (req, resp),-            yesodClientStateCookies = cj'-          }-    )+  errOrResp <-+    liftIO $+      (Right <$> (httpRaw req man >>= traverse (fmap LB.fromChunks . brConsume)))+        `catches` [ Handler $ \e -> pure $ Left $ toHttpException req e,+                    Handler $ \e -> pure $ Left (e :: HttpException)+                  ]+  case errOrResp of+    Left err -> liftIO $ expectationFailure $ "HTTPException: " <> displayException err+    Right resp -> do+      cj <- State.gets yesodClientStateCookies+      now <- liftIO getCurrentTime+      let (cj', _) = updateCookieJar resp req now cj+      State.modify'+        ( \s ->+            s+              { yesodClientStateLast = Just (req, resp),+                yesodClientStateCookies = cj'+              }+        )  -- | For backward compatibiilty, you can use the 'MonadState' constraint to get access to the 'CookieJar' directly. getRequestCookies :: RequestBuilder site (Map ByteString SetCookie)@@ -397,6 +412,13 @@ -- -- (We consider a request a redirect if the status is -- 301, 302, 303, 307 or 308, and the Location header is set.)+--+-- >  it "redirects home" $ do+-- >    get RedirectHomeR+-- >    statusIs 303+-- >    locationShouldBe HomeR+-- >    _ <- followRedirect+-- >    statusIs 200 followRedirect ::   Yesod site =>   -- | 'Left' with an error message if not a redirect, 'Right' with the redirected URL if it was

@@ -5,14 +5,14 @@ -- see: https://github.com/sol/hpack  name:           sydtest-yesod-version:        0.2.0.1+version:        0.3.0.0 synopsis:       A yesod companion library for sydtest category:       Testing homepage:       https://github.com/NorfairKing/sydtest#readme bug-reports:    https://github.com/NorfairKing/sydtest/issues author:         Tom Sydney Kerckhove maintainer:     syd@cs-syd.eu-copyright:      Copyright (c) 2020 Tom Sydney Kerckhove+copyright:      Copyright (c) 2020-2021 Tom Sydney Kerckhove license:        OtherLicense license-file:   LICENSE.md build-type:     Simple@@ -26,6 +26,7 @@       Test.Syd.Yesod       Test.Syd.Yesod.Client       Test.Syd.Yesod.Def+      Test.Syd.Yesod.E2E       Test.Syd.Yesod.Request   other-modules:       Paths_sydtest_yesod@@ -33,6 +34,7 @@       src   build-depends:       base >=4.7 && <5+    , binary     , blaze-builder     , bytestring     , case-insensitive@@ -40,9 +42,11 @@     , cookie     , exceptions     , http-client+    , http-client-tls     , http-types     , mtl     , network+    , network-uri     , pretty-show     , sydtest >=0.3.0.0     , sydtest-wai@@ -106,5 +110,6 @@     , sydtest-yesod     , text     , yesod+    , yesod-core     , yesod-form   default-language: Haskell2010

@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-}  module Test.Syd.YesodSpec (spec) where@@ -6,9 +7,15 @@ import Test.Syd import Test.Syd.Yesod import Test.Syd.Yesod.App+import Yesod.Core  spec :: Spec spec = yesodSpec App $ do+  describe "Local" blogSpec+  describe "E2E" $ localToE2ESpec blogSpec++blogSpec :: (Yesod site, RedirectUrl site (Route App)) => YesodSpec site+blogSpec = do   it "responds 200 OK to GET HomeR" $ do     get HomeR     statusIs 200