module Network.Salvia.Handler.Cookie where
import Control.Applicative hiding (empty)
import Control.Category
import Data.Record.Label
import Data.Time.Format
import Network.Protocol.Cookie
import Network.Salvia.Interface
import Network.Socket
import Prelude hiding ((.), id)
import System.Locale
import qualified Network.Protocol.Http as H
hSetCookie :: HttpM H.Response m => Cookies -> m ()
hSetCookie = response . setM H.setCookie . Just . show
hCookie :: (HttpM H.Request m) => m (Maybe Cookies)
hCookie = fmap (fw cookies) <$> request (getM H.cookie)
hDelCookie :: HttpM H.Response m => String -> m ()
hDelCookie nm = response (theCookie =: Just Nothing)
where theCookie = fmapL (pickCookie nm)
. fmapL (cookies `iso` id)
. H.setCookie
hNewCookie :: (ServerM m, ServerAddressM m, FormatTime t) => t -> Bool -> m Cookie
hNewCookie expire _ = do
sAddr <- serverAddress
return
. (path `set` Just "/")
. (port `set` [portNum sAddr])
. (expires `set` Just ("\"" ++ formatTime defaultTimeLocale "%a, %d %b %Y %H:%M:%S %Z" expire ++ "\""))
$ empty
where portNum (SockAddrInet p _) = fromIntegral p
portNum (SockAddrInet6 p _ _ _) = fromIntegral p
portNum _ = 1