Session.hs

{-# 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.</ kvs)
         => 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.</ kvs)
        => proxy sess
        -> Filter exts actM m kvs ("session" Dict.:= sess ': kvs)
session = session' (Proxy :: Proxy "session")