Cookie.hs

module Network.Salvia.Handlers.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)

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

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
    }