module Web.Spock.Auth
(
authSessCfg, AuthCfg (..)
, writeSessionData, readSessionData, modifySessionData
, VisitorSession, NoAccessReason (..)
, NoAccessHandler, LoadUserFun, CheckRightsFun, UserRights
, markAsLoggedIn
, markAsGuest
, userRoute
)
where
import Web.Spock
import Control.Applicative
import Data.Time.Clock
import qualified Network.HTTP.Types as Http
import qualified Data.Text as T
data AuthCfg sess
= AuthCfg
{ ac_sessionTTL :: NominalDiffTime
, ac_emptySession :: sess
}
type UserRights = T.Text
data NoAccessReason
= NotEnoughRights
| NotLoggedIn
| NotValidUser
deriving (Show, Eq, Read, Enum)
type NoAccessHandler conn sess userId st =
NoAccessReason -> SpockAction conn (VisitorSession sess userId) st ()
type LoadUserFun conn sess userId st user =
userId -> SpockAction conn (VisitorSession sess userId) st (Maybe user)
type CheckRightsFun conn sess userId st user =
user -> [UserRights] -> SpockAction conn (VisitorSession sess userId) st Bool
data SessionType userId
= GuestSession
| UserSession userId
deriving (Show, Eq)
data VisitorSession sess userId
= VisitorSession
{ vs_type :: SessionType userId
, vs_data :: sess
}
deriving (Show, Eq)
authSessCfg :: AuthCfg sess -> SessionCfg (VisitorSession sess userId)
authSessCfg authCfg =
SessionCfg
{ sc_cookieName = "spocksession"
, sc_sessionTTL = ac_sessionTTL authCfg
, sc_sessionIdEntropy = 42
, sc_emptySession = VisitorSession GuestSession (ac_emptySession authCfg)
}
markAsLoggedIn :: userId -> SpockAction conn (VisitorSession sess userId) st ()
markAsLoggedIn userId =
modifySession (\oldData -> oldData { vs_type = (UserSession userId) })
markAsGuest :: SpockAction conn (VisitorSession sess userId) st ()
markAsGuest =
modifySession (\oldData -> oldData { vs_type = GuestSession })
readSessionData :: SpockAction conn (VisitorSession sess userId) st sess
readSessionData =
vs_data <$> readSession
modifySessionData :: (sess -> sess) -> SpockAction conn (VisitorSession sess userId) st ()
modifySessionData f =
modifySession (\oldData -> oldData { vs_data = f (vs_data oldData) })
writeSessionData :: sess -> SpockAction conn (VisitorSession sess userId) st ()
writeSessionData v =
modifySessionData (const v)
userRoute :: NoAccessHandler conn sess userId st
-> LoadUserFun conn sess userId st user
-> CheckRightsFun conn sess userId st user
-> Http.StdMethod
-> [UserRights]
-> T.Text
-> (user -> SpockAction conn (VisitorSession sess userId) st ())
-> SpockM conn (VisitorSession sess userId) st ()
userRoute noAccessHandler loadUser checkRights reqTy requiredRights route action =
defRoute reqTy route $
do sessData <- readSession
case vs_type sessData of
GuestSession ->
noAccessHandler NotLoggedIn
UserSession userId ->
do mUser <- loadUser userId
case mUser of
Nothing ->
noAccessHandler NotValidUser
Just user ->
do isOk <- checkRights user requiredRights
if isOk
then action user
else noAccessHandler NotEnoughRights