module Network.Protocol.Http.Headers where
import Control.Category
import Control.Monad
import Data.Record.Label
import Network.Protocol.Http.Data
import Network.Protocol.Uri.Query
import Prelude hiding ((.), id)
import Safe
contentLength :: (Read i, Integral i) => Http a :-> Maybe i
contentLength = (join . fmap readMay <-> fmap show) `iso` header "Content-Length"
connection :: Http a :-> Maybe String
connection = header "Connection"
accept :: Http a :-> Maybe Parameters
accept = lmap (keyValues "," ";") `iso` header "Accept"
acceptEncoding :: Http a :-> Maybe [String]
acceptEncoding = lmap (values ",") `iso` header "Accept-Encoding"
acceptLanguage :: Http a :-> Maybe [String]
acceptLanguage = lmap (values ",") `iso` header "Accept-Language"
cacheControl :: Http a :-> Maybe String
cacheControl = header "Cache-Control"
keepAlive :: (Read i, Integral i) => Http a :-> Maybe i
keepAlive = (join . fmap readMay <-> fmap show) `iso` header "Keep-Alive"
cookie :: Http Request :-> Maybe String
cookie = header "Cookie"
setCookie :: Http Response :-> Maybe String
setCookie = header "Set-Cookie"
location :: Http a :-> Maybe String
location = header "Location"
contentType :: Http a :-> Maybe (String, Maybe String)
contentType =
(parser <-> fmap printer)
`iso` lmap (keyValues ";" "=")
`iso` header "Content-Type"
where
printer (x, y) = (x, Nothing) : maybe [] (\z -> [("charset", Just z)]) y
parser (Just ((m, Nothing):("charset", c):_)) = Just (m, c)
parser _ = Nothing
date :: Http a :-> Maybe String
date = header "Date"
hostname :: Http a :-> Maybe String
hostname = header "Host"
server :: Http a :-> Maybe String
server = header "Server"
userAgent :: Http a :-> Maybe String
userAgent = header "User-Agent"
upgrade :: Http a :-> Maybe String
upgrade = header "Upgrade"
lastModified :: Http a :-> Maybe Value
lastModified = header "Last-Modified"
acceptRanges :: Http a :-> Maybe Value
acceptRanges = header "Accept-Ranges"
eTag :: Http a :-> Maybe Value
eTag = header "ETag"