module Web.Apiary.Cookie.Internal where
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Maybe
import Web.Apiary
import Web.ClientSession
import Web.Cookie
import Blaze.ByteString.Builder
import qualified Data.ByteString as S
import Data.Default.Class
newtype Cookie = Cookie
{ key :: Key
}
newtype CookieConfig = CookieConfig
{ keyFile :: FilePath }
instance Default CookieConfig where
def = CookieConfig defaultKeyFile
type HasCookie = ?webApiaryCookieCookie :: Cookie
withCookie :: CookieConfig -> (HasCookie => IO b) -> IO b
withCookie conf f = do
k <- getKey $ keyFile conf
let ?webApiaryCookieCookie = Cookie k
f
setCookie :: (MonadIO m, HasCookie) => SetCookie -> ActionT m ()
setCookie sc = do
v' <- liftIO $ encryptIO (key ?webApiaryCookieCookie) (setCookieValue sc)
let s = toByteString . renderSetCookie $ sc { setCookieValue = v' }
addHeader "set-cookie" s
getCookies :: (Monad m, HasCookie) => ActionT m (Maybe [(S.ByteString, Maybe S.ByteString)])
getCookies = runMaybeT $ do
raw <- MaybeT $ getRequestHeader "cookie"
return $ map (\(k,v) -> (k, decrypt (key ?webApiaryCookieCookie) v)) $ parseCookies raw
getCookies' :: (Monad m, HasCookie) => ActionT m [(S.ByteString, Maybe S.ByteString)]
getCookies' = getCookies >>= maybe mzero return
getCookie :: (Monad m, HasCookie) => S.ByteString -> ActionT m (Maybe S.ByteString)
getCookie k = getCookies >>= return . maybe Nothing (join . lookup k)
getCookie' :: (Monad m, HasCookie) => S.ByteString -> ActionT m S.ByteString
getCookie' k = getCookie k >>= maybe mzero return