content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE ConstraintKinds #-}
  {-# LANGUAGE TypeOperators #-}
  {-# LANGUAGE TypeFamilies #-}
  
  module Web.Apiary.Cookie 
      ( -- * setter
        setCookie
      , deleteCookie
      -- * getter
      , getCookies
      -- * filter
      , cookie
      , cookie'
      -- * Reexport
      -- | SetCookie(..)
      , module Web.Cookie
      ) where
  
  import Control.Applicative((<$>))
  
  import Network.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.Compat(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
  {-# INLINE cond #-}
  
  -- | cookie filter. since 0.5.1.0.
  --
  -- can use like 'query' function.
  --
  -- example:
  --
  -- @
  -- cookie [key|foo|] (pFirst pInt)  -- get first Int parameter from foo.
  -- cookie [key|bar|] (pOption pDouble)  -- get first Double parameter from bar, allows no cookie.
  -- cookie [key|baz|] (pMany (pMaybe pString))  -- get zero or more baz cookies. allows cookie decrypt failure.
  -- cookie [key|baz|] (Proxy :: Proxy (LimitSome [int|100|] ByteString)) -- get raw cookies up to 100 entries.
  -- @
  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
  
  -- | delete cookie. since 0.6.1.0.
  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
      }
  
  -- | set raw cookie header.
  setCookie :: Monad m => SetCookie -> ActionT exts prms m ()
  setCookie =
      addHeader "set-cookie" . toByteString . Cookie.renderSetCookie
  