{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE ConstraintKinds #-}

module Web.Apiary.Cookie 
    ( 
    -- * setter
      setCookie
    , deleteCookie
    -- * filter
    , cookie
    , cookie'
    -- * Reexport
    -- | SetCookie(..)
    , module Web.Cookie
    ) where

import Web.Apiary.Wai
import Web.Apiary
import Web.Cookie (SetCookie(..))
import qualified Web.Cookie as Cookie

import Control.Monad.Apiary.Filter.Internal
import Control.Monad.Apiary.Filter.Internal.Strategy

import Data.Maybe
import Data.Time
import Data.Monoid
import Data.Apiary.Document
import Blaze.ByteString.Builder
import Text.Blaze.Html
import qualified Data.ByteString as S

cond :: (a -> Bool) -> (a -> b) -> (a -> b) -> a -> b
cond p t f a = if p a then t a else f a

-- | cookie filter. since 0.5.1.0.
--
-- can use like 'query' function.
--
-- example:
--
-- @
-- cookie "foo" (pFirst pInt)  -- get first Int parameter from foo.
-- cookie "bar" (pOption pDouble)  -- get first Double parameter from bar, allows no cookie.
-- cookie "baz" (pMany (pMaybe pString))  -- get zero or more baz cookies. allows cookie decrypt failure.
-- cookie "baz" (Proxy :: Proxy (LimitSome [int|100|] ByteString)) -- get raw cookies up to 100 entries.
-- @
cookie :: (Strategy w, Query p, Monad actM)
       => S.ByteString
       -> w p
       -> ApiaryT exts (SNext w prms p) actM m ()
       -> ApiaryT exts prms actM m ()
cookie k p = function (DocPrecondition $ toHtml (show k) <> " cookie required") $ \l r ->
    readStrategy (readQuery . Just) ((k ==) . fst) p (cookie' r) l

cookie' :: Request -> [(S.ByteString, S.ByteString)]
cookie' = 
    concatMap Cookie.parseCookies .
    mapMaybe (cond (("cookie" ==) . fst) (Just . snd) (const Nothing)) .
    requestHeaders

-- | delete cookie. since 0.6.1.0.
deleteCookie :: Monad m => S.ByteString -> ActionT exts m ()
deleteCookie k = setCookie def { setCookieName    = k 
                               , setCookieExpires = Just $ UTCTime (ModifiedJulianDay 0) 0
                               , setCookieMaxAge  = Just 0
                               }

-- | set raw cookie header.
setCookie :: Monad m => SetCookie -> ActionT exts m ()
setCookie =
    addHeader "set-cookie" . toByteString . Cookie.renderSetCookie