--------------------------------------------------------------------------------
-- | Module dealing with HTTP: request data types, encoding and decoding...
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings  #-}
module Network.WebSockets.Http
    ( Headers
    , RequestHead (..)
    , Request (..)
    , ResponseHead (..)
    , Response (..)
    , HandshakeException (..)

    , encodeRequestHead
    , encodeRequest
    , decodeRequestHead

    , encodeResponseHead
    , encodeResponse
    , decodeResponseHead
    , decodeResponse

    , response101
    , response400

    , getRequestHeader
    , getResponseHeader
    , getRequestSecWebSocketVersion
    , getRequestSubprotocols
    , getRequestSecWebSocketExtensions
    ) where


--------------------------------------------------------------------------------
import qualified Data.ByteString.Builder                   as Builder
import qualified Data.ByteString.Builder.Extra             as Builder
import           Control.Applicative                       (pure, (*>), (<$>),
                                                            (<*), (<*>))
import           Control.Exception                         (Exception)
import qualified Data.Attoparsec.ByteString                as A
import           Data.ByteString                           (ByteString)
import qualified Data.ByteString                           as B
import           Data.ByteString.Char8                     ()
import qualified Data.ByteString.Char8                     as BC
import           Data.ByteString.Internal                  (c2w)
import qualified Data.CaseInsensitive                      as CI
import           Data.Dynamic                              (Typeable)
import           Data.Monoid                               (mappend, mconcat)
import qualified Network.WebSockets.Extensions.Description as Extensions


--------------------------------------------------------------------------------
-- | Request headers
type Headers = [(CI.CI ByteString, ByteString)]


--------------------------------------------------------------------------------
-- | An HTTP request. The request body is not yet read.
data RequestHead = RequestHead
    { RequestHead -> ByteString
requestPath    :: !B.ByteString
    , RequestHead -> Headers
requestHeaders :: Headers
    , RequestHead -> Bool
requestSecure  :: Bool
    } deriving (Int -> RequestHead -> ShowS
[RequestHead] -> ShowS
RequestHead -> String
(Int -> RequestHead -> ShowS)
-> (RequestHead -> String)
-> ([RequestHead] -> ShowS)
-> Show RequestHead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestHead] -> ShowS
$cshowList :: [RequestHead] -> ShowS
show :: RequestHead -> String
$cshow :: RequestHead -> String
showsPrec :: Int -> RequestHead -> ShowS
$cshowsPrec :: Int -> RequestHead -> ShowS
Show)


--------------------------------------------------------------------------------
-- | A request with a body
data Request = Request RequestHead B.ByteString
    deriving (Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)


--------------------------------------------------------------------------------
-- | HTTP response, without body.
data ResponseHead = ResponseHead
    { ResponseHead -> Int
responseCode    :: !Int
    , ResponseHead -> ByteString
responseMessage :: !B.ByteString
    , ResponseHead -> Headers
responseHeaders :: Headers
    } deriving (Int -> ResponseHead -> ShowS
[ResponseHead] -> ShowS
ResponseHead -> String
(Int -> ResponseHead -> ShowS)
-> (ResponseHead -> String)
-> ([ResponseHead] -> ShowS)
-> Show ResponseHead
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseHead] -> ShowS
$cshowList :: [ResponseHead] -> ShowS
show :: ResponseHead -> String
$cshow :: ResponseHead -> String
showsPrec :: Int -> ResponseHead -> ShowS
$cshowsPrec :: Int -> ResponseHead -> ShowS
Show)


--------------------------------------------------------------------------------
-- | A response including a body
data Response = Response ResponseHead B.ByteString
    deriving (Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)


--------------------------------------------------------------------------------
-- | Error in case of failed handshake. Will be thrown as an 'Exception'.
--
-- TODO: This should probably be in the Handshake module, and is solely here to
-- prevent a cyclic dependency.
data HandshakeException
    -- | We don't have a match for the protocol requested by the client.
    -- todo: version parameter
    = NotSupported
    -- | The request was somehow invalid (missing headers or wrong security
    -- token)
    | MalformedRequest RequestHead String
    -- | The servers response was somehow invalid (missing headers or wrong
    -- security token)
    | MalformedResponse ResponseHead String
    -- | The request was well-formed, but the library user rejected it.
    -- (e.g. "unknown path")
    | RequestRejected Request String
    -- | for example "EOF came too early" (which is actually a parse error)
    -- or for your own errors. (like "unknown path"?)
    | OtherHandshakeException String
    deriving (Int -> HandshakeException -> ShowS
[HandshakeException] -> ShowS
HandshakeException -> String
(Int -> HandshakeException -> ShowS)
-> (HandshakeException -> String)
-> ([HandshakeException] -> ShowS)
-> Show HandshakeException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HandshakeException] -> ShowS
$cshowList :: [HandshakeException] -> ShowS
show :: HandshakeException -> String
$cshow :: HandshakeException -> String
showsPrec :: Int -> HandshakeException -> ShowS
$cshowsPrec :: Int -> HandshakeException -> ShowS
Show, Typeable)


--------------------------------------------------------------------------------
instance Exception HandshakeException


--------------------------------------------------------------------------------
encodeRequestHead :: RequestHead -> Builder.Builder
encodeRequestHead :: RequestHead -> Builder
encodeRequestHead (RequestHead ByteString
path Headers
headers Bool
_) =
    ByteString -> Builder
Builder.byteStringCopy ByteString
"GET "      Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    ByteString -> Builder
Builder.byteStringCopy ByteString
path        Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    ByteString -> Builder
Builder.byteStringCopy ByteString
" HTTP/1.1" Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    ByteString -> Builder
Builder.byteString ByteString
"\r\n"          Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (((CI ByteString, ByteString) -> Builder) -> Headers -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (CI ByteString, ByteString) -> Builder
header Headers
headers)       Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    ByteString -> Builder
Builder.byteStringCopy ByteString
"\r\n"
  where
    header :: (CI ByteString, ByteString) -> Builder
header (CI ByteString
k, ByteString
v) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (ByteString -> Builder) -> [ByteString] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Builder
Builder.byteStringCopy
        [CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
k, ByteString
": ", ByteString
v, ByteString
"\r\n"]


--------------------------------------------------------------------------------
encodeRequest :: Request -> Builder.Builder
encodeRequest :: Request -> Builder
encodeRequest (Request RequestHead
head' ByteString
body) =
    RequestHead -> Builder
encodeRequestHead RequestHead
head' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
Builder.byteStringCopy ByteString
body


--------------------------------------------------------------------------------
-- | Parse an initial request
decodeRequestHead :: Bool -> A.Parser RequestHead
decodeRequestHead :: Bool -> Parser RequestHead
decodeRequestHead Bool
isSecure = ByteString -> Headers -> Bool -> RequestHead
RequestHead
    (ByteString -> Headers -> Bool -> RequestHead)
-> Parser ByteString ByteString
-> Parser ByteString (Headers -> Bool -> RequestHead)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
requestLine
    Parser ByteString (Headers -> Bool -> RequestHead)
-> Parser ByteString Headers
-> Parser ByteString (Bool -> RequestHead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (CI ByteString, ByteString)
-> Parser ByteString ByteString -> Parser ByteString Headers
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
A.manyTill Parser ByteString (CI ByteString, ByteString)
decodeHeaderLine Parser ByteString ByteString
newline
    Parser ByteString (Bool -> RequestHead)
-> Parser ByteString Bool -> Parser RequestHead
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> Parser ByteString Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
isSecure
  where
    space :: Parser Word8
space   = Word8 -> Parser Word8
A.word8 (Char -> Word8
c2w Char
' ')
    newline :: Parser ByteString ByteString
newline = ByteString -> Parser ByteString ByteString
A.string ByteString
"\r\n"

    requestLine :: Parser ByteString ByteString
requestLine = ByteString -> Parser ByteString ByteString
A.string ByteString
"GET" Parser ByteString ByteString -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word8
space Parser Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
' ')
        Parser ByteString ByteString
-> Parser Word8 -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
space
        Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ByteString -> Parser ByteString ByteString
A.string ByteString
"HTTP/1.1" Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
newline


--------------------------------------------------------------------------------
-- | Encode an HTTP upgrade response
encodeResponseHead :: ResponseHead -> Builder.Builder
encodeResponseHead :: ResponseHead -> Builder
encodeResponseHead (ResponseHead Int
code ByteString
msg Headers
headers) =
    ByteString -> Builder
Builder.byteStringCopy ByteString
"HTTP/1.1 " Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    String -> Builder
Builder.stringUtf8 (Int -> String
forall a. Show a => a -> String
show Int
code)     Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    Char -> Builder
Builder.charUtf8 Char
' '               Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    ByteString -> Builder
Builder.byteString ByteString
msg             Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    ByteString -> Builder
Builder.byteString ByteString
"\r\n"          Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (((CI ByteString, ByteString) -> Builder) -> Headers -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (CI ByteString, ByteString) -> Builder
header Headers
headers)       Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend`
    ByteString -> Builder
Builder.byteStringCopy ByteString
"\r\n"
  where
    header :: (CI ByteString, ByteString) -> Builder
header (CI ByteString
k, ByteString
v) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ (ByteString -> Builder) -> [ByteString] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Builder
Builder.byteStringCopy
        [CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
k, ByteString
": ", ByteString
v, ByteString
"\r\n"]


--------------------------------------------------------------------------------
encodeResponse :: Response -> Builder.Builder
encodeResponse :: Response -> Builder
encodeResponse (Response ResponseHead
head' ByteString
body) =
    ResponseHead -> Builder
encodeResponseHead ResponseHead
head' Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` ByteString -> Builder
Builder.byteStringCopy ByteString
body


--------------------------------------------------------------------------------
-- | An upgrade response
response101 :: Headers -> B.ByteString -> Response
response101 :: Headers -> ByteString -> Response
response101 Headers
headers = ResponseHead -> ByteString -> Response
Response
    (Int -> ByteString -> Headers -> ResponseHead
ResponseHead Int
101 ByteString
"WebSocket Protocol Handshake"
        ((CI ByteString
"Upgrade", ByteString
"websocket") (CI ByteString, ByteString) -> Headers -> Headers
forall a. a -> [a] -> [a]
: (CI ByteString
"Connection", ByteString
"Upgrade") (CI ByteString, ByteString) -> Headers -> Headers
forall a. a -> [a] -> [a]
: Headers
headers))


--------------------------------------------------------------------------------
-- | Bad request
response400 :: Headers -> B.ByteString -> Response
response400 :: Headers -> ByteString -> Response
response400 Headers
headers = ResponseHead -> ByteString -> Response
Response (Int -> ByteString -> Headers -> ResponseHead
ResponseHead Int
400 ByteString
"Bad Request" Headers
headers)


--------------------------------------------------------------------------------
-- | HTTP response parser
decodeResponseHead :: A.Parser ResponseHead
decodeResponseHead :: Parser ResponseHead
decodeResponseHead = Int -> ByteString -> Headers -> ResponseHead
ResponseHead
    (Int -> ByteString -> Headers -> ResponseHead)
-> Parser ByteString Int
-> Parser ByteString (ByteString -> Headers -> ResponseHead)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Int)
-> Parser ByteString ByteString -> Parser ByteString Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (ByteString -> String) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BC.unpack) Parser ByteString ByteString
code
    Parser ByteString (ByteString -> Headers -> ResponseHead)
-> Parser ByteString ByteString
-> Parser ByteString (Headers -> ResponseHead)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
message
    Parser ByteString (Headers -> ResponseHead)
-> Parser ByteString Headers -> Parser ResponseHead
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (CI ByteString, ByteString)
-> Parser ByteString ByteString -> Parser ByteString Headers
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
A.manyTill Parser ByteString (CI ByteString, ByteString)
decodeHeaderLine Parser ByteString ByteString
newline
  where
    space :: Parser Word8
space = Word8 -> Parser Word8
A.word8 (Char -> Word8
c2w Char
' ')
    newline :: Parser ByteString ByteString
newline = ByteString -> Parser ByteString ByteString
A.string ByteString
"\r\n"

    code :: Parser ByteString ByteString
code    = ByteString -> Parser ByteString ByteString
A.string ByteString
"HTTP/1.1" Parser ByteString ByteString -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Word8
space Parser Word8
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 Word8 -> Bool
digit Parser ByteString ByteString
-> Parser Word8 -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Word8
space
    digit :: Word8 -> Bool
digit   = \Word8
x -> Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
'0' Bool -> Bool -> Bool
&& Word8
x Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Char -> Word8
c2w Char
'9'
    message :: Parser ByteString ByteString
message = (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'\r') Parser ByteString ByteString
-> Parser ByteString ByteString -> Parser ByteString ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ByteString
newline


--------------------------------------------------------------------------------
decodeResponse :: A.Parser Response
decodeResponse :: Parser Response
decodeResponse = ResponseHead -> ByteString -> Response
Response (ResponseHead -> ByteString -> Response)
-> Parser ResponseHead
-> Parser ByteString (ByteString -> Response)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ResponseHead
decodeResponseHead Parser ByteString (ByteString -> Response)
-> Parser ByteString ByteString -> Parser Response
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
A.takeByteString


--------------------------------------------------------------------------------
getRequestHeader :: RequestHead
                 -> CI.CI ByteString
                 -> Either HandshakeException ByteString
getRequestHeader :: RequestHead
-> CI ByteString -> Either HandshakeException ByteString
getRequestHeader RequestHead
rq CI ByteString
key = case CI ByteString -> Headers -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
key (RequestHead -> Headers
requestHeaders RequestHead
rq) of
    Just ByteString
t  -> ByteString -> Either HandshakeException ByteString
forall a b. b -> Either a b
Right ByteString
t
    Maybe ByteString
Nothing -> HandshakeException -> Either HandshakeException ByteString
forall a b. a -> Either a b
Left (HandshakeException -> Either HandshakeException ByteString)
-> HandshakeException -> Either HandshakeException ByteString
forall a b. (a -> b) -> a -> b
$ RequestHead -> String -> HandshakeException
MalformedRequest RequestHead
rq (String -> HandshakeException) -> String -> HandshakeException
forall a b. (a -> b) -> a -> b
$
        String
"Header missing: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
key)


--------------------------------------------------------------------------------
getResponseHeader :: ResponseHead
                  -> CI.CI ByteString
                  -> Either HandshakeException ByteString
getResponseHeader :: ResponseHead
-> CI ByteString -> Either HandshakeException ByteString
getResponseHeader ResponseHead
rsp CI ByteString
key = case CI ByteString -> Headers -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
key (ResponseHead -> Headers
responseHeaders ResponseHead
rsp) of
    Just ByteString
t  -> ByteString -> Either HandshakeException ByteString
forall a b. b -> Either a b
Right ByteString
t
    Maybe ByteString
Nothing -> HandshakeException -> Either HandshakeException ByteString
forall a b. a -> Either a b
Left (HandshakeException -> Either HandshakeException ByteString)
-> HandshakeException -> Either HandshakeException ByteString
forall a b. (a -> b) -> a -> b
$ ResponseHead -> String -> HandshakeException
MalformedResponse ResponseHead
rsp (String -> HandshakeException) -> String -> HandshakeException
forall a b. (a -> b) -> a -> b
$
        String
"Header missing: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> String
BC.unpack (CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
key)


--------------------------------------------------------------------------------
-- | Get the @Sec-WebSocket-Version@ header
getRequestSecWebSocketVersion :: RequestHead -> Maybe B.ByteString
getRequestSecWebSocketVersion :: RequestHead -> Maybe ByteString
getRequestSecWebSocketVersion RequestHead
p =
    CI ByteString -> Headers -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"Sec-WebSocket-Version" (RequestHead -> Headers
requestHeaders RequestHead
p)


--------------------------------------------------------------------------------
-- | List of subprotocols specified by the client, in order of preference.
-- If the client did not specify a list of subprotocols, this will be the
-- empty list.
getRequestSubprotocols :: RequestHead -> [B.ByteString]
getRequestSubprotocols :: RequestHead -> [ByteString]
getRequestSubprotocols RequestHead
rh = [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ByteString -> [ByteString]
parse Maybe ByteString
mproto
    where
        mproto :: Maybe ByteString
mproto = CI ByteString -> Headers -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"Sec-WebSocket-Protocol" (Headers -> Maybe ByteString) -> Headers -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ RequestHead -> Headers
requestHeaders RequestHead
rh
        parse :: ByteString -> [ByteString]
parse = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
B.null) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> [ByteString]
BC.splitWith (\Char
o -> Char
o Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',' Bool -> Bool -> Bool
|| Char
o Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')


--------------------------------------------------------------------------------
-- | Get the @Sec-WebSocket-Extensions@ header
getRequestSecWebSocketExtensions
    :: RequestHead -> Either HandshakeException Extensions.ExtensionDescriptions
getRequestSecWebSocketExtensions :: RequestHead -> Either HandshakeException ExtensionDescriptions
getRequestSecWebSocketExtensions RequestHead
rq =
    case CI ByteString -> Headers -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"Sec-WebSocket-Extensions" (RequestHead -> Headers
requestHeaders RequestHead
rq) of
        Maybe ByteString
Nothing -> ExtensionDescriptions
-> Either HandshakeException ExtensionDescriptions
forall a b. b -> Either a b
Right []
        Just ByteString
ext -> case ByteString -> Either String ExtensionDescriptions
Extensions.parseExtensionDescriptions ByteString
ext of
            Right ExtensionDescriptions
x  -> ExtensionDescriptions
-> Either HandshakeException ExtensionDescriptions
forall a b. b -> Either a b
Right ExtensionDescriptions
x
            Left String
err -> HandshakeException
-> Either HandshakeException ExtensionDescriptions
forall a b. a -> Either a b
Left (HandshakeException
 -> Either HandshakeException ExtensionDescriptions)
-> HandshakeException
-> Either HandshakeException ExtensionDescriptions
forall a b. (a -> b) -> a -> b
$ RequestHead -> String -> HandshakeException
MalformedRequest RequestHead
rq (String -> HandshakeException) -> String -> HandshakeException
forall a b. (a -> b) -> a -> b
$
                String
"Malformed Sec-WebSockets-Extensions: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
err


--------------------------------------------------------------------------------
decodeHeaderLine :: A.Parser (CI.CI ByteString, ByteString)
decodeHeaderLine :: Parser ByteString (CI ByteString, ByteString)
decodeHeaderLine = (,)
    (CI ByteString -> ByteString -> (CI ByteString, ByteString))
-> Parser ByteString (CI ByteString)
-> Parser ByteString (ByteString -> (CI ByteString, ByteString))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CI.mk (ByteString -> CI ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (CI ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile1 (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
':'))
    Parser ByteString (ByteString -> (CI ByteString, ByteString))
-> Parser Word8
-> Parser ByteString (ByteString -> (CI ByteString, ByteString))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Word8 -> Parser Word8
A.word8 (Char -> Word8
c2w Char
':')
    Parser ByteString (ByteString -> (CI ByteString, ByteString))
-> Parser Word8
-> Parser ByteString (ByteString -> (CI ByteString, ByteString))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  Word8 -> Parser Word8 -> Parser Word8
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option (Char -> Word8
c2w Char
' ') (Word8 -> Parser Word8
A.word8 (Char -> Word8
c2w Char
' '))
    Parser ByteString (ByteString -> (CI ByteString, ByteString))
-> Parser ByteString ByteString
-> Parser ByteString (CI ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word8 -> Bool) -> Parser ByteString ByteString
A.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Char -> Word8
c2w Char
'\r')
    Parser ByteString (CI ByteString, ByteString)
-> Parser ByteString ByteString
-> Parser ByteString (CI ByteString, ByteString)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*  ByteString -> Parser ByteString ByteString
A.string ByteString
"\r\n"