{-# LANGUAGE ConstraintKinds       #-}
{-# LANGUAGE ImplicitParams        #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE ExistentialQuantification   #-}

module IHP.Test.Mocking where

import           Data.ByteString.Builder                   (toLazyByteString)
import qualified Data.ByteString.Lazy                      as LBS
import qualified Data.Vault.Lazy                           as Vault
import qualified Network.HTTP.Types.Status                 as HTTP
import           Network.Wai
import           Network.Wai.Internal                      (ResponseReceived (..))
import           Network.Wai.Parse                         (Param (..))

import           IHP.ApplicationContext                    (ApplicationContext (..))
import qualified IHP.AutoRefresh.Types                     as AutoRefresh
import           IHP.Controller.RequestContext             (RequestBody (..), RequestContext (..))
import           IHP.ControllerSupport                     (InitControllerContext, Controller, runActionWithNewContext)
import           IHP.FrameworkConfig                       (ConfigBuilder (..), FrameworkConfig (..))
import qualified IHP.FrameworkConfig                       as FrameworkConfig
import           IHP.ModelSupport                          (createModelContext, Id')
import           IHP.Prelude
import           IHP.Log.Types
import           IHP.Job.Types
import qualified IHP.Test.Database as Database
import Test.Hspec
import qualified Data.Text as Text
import qualified Network.Wai as Wai
import qualified IHP.LoginSupport.Helper.Controller as Session
import qualified Network.Wai.Session
import qualified Data.Serialize as Serialize
import qualified Control.Exception as Exception
import qualified IHP.PGListener as PGListener
import IHP.Controller.Session (sessionVaultKey)
import qualified Network.Wai.Middleware.Approot as Approot
import qualified Network.Wai.Test as WaiTest

type ContextParameters application = (?applicationContext :: ApplicationContext, ?context :: RequestContext, ?modelContext :: ModelContext, ?application :: application, InitControllerContext application, ?mocking :: MockContext application)

data MockContext application = InitControllerContext application => MockContext
    { forall application. MockContext application -> ModelContext
modelContext :: ModelContext
    , forall application. MockContext application -> RequestContext
requestContext :: RequestContext
    , forall application. MockContext application -> ApplicationContext
applicationContext :: ApplicationContext
    , forall application. MockContext application -> application
application :: application
    }

-- | Create contexts that can be used for mocking
withIHPApp :: (InitControllerContext application) => application -> ConfigBuilder -> (MockContext application -> IO ()) -> IO ()
withIHPApp :: forall application.
InitControllerContext application =>
application
-> ConfigBuilder -> (MockContext application -> IO ()) -> IO ()
withIHPApp application
application ConfigBuilder
configBuilder MockContext application -> IO ()
hspecAction = do
    ConfigBuilder -> (FrameworkConfig -> IO ()) -> IO ()
forall result.
ConfigBuilder -> (FrameworkConfig -> IO result) -> IO result
FrameworkConfig.withFrameworkConfig ConfigBuilder
configBuilder \FrameworkConfig
frameworkConfig -> do
        let FrameworkConfig { Int
dbPoolMaxConnections :: Int
dbPoolMaxConnections :: FrameworkConfig -> Int
dbPoolMaxConnections, NominalDiffTime
dbPoolIdleTime :: NominalDiffTime
dbPoolIdleTime :: FrameworkConfig -> NominalDiffTime
dbPoolIdleTime, ByteString
databaseUrl :: ByteString
databaseUrl :: FrameworkConfig -> ByteString
databaseUrl } = FrameworkConfig
frameworkConfig

        Logger
logger <- LoggerSettings -> IO Logger
newLogger LoggerSettings
forall a. Default a => a
def { level = Warn } -- don't log queries

        let initTestDatabase :: IO TestDatabase
initTestDatabase = ByteString -> IO TestDatabase
Database.createTestDatabase ByteString
databaseUrl
        let cleanupTestDatabase :: TestDatabase -> IO ()
cleanupTestDatabase TestDatabase
testDatabase = ByteString -> TestDatabase -> IO ()
Database.deleteDatabase ByteString
databaseUrl TestDatabase
testDatabase
        let withTestDatabase :: (TestDatabase -> IO ()) -> IO ()
withTestDatabase = IO TestDatabase
-> (TestDatabase -> IO ()) -> (TestDatabase -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
Exception.bracket IO TestDatabase
initTestDatabase TestDatabase -> IO ()
cleanupTestDatabase

        (TestDatabase -> IO ()) -> IO ()
withTestDatabase \TestDatabase
testDatabase -> do
            ModelContext
modelContext <- NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
createModelContext NominalDiffTime
dbPoolIdleTime Int
dbPoolMaxConnections (TestDatabase
testDatabase.url) Logger
logger

            ModelContext -> (PGListener -> IO ()) -> IO ()
forall a. ModelContext -> (PGListener -> IO a) -> IO a
PGListener.withPGListener ModelContext
modelContext \PGListener
pgListener -> do
                IORef AutoRefreshServer
autoRefreshServer <- AutoRefreshServer -> IO (IORef AutoRefreshServer)
forall a. a -> IO (IORef a)
newIORef (PGListener -> AutoRefreshServer
AutoRefresh.newAutoRefreshServer PGListener
pgListener)
                let sessionVault :: Vault
sessionVault = Key (Session IO ByteString ByteString)
-> Session IO ByteString ByteString -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key (Session IO ByteString ByteString)
sessionVaultKey Session IO ByteString ByteString
forall a. Monoid a => a
mempty Vault
Vault.empty
                let applicationContext :: ApplicationContext
applicationContext = ApplicationContext { modelContext :: ModelContext
modelContext = ModelContext
modelContext, IORef AutoRefreshServer
autoRefreshServer :: IORef AutoRefreshServer
autoRefreshServer :: IORef AutoRefreshServer
autoRefreshServer, FrameworkConfig
frameworkConfig :: FrameworkConfig
frameworkConfig :: FrameworkConfig
frameworkConfig, PGListener
pgListener :: PGListener
pgListener :: PGListener
pgListener }

                let requestContext :: RequestContext
requestContext = RequestContext
                     { request :: Request
request = Request
defaultRequest {vault = sessionVault}
                     , requestBody :: RequestBody
requestBody = [Param] -> [File ByteString] -> RequestBody
FormBody [] []
                     , respond :: Respond
respond = IO ResponseReceived -> Respond
forall a b. a -> b -> a
const (ResponseReceived -> IO ResponseReceived
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseReceived
ResponseReceived)
                     , frameworkConfig :: FrameworkConfig
frameworkConfig = FrameworkConfig
frameworkConfig }

                (MockContext application -> IO ()
hspecAction MockContext { application
ModelContext
RequestContext
ApplicationContext
modelContext :: ModelContext
requestContext :: RequestContext
applicationContext :: ApplicationContext
application :: application
application :: application
modelContext :: ModelContext
applicationContext :: ApplicationContext
requestContext :: RequestContext
.. })


mockContextNoDatabase :: (InitControllerContext application) => application -> ConfigBuilder -> IO (MockContext application)
mockContextNoDatabase :: forall application.
InitControllerContext application =>
application -> ConfigBuilder -> IO (MockContext application)
mockContextNoDatabase application
application ConfigBuilder
configBuilder = do
   frameworkConfig :: FrameworkConfig
frameworkConfig@(FrameworkConfig {Int
dbPoolMaxConnections :: FrameworkConfig -> Int
dbPoolMaxConnections :: Int
dbPoolMaxConnections, NominalDiffTime
dbPoolIdleTime :: FrameworkConfig -> NominalDiffTime
dbPoolIdleTime :: NominalDiffTime
dbPoolIdleTime, ByteString
databaseUrl :: FrameworkConfig -> ByteString
databaseUrl :: ByteString
databaseUrl}) <- ConfigBuilder -> IO FrameworkConfig
FrameworkConfig.buildFrameworkConfig ConfigBuilder
configBuilder
   let databaseConnection :: a
databaseConnection = a
forall a. HasCallStack => a
undefined
   Logger
logger <- LoggerSettings -> IO Logger
newLogger LoggerSettings
forall a. Default a => a
def { level = Warn } -- don't log queries
   ModelContext
modelContext <- NominalDiffTime -> Int -> ByteString -> Logger -> IO ModelContext
createModelContext NominalDiffTime
dbPoolIdleTime Int
dbPoolMaxConnections ByteString
databaseUrl Logger
logger

   let sessionVault :: Vault
sessionVault = Key (Session IO ByteString ByteString)
-> Session IO ByteString ByteString -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key (Session IO ByteString ByteString)
sessionVaultKey Session IO ByteString ByteString
forall a. Monoid a => a
mempty Vault
Vault.empty
   PGListener
pgListener <- ModelContext -> IO PGListener
PGListener.init ModelContext
modelContext
   IORef AutoRefreshServer
autoRefreshServer <- AutoRefreshServer -> IO (IORef AutoRefreshServer)
forall a. a -> IO (IORef a)
newIORef (PGListener -> AutoRefreshServer
AutoRefresh.newAutoRefreshServer PGListener
pgListener)
   let applicationContext :: ApplicationContext
applicationContext = ApplicationContext { modelContext :: ModelContext
modelContext = ModelContext
modelContext, IORef AutoRefreshServer
autoRefreshServer :: IORef AutoRefreshServer
autoRefreshServer :: IORef AutoRefreshServer
autoRefreshServer, FrameworkConfig
frameworkConfig :: FrameworkConfig
frameworkConfig :: FrameworkConfig
frameworkConfig, PGListener
pgListener :: PGListener
pgListener :: PGListener
pgListener }

   let requestContext :: RequestContext
requestContext = RequestContext
         { request :: Request
request = Request
defaultRequest {vault = sessionVault}
         , requestBody :: RequestBody
requestBody = [Param] -> [File ByteString] -> RequestBody
FormBody [] []
         , respond :: Respond
respond = \Response
resp -> ResponseReceived -> IO ResponseReceived
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseReceived
ResponseReceived
         , frameworkConfig :: FrameworkConfig
frameworkConfig = FrameworkConfig
frameworkConfig }

   MockContext application -> IO (MockContext application)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MockContext{application
ModelContext
RequestContext
ApplicationContext
modelContext :: ModelContext
requestContext :: RequestContext
applicationContext :: ApplicationContext
application :: application
application :: application
modelContext :: ModelContext
applicationContext :: ApplicationContext
requestContext :: RequestContext
..}

-- | Run a IO action, setting implicit params based on supplied mock context
withContext :: (ContextParameters application => IO a) -> MockContext application -> IO a
withContext :: forall application a.
(ContextParameters application => IO a)
-> MockContext application -> IO a
withContext ContextParameters application => IO a
action mocking :: MockContext application
mocking@MockContext{application
ModelContext
RequestContext
ApplicationContext
modelContext :: forall application. MockContext application -> ModelContext
requestContext :: forall application. MockContext application -> RequestContext
applicationContext :: forall application. MockContext application -> ApplicationContext
application :: forall application. MockContext application -> application
modelContext :: ModelContext
requestContext :: RequestContext
applicationContext :: ApplicationContext
application :: application
..} = let
    ?modelContext = ?modelContext::ModelContext
ModelContext
modelContext
    ?context = ?context::RequestContext
RequestContext
requestContext
    ?applicationContext = ?applicationContext::ApplicationContext
ApplicationContext
applicationContext
    ?application = application
?application::application
application
    ?mocking = ?mocking::MockContext application
MockContext application
mocking
  in do
    IO a
ContextParameters application => IO a
action

setupWithContext :: (ContextParameters application => IO a) -> MockContext application -> IO (MockContext application)
setupWithContext :: forall application a.
(ContextParameters application => IO a)
-> MockContext application -> IO (MockContext application)
setupWithContext ContextParameters application => IO a
action MockContext application
context = (ContextParameters application => IO a)
-> MockContext application -> IO a
forall application a.
(ContextParameters application => IO a)
-> MockContext application -> IO a
withContext IO a
ContextParameters application => IO a
action MockContext application
context IO a
-> IO (MockContext application) -> IO (MockContext application)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MockContext application -> IO (MockContext application)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MockContext application
context

-- | Runs a controller action in a mock environment
callAction :: forall application controller. (Controller controller, ContextParameters application, Typeable application, Typeable controller) => controller -> IO Response
callAction :: forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> IO Response
callAction controller
controller = controller -> [Param] -> IO Response
forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> [Param] -> IO Response
callActionWithParams controller
controller []

-- | Runs a controller action in a mock environment
--
-- >>> callActionWithParams CreatePostAction [("title", "Hello World"), ("body", "lorem ipsum")|
-- Response { .. }
--
callActionWithParams :: forall application controller. (Controller controller, ContextParameters application, Typeable application, Typeable controller) => controller -> [Param] -> IO Response
callActionWithParams :: forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> [Param] -> IO Response
callActionWithParams controller
controller [Param]
params = do
    Middleware
approotMiddleware <- IO Middleware
Approot.envFallback
    let ihpWaiApp :: Request -> Respond -> IO ResponseReceived
ihpWaiApp Request
request Respond
respond = do
            let requestContextWithOverridenRespond :: RequestContext
requestContextWithOverridenRespond = ?context::RequestContext
RequestContext
?context { respond, request, requestBody = FormBody params [] }
            let ?context = ?context::RequestContext
RequestContext
requestContextWithOverridenRespond
            controller -> IO ResponseReceived
forall application controller.
(Controller controller, ?applicationContext::ApplicationContext,
 ?context::RequestContext, InitControllerContext application,
 ?application::application, Typeable application,
 Typeable controller) =>
controller -> IO ResponseReceived
runActionWithNewContext controller
controller

        allMiddlewares :: Middleware
allMiddlewares Request -> Respond -> IO ResponseReceived
app = Middleware
approotMiddleware Request -> Respond -> IO ResponseReceived
app

    SResponse
simpleResponse <- (Request -> Respond -> IO ResponseReceived)
-> Session SResponse -> IO SResponse
forall a.
(Request -> Respond -> IO ResponseReceived) -> Session a -> IO a
WaiTest.withSession (Middleware
allMiddlewares Request -> Respond -> IO ResponseReceived
ihpWaiApp) do
        Request -> Session SResponse
WaiTest.request ?context::RequestContext
RequestContext
?context.request

    Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Status -> ResponseHeaders -> ByteString -> Response
Wai.responseLBS SResponse
simpleResponse.simpleStatus SResponse
simpleResponse.simpleHeaders SResponse
simpleResponse.simpleBody

-- | Run a Job in a mock environment
--
-- __Example:__
--
-- Let's say you have a Job called @JobPost@ that you would like to process as part of a test.
--
-- >  let postJob <- fetch ...
-- >
-- >  callJob postJob
--
-- Note that 'callJob' doesn't set the Job status that is initially set 'IHP.Job.Types.JobStatusNotStarted', as that is
-- done by the Job queue (see 'IHP.Job.Queue.jobDidSucceed' for example).
--
callJob :: forall application job. (ContextParameters application, Typeable application, Job job) => job -> IO ()
callJob :: forall application job.
(ContextParameters application, Typeable application, Job job) =>
job -> IO ()
callJob job
job = do
    let frameworkConfig :: FrameworkConfig
frameworkConfig = ?context::RequestContext
RequestContext
?context.frameworkConfig
    let ?context = ?context::FrameworkConfig
FrameworkConfig
frameworkConfig
    job -> IO ()
forall job.
(Job job, ?modelContext::ModelContext,
 ?context::FrameworkConfig) =>
job -> IO ()
perform job
job


-- | mockAction has been renamed to callAction
mockAction :: forall application controller. (Controller controller, ContextParameters application, Typeable application, Typeable controller) => controller -> IO Response
mockAction :: forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> IO Response
mockAction = controller -> IO Response
forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> IO Response
callAction

-- | Get contents of response
mockActionResponse :: forall application controller. (Controller controller, ContextParameters application, Typeable application, Typeable controller) => controller -> IO LBS.ByteString
mockActionResponse :: forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> IO ByteString
mockActionResponse = (Response -> IO ByteString
responseBody (Response -> IO ByteString) -> IO Response -> IO ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO Response -> IO ByteString)
-> (controller -> IO Response) -> controller -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. controller -> IO Response
forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> IO Response
mockAction

-- | Get HTTP status of the controller
mockActionStatus :: forall application controller. (Controller controller, ContextParameters application, Typeable application, Typeable controller) => controller -> IO HTTP.Status
mockActionStatus :: forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> IO Status
mockActionStatus = (Response -> Status) -> IO Response -> IO Status
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Response -> Status
responseStatus (IO Response -> IO Status)
-> (controller -> IO Response) -> controller -> IO Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. controller -> IO Response
forall application controller.
(Controller controller, ContextParameters application,
 Typeable application, Typeable controller) =>
controller -> IO Response
mockAction

responseBody :: Response -> IO LBS.ByteString
responseBody :: Response -> IO ByteString
responseBody Response
res =
  let (Status
status,ResponseHeaders
headers,(StreamingBody -> IO ByteString) -> IO ByteString
body) = Response
-> (Status, ResponseHeaders,
    (StreamingBody -> IO ByteString) -> IO ByteString)
forall a.
Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
responseToStream Response
res in
  (StreamingBody -> IO ByteString) -> IO ByteString
body ((StreamingBody -> IO ByteString) -> IO ByteString)
-> (StreamingBody -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \StreamingBody
f -> do
    IORef Builder
content <- Builder -> IO (IORef Builder)
forall a. a -> IO (IORef a)
newIORef Builder
forall a. Monoid a => a
mempty
    StreamingBody
f (\Builder
chunk -> IORef Builder -> (Builder -> Builder) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef Builder
content (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
chunk)) (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> IO Builder -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef Builder -> IO Builder
forall a. IORef a -> IO a
readIORef IORef Builder
content

-- | Asserts that the response body contains the given text.
responseBodyShouldContain :: Response -> Text -> IO ()
responseBodyShouldContain :: Response -> Text -> IO ()
responseBodyShouldContain Response
response Text
includedText = do
    Text
body :: Text <- ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response -> IO ByteString
responseBody Response
response
    Text
body Text -> (Text -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` (Text
includedText Text -> Text -> Bool
`Text.isInfixOf`)

-- | Asserts that the response body does not contain the given text.
responseBodyShouldNotContain :: Response -> Text -> IO ()
responseBodyShouldNotContain :: Response -> Text -> IO ()
responseBodyShouldNotContain Response
response Text
includedText = do
    Text
body :: Text <- ByteString -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ByteString -> Text) -> IO ByteString -> IO Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Response -> IO ByteString
responseBody Response
response
    Text
body Text -> (Text -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldNotSatisfy` (Text
includedText Text -> Text -> Bool
`Text.isInfixOf`)

-- | Asserts that the response status is equal to the given status.
responseStatusShouldBe :: Response -> HTTP.Status -> IO ()
responseStatusShouldBe :: Response -> Status -> IO ()
responseStatusShouldBe Response
response Status
status = Response -> Status
responseStatus Response
response Status -> Status -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Status
status

-- | Set's the current user for the application
--
-- Example:
--
-- > user <- newRecord @User
-- >     |> set #email "marc@digitallyinduced.com"
-- >     |> createRecord
-- >
-- > response <- withUser user do
-- >     callAction CreatePostAction
--
-- In this example the 'currentUser' will refer to the newly
-- created user during the execution of CreatePostAction
--
-- Internally this function overrides the session cookie passed to
-- the application.
--
withUser :: forall user application userId result.
    ( ?mocking :: MockContext application
    , ?applicationContext :: ApplicationContext
    , ?context :: RequestContext
    , Serialize.Serialize userId
    , HasField "id" user userId
    , KnownSymbol (GetModelName user)
    ) => user -> ((?context :: RequestContext) => IO result) -> IO result
withUser :: forall user application userId result.
(?mocking::MockContext application,
 ?applicationContext::ApplicationContext, ?context::RequestContext,
 Serialize userId, HasField "id" user userId,
 KnownSymbol (GetModelName user)) =>
user -> ((?context::RequestContext) => IO result) -> IO result
withUser user
user (?context::RequestContext) => IO result
callback =
        let ?context = ?context::RequestContext
RequestContext
newContext
        in IO result
(?context::RequestContext) => IO result
callback
    where
        newContext :: RequestContext
newContext = ?context::RequestContext
RequestContext
?context { request = newRequest }
        newRequest :: Request
newRequest = Request
request { Wai.vault = newVault }

        newSession :: Network.Wai.Session.Session IO ByteString ByteString
        newSession :: Session IO ByteString ByteString
newSession = (ByteString -> IO (Maybe ByteString)
lookupSession, ByteString -> ByteString -> IO ()
forall {f :: * -> *} {p} {p}. Applicative f => p -> p -> f ()
insertSession)

        lookupSession :: ByteString -> IO (Maybe ByteString)
lookupSession ByteString
key = if ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
sessionKey
            then Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
sessionValue)
            else Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing

        insertSession :: p -> p -> f ()
insertSession p
key p
value = () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        newVault :: Vault
newVault = Key (Session IO ByteString ByteString)
-> Session IO ByteString ByteString -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
Vault.insert Key (Session IO ByteString ByteString)
sessionVaultKey Session IO ByteString ByteString
newSession (Request -> Vault
Wai.vault Request
request)
        RequestContext { Request
request :: RequestContext -> Request
request :: Request
request } = ?mocking::MockContext application
MockContext application
?mocking.requestContext

        sessionValue :: ByteString
sessionValue = userId -> ByteString
forall a. Serialize a => a -> ByteString
Serialize.encode (user
user.id)
        sessionKey :: ByteString
sessionKey = ByteString -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (forall user. KnownSymbol (GetModelName user) => ByteString
Session.sessionKey @user)

-- | Turns a record id into a value that can be used with 'callActionWithParams'
--
-- __Example:__
--
-- Let's say you have a test like this:
--
-- >  let postId = cs $ show $ post.id
-- >
-- >  let params = [ ("postId", postId) ]
--
-- You can replace the @cs $ show $@ with a cleaner 'idToParam':
--
--
-- >  let postId = idToParam (libraryOpening.id)
-- >
-- >  let params = [ ("postId", postId) ]
--
idToParam :: forall table. (Show (Id' table)) => Id' table -> ByteString
idToParam :: forall (table :: Symbol).
Show (Id' table) =>
Id' table -> ByteString
idToParam Id' table
id = Id' table
id
    Id' table -> (Id' table -> Text) -> Text
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Id' table -> Text
forall a. Show a => a -> Text
tshow
    Text -> (Text -> ByteString) -> ByteString
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs