{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE UndecidableInstances #-}
module Freckle.App.Test.Yesod
(
MonadYesodExample (..)
, request
, RequestBuilder
, setMethod
, setUrl
, setRequestBody
, addGetParam
, addPostParam
, addRequestHeader
, addJsonHeaders
, setLanguage
, addAcceptLanguage
, addFile
, get
, post
, followRedirect
, getRawBody
, getCsvBody
, getJsonBody
, getResponse
, withResponse
, SResponse (..)
, statusIs
, assertHeader
, assertHeaderContains
, assertHeaderSatisfies
, bodyContains
, getRequestCookies
, testSetCookie
, testDeleteCookie
, testClearCookies
, 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 :: forall a. YesodExample site a -> YesodExample site a
liftYesodExample = forall a. a -> a
id
instance MonadYesodExample site m => MonadYesodExample site (StateT s m) where
liftYesodExample :: forall a. YesodExample site a -> StateT s m a
liftYesodExample = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample
instance MonadYesodExample site m => MonadYesodExample site (ReaderT r m) where
liftYesodExample :: forall a. YesodExample site a -> ReaderT r m a
liftYesodExample = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample
instance MonadYesodExample site m => MonadYesodExample site (ValidateT e m) where
liftYesodExample :: forall a. YesodExample site a -> ValidateT e m a
liftYesodExample = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample
instance MonadYesodExample site m => MonadYesodExample site (MaybeT m) where
liftYesodExample :: forall a. YesodExample site a -> MaybeT m a
liftYesodExample = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample
instance MonadYesodExample site m => MonadYesodExample site (ExceptT e m) where
liftYesodExample :: forall a. YesodExample site a -> ExceptT e m a
liftYesodExample = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample
instance MonadYesodExample site m => MonadYesodExample site (ResourceT m) where
liftYesodExample :: forall a. YesodExample site a -> ResourceT m a
liftYesodExample = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample
instance MonadYesodExample site m => MonadYesodExample site (LoggingT m) where
liftYesodExample :: forall a. YesodExample site a -> LoggingT m a
liftYesodExample = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample
bodyContains :: forall m site. MonadYesodExample site m => String -> m ()
bodyContains :: forall (m :: * -> *) site.
MonadYesodExample site m =>
String -> m ()
bodyContains = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site. HasCallStack => String -> YesodExample site ()
Yesod.Test.bodyContains
testClearCookies :: forall m site. MonadYesodExample site m => m ()
testClearCookies :: forall (m :: * -> *) site. MonadYesodExample site m => m ()
testClearCookies = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall a b. (a -> b) -> a -> b
$ forall site. YesodExample site ()
Yesod.Test.testClearCookies
testDeleteCookie
:: forall m site. MonadYesodExample site m => ByteString -> m ()
testDeleteCookie :: forall (m :: * -> *) site.
MonadYesodExample site m =>
ByteString -> m ()
testDeleteCookie = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site. ByteString -> YesodExample site ()
Yesod.Test.testDeleteCookie
testSetCookie :: forall m site. MonadYesodExample site m => SetCookie -> m ()
testSetCookie :: forall (m :: * -> *) site.
MonadYesodExample site m =>
SetCookie -> m ()
testSetCookie = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site. SetCookie -> YesodExample site ()
Yesod.Test.testSetCookie
getJsonBody :: forall a m site. (MonadYesodExample site m, FromJSON a) => m a
getJsonBody :: forall a (m :: * -> *) site.
(MonadYesodExample site m, FromJSON a) =>
m a
getJsonBody = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {a}. MonadIO m => String -> m a
err forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => ByteString -> Either String a
eitherDecode forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) site. MonadYesodExample site m => m ByteString
getRawBody
where
err :: String -> m a
err String
e = forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString forall a b. (a -> b) -> a -> b
$ String
"Error decoding JSON response body: " forall a. Semigroup a => a -> a -> a
<> String
e
getCsvBody
:: forall a m site. (MonadYesodExample site m, FromNamedRecord a) => m [a]
getCsvBody :: forall a (m :: * -> *) site.
(MonadYesodExample site m, FromNamedRecord a) =>
m [a]
getCsvBody = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {m :: * -> *} {a}. MonadIO m => String -> m a
err (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
V.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
FromNamedRecord a =>
ByteString -> Either String (Header, Vector a)
decodeByName forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) site. MonadYesodExample site m => m ByteString
getRawBody
where
err :: String -> m a
err String
e = forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString forall a b. (a -> b) -> a -> b
$ String
"Error decoding CSV response body: " forall a. Semigroup a => a -> a -> a
<> String
e
getRawBody :: forall m site. MonadYesodExample site m => m BSL.ByteString
getRawBody :: forall (m :: * -> *) site. MonadYesodExample site m => m ByteString
getRawBody =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SResponse -> ByteString
simpleBody forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a
throwString String
"Test response had no body") forall (f :: * -> *) a. Applicative f => a -> f a
pure
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) site.
MonadYesodExample site m =>
m (Maybe SResponse)
getResponse
getResponse :: forall m site. MonadYesodExample site m => m (Maybe SResponse)
getResponse :: forall (m :: * -> *) site.
MonadYesodExample site m =>
m (Maybe SResponse)
getResponse = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall site. YesodExample site (Maybe SResponse)
Yesod.Test.getResponse
request
:: forall m site. MonadYesodExample site m => RequestBuilder site () -> m ()
request :: forall (m :: * -> *) site.
MonadYesodExample site m =>
RequestBuilder site () -> m ()
request = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site. RequestBuilder site () -> YesodExample site ()
Yesod.Test.request
setLanguage :: BCP47 -> RequestBuilder site ()
setLanguage :: forall site. BCP47 -> RequestBuilder site ()
setLanguage = forall site. Text -> Text -> RequestBuilder site ()
addGetParam Text
"_LANG" forall b c a. (b -> c) -> (a -> b) -> a -> c
. BCP47 -> Text
BCP47.toText
addAcceptLanguage :: [Text] -> RequestBuilder site ()
addAcceptLanguage :: forall site. [Text] -> RequestBuilder site ()
addAcceptLanguage [Text]
values =
forall site. Header -> RequestBuilder site ()
addRequestHeader (HeaderName
hAcceptLanguage, Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"," [Text]
values)
addJsonHeaders :: RequestBuilder site ()
= do
forall site. Header -> RequestBuilder site ()
addRequestHeader (HeaderName
hContentType, ByteString
"application/json")
forall site. Header -> RequestBuilder site ()
addRequestHeader (HeaderName
hAccept, ByteString
"application/json")
statusIs
:: forall m site. (HasCallStack, MonadYesodExample site m) => Int -> m ()
statusIs :: forall (m :: * -> *) site.
(HasCallStack, MonadYesodExample site m) =>
Int -> m ()
statusIs = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site. HasCallStack => Int -> YesodExample site ()
Yesod.Test.statusIs
assertHeaderSatisfies
:: forall m site
. MonadYesodExample site m
=> CI ByteString
-> String
-> (ByteString -> Bool)
-> m ()
HeaderName
header String
predicateDesc ByteString -> Bool
predicate = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall a b. (a -> b) -> a -> b
$ forall site a.
HasCallStack =>
(SResponse -> YesodExample site a) -> YesodExample site a
withResponse forall a b. (a -> b) -> a -> b
$ \SResponse
res ->
case forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
header forall a b. (a -> b) -> a -> b
$ SResponse -> ResponseHeaders
simpleHeaders SResponse
res of
Just ByteString
value | ByteString -> Bool
predicate ByteString
value -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ByteString
value ->
forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
expectationFailure forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Expected header "
, forall a. Show a => a -> String
show HeaderName
header
, String
" "
, String
predicateDesc
, String
", but received "
, forall a. Show a => a -> String
show ByteString
value
]
Maybe ByteString
Nothing ->
forall (m :: * -> *). (HasCallStack, MonadIO m) => String -> m ()
expectationFailure forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Expected header "
, forall a. Show a => a -> String
show HeaderName
header
, String
predicateDesc
, String
", but it was not present"
]
assertHeaderContains
:: MonadYesodExample site m
=> CI ByteString
-> ByteString
-> m ()
HeaderName
header ByteString
substring =
forall (m :: * -> *) site.
MonadYesodExample site m =>
HeaderName -> String -> (ByteString -> Bool) -> m ()
assertHeaderSatisfies
HeaderName
header
(String
"to contain " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show ByteString
substring)
(ByteString
substring ByteString -> ByteString -> Bool
`BS.isInfixOf`)
assertHeader
:: forall m site
. MonadYesodExample site m
=> CI ByteString
-> ByteString
-> m ()
HeaderName
k ByteString
v = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall a b. (a -> b) -> a -> b
$ forall site.
HasCallStack =>
HeaderName -> ByteString -> YesodExample site ()
Yesod.Test.assertHeader HeaderName
k ByteString
v
followRedirect
:: forall m site
. MonadYesodExample site m
=> m (Either Text Text)
followRedirect :: forall (m :: * -> *) site.
MonadYesodExample site m =>
m (Either Text Text)
followRedirect = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall site. Yesod site => YesodExample site (Either Text Text)
Yesod.Test.followRedirect
get
:: forall url m site
. (MonadYesodExample site m, RedirectUrl site url)
=> url
-> m ()
get :: forall url (m :: * -> *) site.
(MonadYesodExample site m, RedirectUrl site url) =>
url -> m ()
get = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site url.
(Yesod site, RedirectUrl site url) =>
url -> YesodExample site ()
Yesod.Test.get
post
:: forall url m site
. (MonadYesodExample site m, RedirectUrl site url)
=> url
-> m ()
post :: forall url (m :: * -> *) site.
(MonadYesodExample site m, RedirectUrl site url) =>
url -> m ()
post = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall site url.
(Yesod site, RedirectUrl site url) =>
url -> YesodExample site ()
Yesod.Test.post
getTestYesod :: forall m site. MonadYesodExample site m => m site
getTestYesod :: forall (m :: * -> *) site. MonadYesodExample site m => m site
getTestYesod = forall site (m :: * -> *) a.
MonadYesodExample site m =>
YesodExample site a -> m a
liftYesodExample forall site. YesodExample site site
Yesod.Test.getTestYesod