{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE DataKinds #-} module Web.Apiary.Session ( Session , getSession, setSession, deleteSession , session, session' , Proxy(Proxy) ) where import Control.Monad(mzero) import Control.Monad.Apiary.Action(ActionT) import Control.Monad.Apiary.Filter(focus, Filter, Doc(DocPrecondition)) import Web.Apiary.Session.Internal (Session(Session), backendGet, backendSet, backendDelete) import Data.Apiary.Extension(Has, getExt) import Data.Proxy.Compat(Proxy(..)) import GHC.TypeLits.Compat(KnownSymbol) import qualified Network.Routing.Dict as Dict import qualified Network.Routing as R -- | get session provided type. getSession :: (Has (Session sess m) exts, Monad m) => proxy sess -> ActionT exts prms m (Maybe sess) getSession _ = do Session b <- getExt Proxy backendGet b -- | set session provided type. setSession :: (Has (Session sess m) exts, Monad m) => proxy sess -> sess -> ActionT exts prms m () setSession _ v = do Session b <- getExt Proxy backendSet b v -- | delete session provided type. deleteSession :: forall proxy exts prms m sess. (Has (Session sess m) exts, Monad m) => proxy sess -> ActionT exts prms m () deleteSession _ = do Session b <- getExt (Proxy :: Proxy (Session sess m)) backendDelete b -- | filter by has session or not. session' :: (Has (Session sess actM) exts, KnownSymbol key, Monad actM, key Dict. kProxy key -> sProxy sess -> Filter exts actM m kvs (key Dict.:= sess ': kvs) session' ky p = focus (DocPrecondition "session cookie required.") Nothing $ R.raw "session" $ \d t -> getSession p >>= \case Nothing -> mzero Just s -> return (Dict.add ky s d, t) -- | filter by has session or not. use \"session\" dict key. -- -- @ -- session = session' (Proxy :: Proxy "session") -- @ session :: (Has (Session sess actM) exts, Monad actM, "session" Dict. proxy sess -> Filter exts actM m kvs ("session" Dict.:= sess ': kvs) session = session' (Proxy :: Proxy "session")