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
type SpockAllM conn sess st a = SpockT (WebStateM conn sess st) a
type SpockActionCtx ctx conn sess st = ActionCtxT ctx (WebStateM conn sess st)
type SpockAction conn sess st = SpockActionCtx () conn sess st
data SpockCfg conn sess st
= SpockCfg
{ spc_initialState :: st
, spc_database :: PoolOrConn conn
, spc_sessionCfg :: SessionCfg conn sess st
, spc_maxRequestSize :: Maybe Word64
, spc_errorHandler :: Status -> ActionCtxT () IO ()
, spc_csrfProtection :: Bool
, spc_csrfHeaderName :: T.Text
, spc_csrfPostName :: T.Text
}
data PoolCfg
= PoolCfg
{ pc_stripes :: Int
, pc_resPerStripe :: Int
, pc_keepOpenTime :: NominalDiffTime
}
data ConnBuilder a
= ConnBuilder
{ cb_createConn :: IO a
, cb_destroyConn :: a -> IO ()
, cb_poolConfiguration :: PoolCfg
}
data PoolOrConn a where
PCPool :: Pool a -> PoolOrConn a
PCConn :: ConnBuilder a -> PoolOrConn a
PCNoDatabase :: PoolOrConn ()
data SessionCfg conn a st
= SessionCfg
{ sc_cookieName :: T.Text
, sc_sessionTTL :: NominalDiffTime
, sc_sessionIdEntropy :: Int
, sc_sessionExpandTTL :: Bool
, sc_emptySession :: a
, sc_store :: SessionStoreInstance (Session conn a st)
, sc_housekeepingInterval :: NominalDiffTime
, sc_hooks :: SessionHooks a
}
data SessionHooks a
= SessionHooks
{ sh_removed :: HM.HashMap SessionId a -> IO ()
}
data WebState conn sess st
= WebState
{ web_dbConn :: Pool conn
, web_sessionMgr :: SpockSessionManager conn sess st
, web_state :: st
, web_config :: SpockCfg conn sess st
}
class HasSpock m where
type SpockConn m :: *
type SpockState m :: *
type SpockSession m :: *
runQuery :: (SpockConn m -> IO a) -> m a
getState :: m (SpockState m)
getSessMgr :: m (SpockSessionManager (SpockConn m) (SpockSession m) (SpockState m))
getSpockCfg :: m (SpockCfg (SpockConn m) (SpockSession m) (SpockState m))
newtype WebStateT conn sess st m a
= WebStateT { runWebStateT :: ReaderT (WebState conn sess st) m a }
deriving ( Monad, Functor, Applicative, MonadIO
, MonadReader (WebState conn sess st)
, MonadTrans
)
instance MonadBase b m => MonadBase b (WebStateT conn sess st m) where
liftBase = liftBaseDefault
instance MonadTransControl (WebStateT conn sess st) where
type StT (WebStateT conn sess st) a = a
liftWith = defaultLiftWith WebStateT runWebStateT
restoreT = defaultRestoreT 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 = defaultRestoreM
liftBaseWith = defaultLiftBaseWith
type WebStateM conn sess st = WebStateT conn sess st (ResourceT IO)
type SessionId = T.Text
data Session conn sess st
= Session
{ sess_id :: !SessionId
, sess_csrfToken :: !T.Text
, sess_validUntil :: !UTCTime
, 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
{ ss_runTx :: forall a. tx a -> IO a
, ss_loadSession :: SessionId -> tx (Maybe sess)
, ss_deleteSession :: SessionId -> tx ()
, ss_storeSession :: sess -> tx ()
, ss_toList :: tx [sess]
, ss_filterSessions :: (sess -> Bool) -> tx ()
, ss_mapSessions :: (sess -> tx sess) -> tx ()
}
instance Show (Session conn sess st) where
show = show . sess_id
type SpockSessionManager conn sess st = SessionManager (SpockActionCtx () conn sess st) conn sess st
data SessionManager m conn sess st
= SessionManager
{ sm_getSessionId :: m SessionId
, sm_getCsrfToken :: m T.Text
, sm_regenerateSessionId :: m ()
, sm_readSession :: m sess
, sm_writeSession :: sess -> m ()
, sm_modifySession :: forall a. (sess -> (sess, a)) -> m a
, sm_mapSessions :: (forall n. Monad n => sess -> n sess) -> m ()
, sm_clearAllSessions :: MonadIO m => m ()
, sm_middleware :: Middleware
, sm_closeSessionManager :: IO ()
}