{-# LANGUAGE OverloadedStrings #-}

module Cookie
  ( makeSimpleCookie
  , setCookie
  , setSimpleCookie
  , getCookie
  , getCookies
  , deleteCookie
  ) where

import Control.Monad ( liftM )

import qualified Data.Text as TS
import qualified Data.Text.Encoding as TS
import qualified Data.Text.Lazy.Encoding as TL

import qualified Data.Map as Map

import qualified Data.ByteString.Lazy as BSL

import Data.Time.Clock.POSIX ( posixSecondsToUTCTime )

import Blaze.ByteString.Builder ( toLazyByteString )

import Web.Scotty.Trans
import Web.Cookie

makeSimpleCookie :: TS.Text -> TS.Text -> SetCookie
makeSimpleCookie n v =
  def
    { setCookieName  = TS.encodeUtf8 n
    , setCookieValue = TS.encodeUtf8 v
    , setCookiePath = Just $ TS.encodeUtf8 "/"
    , setCookieSecure = True
    }

setCookie :: (Monad m, ScottyError e) => SetCookie -> ActionT e m ()
setCookie c = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie c)

setSimpleCookie :: (Monad m, ScottyError e) => TS.Text -> TS.Text -> ActionT e m ()
setSimpleCookie n v = setCookie $ makeSimpleCookie n v

getCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m (Maybe TS.Text)
getCookie c = liftM (Map.lookup c) getCookies

getCookies :: (Monad m, ScottyError e) => ActionT e m (Map.Map TS.Text TS.Text)
getCookies =
  liftM (Map.fromList . maybe [] parse) $ header "Cookie"
  where parse = parseCookiesText . BSL.toStrict . TL.encodeUtf8

deleteCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m ()
deleteCookie c = setCookie $ (makeSimpleCookie c "") { setCookieExpires = Just $ posixSecondsToUTCTime 0 }