{-# 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                        as HTTP
import           Network.Wai
import           Network.Wai.Internal                      (ResponseReceived (..))
import           Network.Wai.Parse                         (Param (..))

import           Wai.Request.Params.Middleware                 (Respond)
import           IHP.ControllerSupport                     (InitControllerContext, Controller, runActionWithNewContext)
import           IHP.FrameworkConfig                       (ConfigBuilder (..), FrameworkConfig (..), RootApplication (..))
import qualified IHP.FrameworkConfig                       as FrameworkConfig
import           IHP.ModelSupport                          (createModelContext, withModelContext, Id')
import           IHP.Prelude
import           IHP.Log.Types
import           IHP.Job.Types
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 IHP.Controller.Session (sessionVaultKey)
import IHP.Server (initMiddlewareStack)
import qualified IHP.Server as Server
import IHP.Controller.NotFound (handleNotFound)
import IHP.RouterSupport (FrontController)

type ContextParameters application = (?request :: Request, ?respond :: Respond, ?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 -> FrameworkConfig
frameworkConfig :: FrameworkConfig
    , forall application. MockContext application -> Request
mockRequest :: Request
    , forall application. MockContext application -> Respond
mockRespond :: Respond
    , forall application. MockContext application -> application
application :: application
    }

-- | Run a request through the test middleware stack.
-- This applies the same middlewares that IHP.Server uses (with PGListener disabled).
-- Used for initial setup only - actual request params are handled in callActionWithParams.
runTestMiddlewares :: FrameworkConfig -> ModelContext -> Request -> IO Request
runTestMiddlewares :: FrameworkConfig -> ModelContext -> Request -> IO Request
runTestMiddlewares FrameworkConfig
frameworkConfig ModelContext
modelContext Request
baseRequest = do
    -- Capture the modified request after running through middlewares
    resultRef <- Request -> IO (IORef Request)
forall a. a -> IO (IORef a)
newIORef Request
baseRequest
    let captureApp Request
req Respond
respond = do
            IORef Request -> Request -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Request
resultRef Request
req
            Respond
respond (Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
HTTP.status200 [] ByteString
"")

    -- Use the same middleware stack as production, but without PGListener
    middlewareStack <- initMiddlewareStack frameworkConfig modelContext Nothing

    -- Run request through middleware stack
    _ <- middlewareStack captureApp baseRequest (\Response
_ -> ResponseReceived -> IO ResponseReceived
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseReceived
ResponseReceived)

    readIORef resultRef

{-# DEPRECATED mockContextNoDatabase "Use withMockContext instead for bracket-style resource management" #-}
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 {databaseUrl}) <- ConfigBuilder -> IO FrameworkConfig
FrameworkConfig.buildFrameworkConfig ConfigBuilder
configBuilder
   logger <- newLogger def { level = Warn } -- don't log queries
   modelContext <- createModelContext databaseUrl logger

   -- Start with a minimal request - the middleware stack will set up session, etc.
   let baseRequest = Request
defaultRequest
   mockRequest <- runTestMiddlewares frameworkConfig modelContext baseRequest
   let mockRespond = IO ResponseReceived -> b -> IO ResponseReceived
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)

   pure MockContext{..}

-- | Bracket-style mock context creation with proper resource cleanup.
--
-- Uses 'withModelContext' to ensure the database pool is released when done.
-- Prefer this over 'mockContextNoDatabase'.
--
-- __Example:__ Use with hspec's 'aroundAll':
--
-- > tests :: Spec
-- > tests = aroundAll (withMockContext WebApplication config) do
-- >     it "should work" $ withContext do
-- >         ...
--
withMockContext :: (InitControllerContext application) => application -> ConfigBuilder -> (MockContext application -> IO a) -> IO a
withMockContext :: forall application a.
InitControllerContext application =>
application
-> ConfigBuilder -> (MockContext application -> IO a) -> IO a
withMockContext application
application ConfigBuilder
configBuilder MockContext application -> IO a
action =
    ConfigBuilder -> (FrameworkConfig -> IO a) -> IO a
forall result.
ConfigBuilder -> (FrameworkConfig -> IO result) -> IO result
FrameworkConfig.withFrameworkConfig ConfigBuilder
configBuilder \FrameworkConfig
frameworkConfig -> do
        ByteString -> Logger -> (ModelContext -> IO a) -> IO a
forall a. ByteString -> Logger -> (ModelContext -> IO a) -> IO a
withModelContext FrameworkConfig
frameworkConfig.databaseUrl FrameworkConfig
frameworkConfig.logger \ModelContext
modelContext -> do
            let baseRequest :: Request
baseRequest = Request
defaultRequest
            mockRequest <- FrameworkConfig -> ModelContext -> Request -> IO Request
runTestMiddlewares FrameworkConfig
frameworkConfig ModelContext
modelContext Request
baseRequest
            let mockRespond = IO ResponseReceived -> b -> IO ResponseReceived
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)
            action MockContext{..}

-- | Build a WAI 'Application' from a 'MockContext' for use with @runSession@.
initTestApplication :: (FrontController RootApplication) => MockContext application -> IO Application
initTestApplication :: forall application.
FrontController RootApplication =>
MockContext application
-> IO (Request -> Respond -> IO ResponseReceived)
initTestApplication MockContext { FrameworkConfig
frameworkConfig :: forall application. MockContext application -> FrameworkConfig
frameworkConfig :: FrameworkConfig
frameworkConfig, ModelContext
modelContext :: forall application. MockContext application -> ModelContext
modelContext :: ModelContext
modelContext } = do
    middleware <- FrameworkConfig
-> ModelContext -> Maybe PGListener -> IO Middleware
initMiddlewareStack FrameworkConfig
frameworkConfig ModelContext
modelContext Maybe PGListener
forall a. Maybe a
Nothing
    pure (middleware $ Server.application handleNotFound (\Request -> Respond -> IO ResponseReceived
app -> Request -> Respond -> IO ResponseReceived
app))

-- | Combines 'withMockContext' and 'initTestApplication' into a single bracket.
--
-- __Example:__ Use with hspec's 'aroundAll':
--
-- > tests :: Spec
-- > tests = aroundAll (withMockContextAndApp WebApplication config) do
-- >     it "should work" $ withContextAndApp \application -> do
-- >         runSession (testGet "/foo") application >>= assertSuccess "bar"
--
withMockContextAndApp :: (InitControllerContext application, FrontController RootApplication) => application -> ConfigBuilder -> ((MockContext application, Application) -> IO a) -> IO a
withMockContextAndApp :: forall application a.
(InitControllerContext application,
 FrontController RootApplication) =>
application
-> ConfigBuilder
-> ((MockContext application,
     Request -> Respond -> IO ResponseReceived)
    -> IO a)
-> IO a
withMockContextAndApp application
application ConfigBuilder
configBuilder (MockContext application,
 Request -> Respond -> IO ResponseReceived)
-> IO a
action =
    application
-> ConfigBuilder -> (MockContext application -> IO a) -> IO a
forall application a.
InitControllerContext application =>
application
-> ConfigBuilder -> (MockContext application -> IO a) -> IO a
withMockContext application
application ConfigBuilder
configBuilder \MockContext application
ctx -> do
        app <- MockContext application
-> IO (Request -> Respond -> IO ResponseReceived)
forall application.
FrontController RootApplication =>
MockContext application
-> IO (Request -> Respond -> IO ResponseReceived)
initTestApplication MockContext application
ctx
        action (ctx, app)

-- | Like 'withContext' but for specs using 'withMockContextAndApp'.
-- The WAI 'Application' is passed to the callback.
withContextAndApp :: (ContextParameters application => Application -> IO a) -> (MockContext application, Application) -> IO a
withContextAndApp :: forall application a.
(ContextParameters application =>
 (Request -> Respond -> IO ResponseReceived) -> IO a)
-> (MockContext application,
    Request -> Respond -> IO ResponseReceived)
-> IO a
withContextAndApp ContextParameters application =>
(Request -> Respond -> IO ResponseReceived) -> IO a
action (MockContext application
ctx, Request -> Respond -> IO ResponseReceived
app) = (ContextParameters application => IO a)
-> MockContext application -> IO a
forall application a.
(ContextParameters application => IO a)
-> MockContext application -> IO a
withContext (ContextParameters application =>
(Request -> Respond -> IO ResponseReceived) -> IO a
(Request -> Respond -> IO ResponseReceived) -> IO a
action Request -> Respond -> IO ResponseReceived
app) MockContext application
ctx

-- | 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
Request
ModelContext
FrameworkConfig
Respond
modelContext :: forall application. MockContext application -> ModelContext
frameworkConfig :: forall application. MockContext application -> FrameworkConfig
mockRequest :: forall application. MockContext application -> Request
mockRespond :: forall application. MockContext application -> Respond
application :: forall application. MockContext application -> application
modelContext :: ModelContext
frameworkConfig :: FrameworkConfig
mockRequest :: Request
mockRespond :: Respond
application :: application
..} = let
    ?modelContext = ?modelContext::ModelContext
ModelContext
modelContext
    ?request = ?request::Request
Request
mockRequest
    ?respond = ?respond::Respond
Respond
mockRespond
    ?application = application
?application::application
application
    ?mocking = ?mocking::MockContext application
MockContext application
mocking
  in do
    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
    let MockContext { FrameworkConfig
frameworkConfig :: forall application. MockContext application -> FrameworkConfig
frameworkConfig :: FrameworkConfig
frameworkConfig, ModelContext
modelContext :: forall application. MockContext application -> ModelContext
modelContext :: ModelContext
modelContext } = ?mocking::MockContext application
MockContext application
?mocking

    -- Build request with real form body (let middleware parse it)
    requestBody <- ByteString -> IO (IORef ByteString)
forall a. a -> IO (IORef a)
newIORef (Bool -> [Param] -> ByteString
HTTP.renderSimpleQuery Bool
False [Param]
params)
    let readBody = IORef ByteString -> (ByteString -> Param) -> IO ByteString
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef ByteString
requestBody (\ByteString
body -> (ByteString
"", ByteString
body))
    let baseRequest = ?request::Request
Request
?request
            { Wai.requestMethod = "POST"
            , Wai.requestBody = readBody
            , Wai.requestHeaders = (HTTP.hContentType, "application/x-www-form-urlencoded") : filter ((/= HTTP.hContentType) . fst) (Wai.requestHeaders ?request)
            }

    -- Capture the response
    responseRef <- newIORef Nothing
    let captureRespond Response
response = do
            IORef (Maybe Response) -> Maybe Response -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe Response)
responseRef (Response -> Maybe Response
forall a. a -> Maybe a
Just Response
response)
            ResponseReceived -> IO ResponseReceived
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResponseReceived
ResponseReceived

    -- Check if withUser set a mock session that we need to preserve
    let mockSession = Key (Session IO ByteString ByteString)
-> Vault -> Maybe (Session IO ByteString ByteString)
forall a. Key a -> Vault -> Maybe a
Vault.lookup Key (Session IO ByteString ByteString)
sessionVaultKey (Request -> Vault
Wai.vault ?request::Request
Request
?request)

    -- Create the controller app
    let controllerApp Request
req Respond
respond = do
            -- Restore mock session from withUser if it was set
            let req' :: Request
req' = case Maybe (Session IO ByteString ByteString)
mockSession of
                    Just Session IO ByteString ByteString
session -> Request
req { Wai.vault = Vault.insert sessionVaultKey session (Wai.vault req) }
                    Maybe (Session IO ByteString ByteString)
Nothing -> Request
req
            let ?request = ?request::Request
Request
req'
            let ?respond = ?respond::Respond
Respond
respond
            controller -> IO ResponseReceived
forall application controller.
(Controller controller, ?request::Request, ?respond::Respond,
 InitControllerContext application, ?application::application,
 Typeable application, Typeable controller) =>
controller -> IO ResponseReceived
runActionWithNewContext controller
controller

    -- Run through middleware stack (like the real server does)
    middlewareStack <- initMiddlewareStack frameworkConfig modelContext Nothing
    _ <- middlewareStack controllerApp baseRequest captureRespond

    readIORef responseRef >>= \case
        Just Response
response -> Response -> IO Response
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Response
response
        Maybe Response
Nothing -> Text -> IO Response
forall a. Text -> a
error Text
"callActionWithParams: No response was returned by the controller"

-- | 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 = ?request::Request
Request
?request.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
    content <- Builder -> IO (IORef Builder)
forall a. a -> IO (IORef a)
newIORef Builder
forall a. Monoid a => a
mempty
    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)) (return ())
    toLazyByteString <$> readIORef content

-- | Asserts that the response body contains the given text.
responseBodyShouldContain :: Response -> Text -> IO ()
responseBodyShouldContain :: Response -> Text -> IO ()
responseBodyShouldContain Response
response Text
includedText = do
    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
    body `shouldSatisfy` (includedText `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
    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
    body `shouldNotSatisfy` (includedText `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
    , ?request :: Request
    , ?respond :: Respond
    , Serialize.Serialize userId
    , HasField "id" user userId
    , KnownSymbol (GetModelName user)
    ) => user -> ((?request :: Request, ?respond :: Respond) => IO result) -> IO result
withUser :: forall user application userId result.
(?mocking::MockContext application, ?request::Request,
 ?respond::Respond, Serialize userId, HasField "id" user userId,
 KnownSymbol (GetModelName user)) =>
user
-> ((?request::Request, ?respond::Respond) => IO result)
-> IO result
withUser user
user (?request::Request, ?respond::Respond) => IO result
callback =
        let ?request = ?request::Request
Request
newRequest
        in IO result
(?request::Request, ?respond::Respond) => IO result
callback
    where
        newRequest :: Request
newRequest = Request
currentRequest { 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
currentRequest)
        currentRequest :: Request
currentRequest = ?request::Request
Request
?request

        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 a b. a -> (a -> b) -> b
|> Id' table -> Text
forall a. Show a => a -> Text
tshow
    Text -> (Text -> ByteString) -> ByteString
forall a b. a -> (a -> b) -> b
|> Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs