{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}

module Network.Wai.Application.Classic.Header where

import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS (tail,break)
import Network.HTTP.Types.Header
import Network.Wai

----------------------------------------------------------------

-- | Look-up key for If-Unmodified-Since:.
hIfUnmodifiedSince :: HeaderName
hIfUnmodifiedSince :: HeaderName
hIfUnmodifiedSince = HeaderName
"if-unmodified-since"

-- | Look-up key for Status.
hStatus :: HeaderName
hStatus :: HeaderName
hStatus = HeaderName
"status"

-- | Look-up key for X-Forwarded-For.
hXForwardedFor :: HeaderName
hXForwardedFor :: HeaderName
hXForwardedFor = HeaderName
"x-forwarded-for"

-- | Look-up key for Via.
hVia :: HeaderName
hVia :: HeaderName
hVia = HeaderName
"via"

-- | Lookup key for Transfer-Encoding.
hTransferEncoding :: HeaderName
hTransferEncoding :: HeaderName
hTransferEncoding = HeaderName
"transfer-encoding"

-- | Lookup key for Accept-Encoding.
hAcceptEncoding :: HeaderName
hAcceptEncoding :: HeaderName
hAcceptEncoding = HeaderName
"accept-encoding"

----------------------------------------------------------------

hostPort :: Request -> (ByteString, ByteString)
hostPort :: Request -> (ByteString, ByteString)
hostPort Request
req = case Request -> Maybe ByteString
requestHeaderHost Request
req of
    Maybe ByteString
Nothing -> (ByteString
"Unknown",ByteString
"80")
    Just ByteString
hostport -> case (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') ByteString
hostport of
        (ByteString
host,ByteString
"")   -> (ByteString
host,ByteString
"80")
        (ByteString
host,ByteString
port) -> (ByteString
host, HasCallStack => ByteString -> ByteString
ByteString -> ByteString
BS.tail ByteString
port)