module Web.Spock.Types where
import Web.Scotty.Trans
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad.Base
import Control.Monad.Reader
import Control.Monad.Trans.Control
import Control.Monad.Trans.Resource
import Data.Hashable
import Data.Pool
import Data.Text.Lazy (Text)
import Data.Time.Clock ( UTCTime(..), NominalDiffTime )
import Data.Typeable
import Network.Wai
import qualified Data.Conduit.Pool as CP
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
type SpockError e = ScottyError e
type SpockM conn sess st a = ScottyT Text (WebStateM conn sess st) a
type SpockAction conn sess st a = ActionT Text (WebStateM conn sess st) a
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
= PCPool (Pool a)
| PCConduitPool (CP.Pool a)
| PCConn (ConnBuilder a)
data SessionCfg a
= SessionCfg
{ sc_cookieName :: T.Text
, sc_sessionTTL :: NominalDiffTime
, sc_sessionIdEntropy :: Int
, sc_emptySession :: a
}
data ConnectionPool conn
= DataPool (Pool conn)
| ConduitPool (CP.Pool conn)
data WebState conn sess st
= WebState
{ web_dbConn :: ConnectionPool conn
, web_sessionMgr :: SessionManager sess
, web_state :: st
}
class (Hashable a, Eq a, Typeable a) => SafeAction a where
runSafeAction :: a -> SpockAction conn sess st ()
data PackedSafeAction
= forall a. (SafeAction a) => PackedSafeAction { unpackSafeAction :: a }
instance Hashable PackedSafeAction where
hashWithSalt i (PackedSafeAction a) = hashWithSalt i a
instance Eq PackedSafeAction where
(PackedSafeAction a) == (PackedSafeAction b) =
cast a == Just b
data SafeActionStore
= SafeActionStore
{ sas_forward :: HM.HashMap SafeActionHash PackedSafeAction
, sas_reverse :: HM.HashMap PackedSafeAction SafeActionHash
}
type SafeActionHash = T.Text
newtype WebStateM conn sess st a = WebStateM { runWebStateM :: ReaderT (WebState conn sess st) (ResourceT IO) a }
deriving (Monad, Functor, Applicative, MonadIO, MonadReader (WebState conn sess st))
instance MonadBase IO (WebStateM conn sess st) where
liftBase = WebStateM . liftBase
instance MonadBaseControl IO (WebStateM conn sess st) where
newtype StM (WebStateM conn sess st) a = WStM { unWStM :: StM (ReaderT (WebState conn sess st) (ResourceT IO)) a }
liftBaseWith f = WebStateM . liftBaseWith $ \runInBase -> f $ liftM WStM . runInBase . runWebStateM
restoreM = WebStateM . restoreM . unWStM
type SessionId = T.Text
data Session a
= Session
{ sess_id :: SessionId
, sess_validUntil :: UTCTime
, sess_data :: a
, sess_safeActions :: SafeActionStore
}
type UserSessions a = TVar (HM.HashMap SessionId (Session a))
data SessionManager a
= SessionManager
{ sm_readSession :: (SpockError e, MonadIO m) => ActionT e m a
, sm_writeSession :: (SpockError e, MonadIO m) => a -> ActionT e m ()
, sm_modifySession :: (SpockError e, MonadIO m) => (a -> a) -> ActionT e m ()
, sm_middleware :: Middleware
, sm_addSafeAction :: (SpockError e, MonadIO m) => PackedSafeAction -> ActionT e m SafeActionHash
, sm_lookupSafeAction :: (SpockError e, MonadIO m) => SafeActionHash -> ActionT e m (Maybe PackedSafeAction)
}