{-# LANGUAGE CPP #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ConstraintKinds #-}
module Web.Spock.Internal.Types where

import Web.Spock.Core

#if MIN_VERSION_base(4,8,0)
#else
import Control.Applicative
#endif
import Control.Monad.Base
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Control.Monad.Trans.Resource
import Data.Pool
import Data.Time.Clock ( UTCTime(..), NominalDiffTime )
import Data.Word
import Network.HTTP.Types.Status
import Network.Wai
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T

-- | Inside the SpockAllM monad, you may define routes and middleware.
type SpockAllM conn sess st a = SpockT (WebStateM conn sess st) a

-- | The 'SpockActionCtx' is the monad of all route-actions. You have access
-- to the context of the request and database, session and state of your application.
type SpockActionCtx ctx conn sess st = ActionCtxT ctx (WebStateM conn sess st)

-- | The 'SpockAction' is a specialisation of 'SpockActionCtx' with a '()' context.
type SpockAction conn sess st = SpockActionCtx () conn sess st

-- | Spock configuration, use 'defaultSpockCfg' and change single values if needed
data SpockCfg conn sess st
   = SpockCfg
   { SpockCfg conn sess st -> st
spc_initialState :: st
     -- ^ initial application global state
   , SpockCfg conn sess st -> PoolOrConn conn
spc_database :: PoolOrConn conn
     -- ^ See 'PoolOrConn'
   , SpockCfg conn sess st -> SessionCfg conn sess st
spc_sessionCfg :: SessionCfg conn sess st
     -- ^ See 'SessionCfg'
   , SpockCfg conn sess st -> Maybe Word64
spc_maxRequestSize :: Maybe Word64
     -- ^ Maximum request size in bytes. 'Nothing' means no limit. Defaults to 5 MB in @defaultSpockCfg@.
   , SpockCfg conn sess st -> Status -> ActionCtxT () IO ()
spc_errorHandler :: Status -> ActionCtxT () IO ()
     -- ^ Custom error handlers for implicit errors such as not matching routes or
     -- exceptions during a request handler run.
   , SpockCfg conn sess st -> Text -> IO ()
spc_logError :: T.Text -> IO ()
     -- ^ Function that should be called to log errors.
   , SpockCfg conn sess st -> Bool
spc_csrfProtection :: Bool
     -- ^ When set to true, all non GET request will require
     -- either an HTTP-Header 'spc_csrfHeaderName' or a
     -- POST-Parameter 'spc_csrfPostName' to be set to the value aquired by 'getCsrfToken'
   , SpockCfg conn sess st -> Text
spc_csrfHeaderName :: T.Text
     -- ^ see 'spc_csrfHeaderName'
   , SpockCfg conn sess st -> Text
spc_csrfPostName :: T.Text
     -- ^ see 'spc_csrfPostName'
   }

-- | If Spock should take care of connection pooling, you need to configure
-- it depending on what you need.
data PoolCfg
   = PoolCfg
   { PoolCfg -> Int
pc_stripes :: Int
   , PoolCfg -> Int
pc_resPerStripe :: Int
   , PoolCfg -> NominalDiffTime
pc_keepOpenTime :: NominalDiffTime
   }

-- | The ConnBuilder instructs Spock how to create or close a database connection.
data ConnBuilder a
   = ConnBuilder
   { ConnBuilder a -> IO a
cb_createConn :: IO a
   , ConnBuilder a -> a -> IO ()
cb_destroyConn :: a -> IO ()
   , ConnBuilder a -> PoolCfg
cb_poolConfiguration :: PoolCfg
   }

-- | You can feed Spock with either a connection pool, or instructions on how to build
-- a connection pool. See 'ConnBuilder'
data PoolOrConn a where
    PCPool :: Pool a -> PoolOrConn a
    PCConn :: ConnBuilder a -> PoolOrConn a
    PCNoDatabase :: PoolOrConn ()

-- | Configuration for the session manager
data SessionCfg conn a st
   = SessionCfg
   { SessionCfg conn a st -> Text
sc_cookieName :: T.Text
     -- ^ name of the client side cookie
   , SessionCfg conn a st -> CookieEOL
sc_cookieEOL :: CookieEOL
     -- ^ how long the client side cookie should live
   , SessionCfg conn a st -> NominalDiffTime
sc_sessionTTL :: NominalDiffTime
     -- ^ how long shoud a client session live
   , SessionCfg conn a st -> Int
sc_sessionIdEntropy :: Int
     -- ^ entropy of the session id sent to the client
   , SessionCfg conn a st -> Bool
sc_sessionExpandTTL :: Bool
     -- ^ if this is true, every page reload will renew the session time to live counter
   , SessionCfg conn a st -> a
sc_emptySession :: a
     -- ^ initial session for visitors
   , SessionCfg conn a st -> SessionStoreInstance (Session conn a st)
sc_store :: SessionStoreInstance (Session conn a st)
     -- ^ storage interface for sessions
   , SessionCfg conn a st -> NominalDiffTime
sc_housekeepingInterval :: NominalDiffTime
     -- ^ how often should the session manager check for dangeling dead sessions
   , SessionCfg conn a st -> SessionHooks a
sc_hooks :: SessionHooks a
     -- ^ hooks into the session manager
   }

-- | Hook into the session manager to trigger custom behavior
data SessionHooks a
   = SessionHooks
   { SessionHooks a -> HashMap Text a -> IO ()
sh_removed :: HM.HashMap SessionId a -> IO ()
   }

data WebState conn sess st
   = WebState
   { WebState conn sess st -> Pool conn
web_dbConn :: Pool conn
   , WebState conn sess st -> SpockSessionManager conn sess st
web_sessionMgr :: SpockSessionManager conn sess st
   , WebState conn sess st -> st
web_state :: st
   , WebState conn sess st -> SpockCfg conn sess st
web_config :: SpockCfg conn sess st
   }

class HasSpock m where
    type SpockConn m :: *
    type SpockState m :: *
    type SpockSession m :: *
    -- | Give you access to a database connectin from the connection pool. The connection is
    -- released back to the pool once the function terminates.
    runQuery :: (SpockConn m -> IO a) -> m a
    -- | Read the application's state. If you wish to have mutable state, you could
    -- use a 'TVar' from the STM packge.
    getState :: m (SpockState m)
    -- | Get the session manager
    getSessMgr :: m (SpockSessionManager (SpockConn m) (SpockSession m) (SpockState m))
    -- | Get the Spock configuration
    getSpockCfg :: m (SpockCfg (SpockConn m) (SpockSession m) (SpockState m))

newtype WebStateT conn sess st m a
    = WebStateT { WebStateT conn sess st m a -> ReaderT (WebState conn sess st) m a
runWebStateT :: ReaderT (WebState conn sess st) m a }
    deriving ( Applicative (WebStateT conn sess st m)
a -> WebStateT conn sess st m a
Applicative (WebStateT conn sess st m)
-> (forall a b.
    WebStateT conn sess st m a
    -> (a -> WebStateT conn sess st m b) -> WebStateT conn sess st m b)
-> (forall a b.
    WebStateT conn sess st m a
    -> WebStateT conn sess st m b -> WebStateT conn sess st m b)
-> (forall a. a -> WebStateT conn sess st m a)
-> Monad (WebStateT conn sess st m)
WebStateT conn sess st m a
-> (a -> WebStateT conn sess st m b) -> WebStateT conn sess st m b
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
forall a. a -> WebStateT conn sess st m a
forall a b.
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
forall a b.
WebStateT conn sess st m a
-> (a -> WebStateT conn sess st m b) -> WebStateT conn sess st m b
forall conn sess st (m :: * -> *).
Monad m =>
Applicative (WebStateT conn sess st m)
forall conn sess st (m :: * -> *) a.
Monad m =>
a -> WebStateT conn sess st m a
forall conn sess st (m :: * -> *) a b.
Monad m =>
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
forall conn sess st (m :: * -> *) a b.
Monad m =>
WebStateT conn sess st m a
-> (a -> WebStateT conn sess st m b) -> WebStateT conn sess st m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> WebStateT conn sess st m a
$creturn :: forall conn sess st (m :: * -> *) a.
Monad m =>
a -> WebStateT conn sess st m a
>> :: WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
$c>> :: forall conn sess st (m :: * -> *) a b.
Monad m =>
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
>>= :: WebStateT conn sess st m a
-> (a -> WebStateT conn sess st m b) -> WebStateT conn sess st m b
$c>>= :: forall conn sess st (m :: * -> *) a b.
Monad m =>
WebStateT conn sess st m a
-> (a -> WebStateT conn sess st m b) -> WebStateT conn sess st m b
$cp1Monad :: forall conn sess st (m :: * -> *).
Monad m =>
Applicative (WebStateT conn sess st m)
Monad, a -> WebStateT conn sess st m b -> WebStateT conn sess st m a
(a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
(forall a b.
 (a -> b)
 -> WebStateT conn sess st m a -> WebStateT conn sess st m b)
-> (forall a b.
    a -> WebStateT conn sess st m b -> WebStateT conn sess st m a)
-> Functor (WebStateT conn sess st m)
forall a b.
a -> WebStateT conn sess st m b -> WebStateT conn sess st m a
forall a b.
(a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
forall conn sess st (m :: * -> *) a b.
Functor m =>
a -> WebStateT conn sess st m b -> WebStateT conn sess st m a
forall conn sess st (m :: * -> *) a b.
Functor m =>
(a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WebStateT conn sess st m b -> WebStateT conn sess st m a
$c<$ :: forall conn sess st (m :: * -> *) a b.
Functor m =>
a -> WebStateT conn sess st m b -> WebStateT conn sess st m a
fmap :: (a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
$cfmap :: forall conn sess st (m :: * -> *) a b.
Functor m =>
(a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
Functor, Functor (WebStateT conn sess st m)
a -> WebStateT conn sess st m a
Functor (WebStateT conn sess st m)
-> (forall a. a -> WebStateT conn sess st m a)
-> (forall a b.
    WebStateT conn sess st m (a -> b)
    -> WebStateT conn sess st m a -> WebStateT conn sess st m b)
-> (forall a b c.
    (a -> b -> c)
    -> WebStateT conn sess st m a
    -> WebStateT conn sess st m b
    -> WebStateT conn sess st m c)
-> (forall a b.
    WebStateT conn sess st m a
    -> WebStateT conn sess st m b -> WebStateT conn sess st m b)
-> (forall a b.
    WebStateT conn sess st m a
    -> WebStateT conn sess st m b -> WebStateT conn sess st m a)
-> Applicative (WebStateT conn sess st m)
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m a
WebStateT conn sess st m (a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
(a -> b -> c)
-> WebStateT conn sess st m a
-> WebStateT conn sess st m b
-> WebStateT conn sess st m c
forall a. a -> WebStateT conn sess st m a
forall a b.
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m a
forall a b.
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
forall a b.
WebStateT conn sess st m (a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
forall a b c.
(a -> b -> c)
-> WebStateT conn sess st m a
-> WebStateT conn sess st m b
-> WebStateT conn sess st m c
forall conn sess st (m :: * -> *).
Applicative m =>
Functor (WebStateT conn sess st m)
forall conn sess st (m :: * -> *) a.
Applicative m =>
a -> WebStateT conn sess st m a
forall conn sess st (m :: * -> *) a b.
Applicative m =>
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m a
forall conn sess st (m :: * -> *) a b.
Applicative m =>
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
forall conn sess st (m :: * -> *) a b.
Applicative m =>
WebStateT conn sess st m (a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
forall conn sess st (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WebStateT conn sess st m a
-> WebStateT conn sess st m b
-> WebStateT conn sess st m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m a
$c<* :: forall conn sess st (m :: * -> *) a b.
Applicative m =>
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m a
*> :: WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
$c*> :: forall conn sess st (m :: * -> *) a b.
Applicative m =>
WebStateT conn sess st m a
-> WebStateT conn sess st m b -> WebStateT conn sess st m b
liftA2 :: (a -> b -> c)
-> WebStateT conn sess st m a
-> WebStateT conn sess st m b
-> WebStateT conn sess st m c
$cliftA2 :: forall conn sess st (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WebStateT conn sess st m a
-> WebStateT conn sess st m b
-> WebStateT conn sess st m c
<*> :: WebStateT conn sess st m (a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
$c<*> :: forall conn sess st (m :: * -> *) a b.
Applicative m =>
WebStateT conn sess st m (a -> b)
-> WebStateT conn sess st m a -> WebStateT conn sess st m b
pure :: a -> WebStateT conn sess st m a
$cpure :: forall conn sess st (m :: * -> *) a.
Applicative m =>
a -> WebStateT conn sess st m a
$cp1Applicative :: forall conn sess st (m :: * -> *).
Applicative m =>
Functor (WebStateT conn sess st m)
Applicative, Monad (WebStateT conn sess st m)
Monad (WebStateT conn sess st m)
-> (forall a. IO a -> WebStateT conn sess st m a)
-> MonadIO (WebStateT conn sess st m)
IO a -> WebStateT conn sess st m a
forall a. IO a -> WebStateT conn sess st m a
forall conn sess st (m :: * -> *).
MonadIO m =>
Monad (WebStateT conn sess st m)
forall conn sess st (m :: * -> *) a.
MonadIO m =>
IO a -> WebStateT conn sess st m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> WebStateT conn sess st m a
$cliftIO :: forall conn sess st (m :: * -> *) a.
MonadIO m =>
IO a -> WebStateT conn sess st m a
$cp1MonadIO :: forall conn sess st (m :: * -> *).
MonadIO m =>
Monad (WebStateT conn sess st m)
MonadIO
             , MonadReader (WebState conn sess st)
             , m a -> WebStateT conn sess st m a
(forall (m :: * -> *) a.
 Monad m =>
 m a -> WebStateT conn sess st m a)
-> MonadTrans (WebStateT conn sess st)
forall conn sess st (m :: * -> *) a.
Monad m =>
m a -> WebStateT conn sess st m a
forall (m :: * -> *) a.
Monad m =>
m a -> WebStateT conn sess st m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> WebStateT conn sess st m a
$clift :: forall conn sess st (m :: * -> *) a.
Monad m =>
m a -> WebStateT conn sess st m a
MonadTrans
             )

instance MonadBase b m => MonadBase b (WebStateT conn sess st m) where
    liftBase :: b α -> WebStateT conn sess st m α
liftBase = b α -> WebStateT conn sess st m α
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) α.
(MonadTrans t, MonadBase b m) =>
b α -> t m α
liftBaseDefault

instance MonadTransControl (WebStateT conn sess st) where
    type StT (WebStateT conn sess st) a = a
    liftWith :: (Run (WebStateT conn sess st) -> m a) -> WebStateT conn sess st m a
liftWith = (forall b.
 ReaderT (WebState conn sess st) m b -> WebStateT conn sess st m b)
-> (forall (o :: * -> *) b.
    WebStateT conn sess st o b -> ReaderT (WebState conn sess st) o b)
-> (RunDefault
      (WebStateT conn sess st) (ReaderT (WebState conn sess st))
    -> m a)
-> WebStateT conn sess st m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *)
       (t :: (* -> *) -> * -> *) a.
(Monad m, MonadTransControl n) =>
(forall b. n m b -> t m b)
-> (forall (o :: * -> *) b. t o b -> n o b)
-> (RunDefault t n -> m a)
-> t m a
defaultLiftWith forall b.
ReaderT (WebState conn sess st) m b -> WebStateT conn sess st m b
forall conn sess st (m :: * -> *) a.
ReaderT (WebState conn sess st) m a -> WebStateT conn sess st m a
WebStateT forall conn sess st (m :: * -> *) a.
WebStateT conn sess st m a -> ReaderT (WebState conn sess st) m a
forall (o :: * -> *) b.
WebStateT conn sess st o b -> ReaderT (WebState conn sess st) o b
runWebStateT
    restoreT :: m (StT (WebStateT conn sess st) a) -> WebStateT conn sess st m a
restoreT = (ReaderT (WebState conn sess st) m a -> WebStateT conn sess st m a)
-> m (StT (ReaderT (WebState conn sess st)) a)
-> WebStateT conn sess st m a
forall (m :: * -> *) (n :: (* -> *) -> * -> *) a
       (t :: (* -> *) -> * -> *).
(Monad m, MonadTransControl n) =>
(n m a -> t m a) -> m (StT n a) -> t m a
defaultRestoreT ReaderT (WebState conn sess st) m a -> WebStateT conn sess st m a
forall conn sess st (m :: * -> *) a.
ReaderT (WebState conn sess st) m a -> WebStateT conn sess st m a
WebStateT

instance MonadBaseControl b m => MonadBaseControl b (WebStateT conn sess st m) where
    type StM (WebStateT conn sess st m) a = ComposeSt (WebStateT conn sess st) m a
    restoreM :: StM (WebStateT conn sess st m) a -> WebStateT conn sess st m a
restoreM = StM (WebStateT conn sess st m) a -> WebStateT conn sess st m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
    liftBaseWith :: (RunInBase (WebStateT conn sess st m) b -> b a)
-> WebStateT conn sess st m a
liftBaseWith = (RunInBase (WebStateT conn sess st m) b -> b a)
-> WebStateT conn sess st m a
forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith

type WebStateM conn sess st = WebStateT conn sess st (ResourceT IO)

type SessionId = T.Text
data Session conn sess st
    = Session
    { Session conn sess st -> Text
sess_id :: !SessionId
    , Session conn sess st -> Text
sess_csrfToken :: !T.Text
    , Session conn sess st -> UTCTime
sess_validUntil :: !UTCTime
    , Session conn sess st -> sess
sess_data :: !sess
    }

data SessionStoreInstance sess where
    SessionStoreInstance :: forall sess tx. (Monad tx, Functor tx, Applicative tx) => SessionStore sess tx -> SessionStoreInstance sess

data SessionStore sess tx
   = SessionStore
   { SessionStore sess tx -> forall a. tx a -> IO a
ss_runTx :: forall a. tx a -> IO a
   , SessionStore sess tx -> Text -> tx (Maybe sess)
ss_loadSession :: SessionId -> tx (Maybe sess)
   , SessionStore sess tx -> Text -> tx ()
ss_deleteSession :: SessionId -> tx ()
   , SessionStore sess tx -> sess -> tx ()
ss_storeSession :: sess -> tx ()
   , SessionStore sess tx -> tx [sess]
ss_toList :: tx [sess]
   , SessionStore sess tx -> (sess -> Bool) -> tx ()
ss_filterSessions :: (sess -> Bool) -> tx ()
   , SessionStore sess tx -> (sess -> tx sess) -> tx ()
ss_mapSessions :: (sess -> tx sess) -> tx ()
   }

instance Show (Session conn sess st) where
    show :: Session conn sess st -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String)
-> (Session conn sess st -> Text) -> Session conn sess st -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Session conn sess st -> Text
forall conn sess st. Session conn sess st -> Text
sess_id

type SpockSessionManager conn sess st = SessionManager (SpockActionCtx () conn sess st) conn sess st

data SessionManager m conn sess st
   = SessionManager
   { SessionManager m conn sess st -> m Text
sm_getSessionId :: m SessionId
   , SessionManager m conn sess st -> m Text
sm_getCsrfToken :: m T.Text
   , SessionManager m conn sess st -> m ()
sm_regenerateSessionId :: m ()
   , SessionManager m conn sess st -> m sess
sm_readSession :: m sess
   , SessionManager m conn sess st -> sess -> m ()
sm_writeSession :: sess -> m ()
   , SessionManager m conn sess st
-> forall a. (sess -> (sess, a)) -> m a
sm_modifySession :: forall a. (sess -> (sess, a)) -> m a
   , SessionManager m conn sess st
-> (forall (n :: * -> *). Monad n => sess -> n sess) -> m ()
sm_mapSessions :: (forall n. Monad n => sess -> n sess) -> m ()
   , SessionManager m conn sess st -> MonadIO m => m ()
sm_clearAllSessions :: MonadIO m => m ()
   , SessionManager m conn sess st -> Middleware
sm_middleware :: Middleware
   , SessionManager m conn sess st -> IO ()
sm_closeSessionManager :: IO ()
   }