Cookie.hs

module Network.Salvia.Handler.Cookie (
    hSetCookies
  , hGetCookies

  , newCookie
  ) where

import Control.Applicative hiding (empty)
import Control.Monad.State
import Data.Record.Label
import Data.Time.Format
import Data.Time.LocalTime
import Network.Protocol.Cookie (showCookies, Cookie, Cookies, parseCookies, empty, path, port, expires)
import Network.Protocol.Http (cookie)
import Network.Salvia.Httpd
import System.Locale (defaultTimeLocale)

{- | Set the `cookie` HTTP response header (Set-Cookie) with the specified `Cookies`. -}

hSetCookies :: Cookies -> Handler ()
hSetCookies = setM (cookie % response) . showCookies

{- | Try to get the cookies from the HTTP `cookie` request header. -}

hGetCookies :: Handler (Maybe Cookies)
hGetCookies = parseCookies <$> getM (cookie % request)

{- |
Convenient method for creating cookies that expire in the near future and are
bound to the domain and port this server runs on. The path will be locked to
root.
-}

newCookie :: LocalTime -> Handler Cookie
newCookie expire = do
  httpd <- getM config
  return $ empty {
      path    = Just "/"
--  , domain  = Just $ '.' : hostname httpd
    , port    = [fromEnum $ listenPort httpd]
    , expires = Just $ formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" expire
    }