diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,15 @@ # ChangeLog for hspec-yesod +## 0.2.0 + +- `statusIs` now prints the request method, path, and query string on failing requests +- Tracks the latest request via `yedRequest` on `YesodExampleData` +- Adds `getLatestRequest` and `requireLatestRequest` as helpful accessors for it +- Adds `formatRequestBuilderDataForDebugging` to format the request for use in error messages +- Adds a new `.Internal` module to access fields of `RequestBuilderData` + +Together these changes are intended to allow for better error messages, like the one made to `statusIs`. + ## 0.1.0 - Initial release and fork from `yesod-test`. diff --git a/hspec-yesod.cabal b/hspec-yesod.cabal --- a/hspec-yesod.cabal +++ b/hspec-yesod.cabal @@ -1,5 +1,5 @@ name: hspec-yesod -version: 0.1.0 +version: 0.2.0 license: MIT license-file: LICENSE author: Nubis , Matt Parsons @@ -44,7 +44,7 @@ , yesod-core >= 1.6.17 , yesod-test - exposed-modules: Test.Hspec.Yesod + exposed-modules: Test.Hspec.Yesod, Test.Hspec.Yesod.Internal ghc-options: -Wall -fwarn-redundant-constraints hs-source-dirs: src diff --git a/src/Test/Hspec/Yesod.hs b/src/Test/Hspec/Yesod.hs --- a/src/Test/Hspec/Yesod.hs +++ b/src/Test/Hspec/Yesod.hs @@ -219,6 +219,9 @@ -- * Grab information , getTestYesod + , getLatestRequest + , requireLatestRequest + , formatRequestBuilderDataForDebugging , getResponse , getRequestCookies @@ -278,6 +281,7 @@ import qualified Yesod.Test.Internal.SIO as YT.SIO import Yesod.Test.Internal.SIO (SIO, execSIO, runSIO) import qualified Yesod.Test.Internal as YT.Internal (getBodyTextPreview, contentTypeHeaderIsUtf8) +import Test.Hspec.Yesod.Internal -- | The state used in a single test case defined using 'yit' -- @@ -287,6 +291,7 @@ , yedMiddleware :: !Middleware , yedSite :: !site , yedCookies :: !Cookies + , yedRequest :: !(Maybe (RequestBuilderData site)) , yedResponse :: !(Maybe SResponse) , yedTestCleanup :: !(IO ()) } @@ -317,30 +322,31 @@ getTestYesod :: YesodExample site site getTestYesod = fmap yedSite MS.get +-- | Get the most recently provided request value, if available. +-- +-- This is intended to allow assertions to add context on the request in their error messages. +-- Currently the contents of RequestBuilderData are only accessible via Test.Hspec.Yesod.Internal and formatRequestBuilderDataForDebugging. +-- +-- @since 0.2.0 +getLatestRequest :: YesodExample site (Maybe (RequestBuilderData site)) +getLatestRequest = fmap yedRequest MS.get + +-- | Like 'getLatestRequest', but throws an error if no request has been made. +-- +-- @since 0.2.0 +requireLatestRequest :: YesodExample site (RequestBuilderData site) +requireLatestRequest = do + mRequest <- getLatestRequest + case mRequest of + Nothing -> failure "Called requireLatestRequest, but no request has been made" + Just r -> pure r + -- | Get the most recently provided response value, if available. -- -- Since 1.2.0 getResponse :: YesodExample site (Maybe SResponse) getResponse = fmap yedResponse MS.get -data RequestBuilderData site = RequestBuilderData - { rbdPostData :: RBDPostData - , rbdResponse :: (Maybe SResponse) - , rbdMethod :: H.Method - , rbdSite :: site - , rbdPath :: [T.Text] - , rbdGets :: H.Query - , rbdHeaders :: H.RequestHeaders - } - -data RBDPostData = MultipleItemsPostData [RequestPart] - | BinaryPostData BSL8.ByteString - --- | Request parts let us discern regular key/values from files sent in the request. -data RequestPart - = ReqKvPart T.Text T.Text - | ReqFilePart T.Text FilePath BSL8.ByteString T.Text - -- | The 'RequestBuilder' state monad constructs a URL encoded string of arguments -- to send with your requests. Some of the functions that run on it use the current -- response to analyze the forms that the server is expecting to receive. @@ -362,6 +368,7 @@ , yedMiddleware = id , yedSite = site , yedCookies = M.empty + , yedRequest = Nothing , yedResponse = Nothing , yedTestCleanup = pure () } @@ -393,6 +400,7 @@ , yedMiddleware = id , yedSite = site , yedCookies = M.empty + , yedRequest = Nothing , yedResponse = Nothing , yedTestCleanup = pure () } @@ -591,6 +599,7 @@ -- > statusIs 200 statusIs :: HasCallStack => Int -> YesodExample site () statusIs number = do + latestRequest <- requireLatestRequest withResponse $ \(SResponse status headers body) -> do let mContentType = lookup hContentType headers isUTF8ContentType = maybe False YT.Internal.contentTypeHeaderIsUtf8 mContentType @@ -598,6 +607,7 @@ liftIO $ flip HUnit.assertBool (H.statusCode status == number) $ concat [ "Expected status was ", show number , " but received status was ", show $ H.statusCode status + , " for " <> (T.unpack $ formatRequestBuilderDataForDebugging latestRequest) , if isUTF8ContentType then ". For debugging, the body was: " <> (T.unpack $ YT.Internal.getBodyTextPreview body) else "" @@ -1359,6 +1369,22 @@ mkApplication = do liftIO . yesodExampleDataToApplication =<< MS.get +-- | Provides a helpful summary of the request, meant to be used in assertion functions +-- +-- Currently formats as METHOD PATH?QUERY, e.g. GET /foo/bar?q=true +-- The exact format is subject to change. +-- +-- @since 0.2.0 +formatRequestBuilderDataForDebugging :: RequestBuilderData site -> T.Text +formatRequestBuilderDataForDebugging RequestBuilderData{..} = + (TE.decodeUtf8 rbdMethod) <> " " <> getEncodedPath rbdPath <> (TE.decodeUtf8 $ H.renderQuery True rbdGets) + +getEncodedPath :: [T.Text] -> T.Text +getEncodedPath pathSegments = + if null pathSegments + then "/" + else TE.decodeUtf8 $ Builder.toByteString $ H.encodePathSegments pathSegments + -- | The general interface for performing requests. 'request' takes a 'RequestBuilder', -- constructs a request, and executes it. -- @@ -1381,7 +1407,7 @@ mRes <- MS.gets yedResponse oldCookies <- MS.gets yedCookies - RequestBuilderData {..} <- liftIO $ execSIO reqBuilder RequestBuilderData + rbd@RequestBuilderData {..} <- liftIO $ execSIO reqBuilder RequestBuilderData { rbdPostData = MultipleItemsPostData [] , rbdResponse = mRes , rbdMethod = "GET" @@ -1390,9 +1416,7 @@ , rbdGets = [] , rbdHeaders = [] } - let path - | null rbdPath = "/" - | otherwise = TE.decodeUtf8 $ Builder.toByteString $ H.encodePathSegments rbdPath + let path = getEncodedPath rbdPath -- expire cookies and filter them for the current path. TODO: support max age currentUtc <- liftIO getCurrentTime @@ -1421,7 +1445,7 @@ }) app let newCookies = parseSetCookies $ simpleHeaders response cookies' = M.fromList [(Cookie.setCookieName c, c) | c <- newCookies] `M.union` cookies - modify $ \e -> e { yedCookies = cookies', yedResponse = Just response } + modify $ \e -> e { yedCookies = cookies', yedRequest = Just rbd, yedResponse = Just response } where isFile (ReqFilePart _ _ _ _) = True isFile _ = False @@ -1545,6 +1569,7 @@ , yedMiddleware = id , yedSite = site , yedCookies = M.empty + , yedRequest = Nothing , yedResponse = Nothing , yedTestCleanup = pure () } diff --git a/src/Test/Hspec/Yesod/Internal.hs b/src/Test/Hspec/Yesod/Internal.hs new file mode 100644 --- /dev/null +++ b/src/Test/Hspec/Yesod/Internal.hs @@ -0,0 +1,71 @@ +-- | This module exposes functions that are used internally by yesod-test. The functions exposed here are _not_ a stable API—they may be changed or removed without any major version bump. +-- +-- That said, you may find them useful if your application can accept API breakage. +module Test.Hspec.Yesod.Internal + ( RequestBuilderData(..) + , RBDPostData(..) + , RequestPart(..) + ) where + +import Control.Monad.Catch (finally) +import Test.Hspec.Core.Spec +import Test.Hspec.Core.Hooks +import qualified Data.List as DL +import qualified Data.ByteString.Char8 as BS8 +import Data.ByteString (ByteString) +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.Text.Encoding.Error as TErr +import qualified Data.ByteString.Lazy.Char8 as BSL8 +import qualified Test.HUnit as HUnit +import qualified Network.HTTP.Types as H +import qualified Network.Socket as Sock +import Data.CaseInsensitive (CI) +import qualified Data.CaseInsensitive as CI +import Network.Wai +import Network.Wai.Test hiding (assertHeader, assertNoHeader, request) +import Control.Monad.IO.Class +import qualified Control.Monad.State.Class as MS +import Control.Monad.State.Class hiding (get) +import System.IO +import Yesod.Core.Unsafe (runFakeHandler) +import Yesod.Core +import qualified Data.Text.Lazy as TL +import Data.Text.Lazy.Encoding (encodeUtf8, decodeUtf8, decodeUtf8With) +import Text.XML.Cursor hiding (element) +import qualified Text.XML.Cursor as C +import qualified Text.HTML.DOM as HD +import qualified Data.Map as M +import qualified Web.Cookie as Cookie +import qualified Blaze.ByteString.Builder as Builder +import Data.Time.Clock (getCurrentTime) +import Control.Applicative ((<$>)) +import Text.Show.Pretty (ppShow) +import Data.Monoid (mempty) +import Data.ByteArray.Encoding (convertToBase, Base(..)) +import Network.HTTP.Types.Header (hContentType) +import Data.Aeson (eitherDecode') +import Control.Monad +import qualified Yesod.Test.TransversingCSS as YT.CSS +import Yesod.Test.TransversingCSS (HtmlLBS, Query) +import qualified Yesod.Test.Internal.SIO as YT.SIO +import Yesod.Test.Internal.SIO (SIO, execSIO, runSIO) +import qualified Yesod.Test.Internal as YT.Internal (getBodyTextPreview, contentTypeHeaderIsUtf8) + +data RequestBuilderData site = RequestBuilderData + { rbdPostData :: RBDPostData + , rbdResponse :: (Maybe SResponse) + , rbdMethod :: H.Method + , rbdSite :: site + , rbdPath :: [T.Text] + , rbdGets :: H.Query + , rbdHeaders :: H.RequestHeaders + } + +data RBDPostData = MultipleItemsPostData [RequestPart] + | BinaryPostData BSL8.ByteString + +-- | Request parts let us discern regular key/values from files sent in the request. +data RequestPart + = ReqKvPart T.Text T.Text + | ReqFilePart T.Text FilePath BSL8.ByteString T.Text