module Web.Apiary.Cookie
(
setCookie
, deleteCookie
, getCookies
, cookie
, cookie'
, module Web.Cookie
) where
import Control.Applicative((<$>))
import Data.Apiary.Routing.Dict(type (</))
import qualified Network.Wai as Wai
import Web.Cookie (SetCookie(..))
import qualified Web.Cookie as Cookie
import Control.Monad.Apiary.Action(ActionT, getHeaders, addHeader)
import Control.Monad.Apiary.Filter
import GHC.TypeLits(KnownSymbol, symbolVal)
import Data.Apiary.Param(Strategy(..))
import Data.Maybe(mapMaybe)
import Data.Time(UTCTime(UTCTime), Day(ModifiedJulianDay))
import Data.Monoid((<>))
import Blaze.ByteString.Builder(toByteString)
import Text.Blaze.Html(toHtml)
import qualified Data.ByteString as S
import qualified Data.ByteString.Char8 as SC
cond :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
cond p t f a = if p a then t a else f a
cookie :: (Strategy w, Monad actM, k </ prms, KnownSymbol k)
=> proxy k
-> w S.ByteString
-> Filter exts actM m prms (SNext w k S.ByteString prms)
cookie k p = function (DocPrecondition $ toHtml (symbolVal k) <> " cookie required") $ \l r ->
strategy p k (map (Just . snd) . filter ((SC.pack (symbolVal k) ==) . fst) $ cookie' r) l
cookie' :: Wai.Request -> [(S.ByteString, S.ByteString)]
cookie' =
concatMap Cookie.parseCookies .
mapMaybe (cond (("cookie" ==) . fst) (Just . snd) (const Nothing)) .
Wai.requestHeaders
getCookies :: Monad m => ActionT exts prms m [(S.ByteString, S.ByteString)]
getCookies =
concatMap (Cookie.parseCookies . snd) .
filter (("cookie" ==) . fst) <$>
getHeaders
deleteCookie :: Monad m => S.ByteString -> ActionT exts prms m ()
deleteCookie k = setCookie Cookie.def
{ setCookieName = k
, setCookieExpires = Just $ UTCTime (ModifiedJulianDay 0) 0
, setCookieMaxAge = Just 0
}
setCookie :: Monad m => SetCookie -> ActionT exts prms m ()
setCookie =
addHeader "set-cookie" . toByteString . Cookie.renderSetCookie