{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP.Forwarded
( Forwarded(..)
, parseForwarded
, serializeForwarded
) where
import Data.ByteString (ByteString)
import Data.CaseInsensitive (CI)
import Data.Maybe (catMaybes)
import Data.Monoid ((<>))
import Data.Word (Word8)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative ((<$>))
#endif
import qualified Data.ByteString as ByteString
import qualified Data.CaseInsensitive as CaseInsensitive
import qualified Data.Char as Char
data Forwarded = Forwarded
{ Forwarded -> Maybe ByteString
forwardedBy :: Maybe ByteString
, Forwarded -> Maybe ByteString
forwardedFor :: Maybe ByteString
, Forwarded -> Maybe ByteString
forwardedHost :: Maybe ByteString
, Forwarded -> Maybe (CI ByteString)
forwardedProto :: Maybe (CI ByteString)
} deriving (Forwarded -> Forwarded -> Bool
(Forwarded -> Forwarded -> Bool)
-> (Forwarded -> Forwarded -> Bool) -> Eq Forwarded
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Forwarded -> Forwarded -> Bool
$c/= :: Forwarded -> Forwarded -> Bool
== :: Forwarded -> Forwarded -> Bool
$c== :: Forwarded -> Forwarded -> Bool
Eq, Int -> Forwarded -> ShowS
[Forwarded] -> ShowS
Forwarded -> String
(Int -> Forwarded -> ShowS)
-> (Forwarded -> String)
-> ([Forwarded] -> ShowS)
-> Show Forwarded
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Forwarded] -> ShowS
$cshowList :: [Forwarded] -> ShowS
show :: Forwarded -> String
$cshow :: Forwarded -> String
showsPrec :: Int -> Forwarded -> ShowS
$cshowsPrec :: Int -> Forwarded -> ShowS
Show)
empty :: Forwarded
empty :: Forwarded
empty = Forwarded :: Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe (CI ByteString)
-> Forwarded
Forwarded
{ forwardedBy :: Maybe ByteString
forwardedBy = Maybe ByteString
forall a. Maybe a
Nothing
, forwardedFor :: Maybe ByteString
forwardedFor = Maybe ByteString
forall a. Maybe a
Nothing
, forwardedHost :: Maybe ByteString
forwardedHost = Maybe ByteString
forall a. Maybe a
Nothing
, forwardedProto :: Maybe (CI ByteString)
forwardedProto = Maybe (CI ByteString)
forall a. Maybe a
Nothing
}
parseForwarded :: ByteString -> Forwarded
parseForwarded :: ByteString -> Forwarded
parseForwarded = ((ByteString, ByteString) -> Forwarded -> Forwarded)
-> Forwarded -> [(ByteString, ByteString)] -> Forwarded
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ByteString, ByteString) -> Forwarded -> Forwarded
forall a.
(Eq a, IsString a) =>
(a, ByteString) -> Forwarded -> Forwarded
accumulate Forwarded
empty ([(ByteString, ByteString)] -> Forwarded)
-> (ByteString -> [(ByteString, ByteString)])
-> ByteString
-> Forwarded
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [(ByteString, ByteString)]
parseForwarded'
where
accumulate :: (a, ByteString) -> Forwarded -> Forwarded
accumulate (a
key, ByteString
val) Forwarded
acc =
case a
key of
a
"by" -> Forwarded
acc { forwardedBy :: Maybe ByteString
forwardedBy = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
val }
a
"for" -> Forwarded
acc { forwardedFor :: Maybe ByteString
forwardedFor = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
val }
a
"host" -> Forwarded
acc { forwardedHost :: Maybe ByteString
forwardedHost = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
val }
a
"proto" -> Forwarded
acc { forwardedProto :: Maybe (CI ByteString)
forwardedProto = CI ByteString -> Maybe (CI ByteString)
forall a. a -> Maybe a
Just (CI ByteString -> Maybe (CI ByteString))
-> CI ByteString -> Maybe (CI ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> CI ByteString
forall s. FoldCase s => s -> CI s
CaseInsensitive.mk ByteString
val }
a
_ -> Forwarded
acc
parseForwarded' :: ByteString -> [ (ByteString, ByteString) ]
parseForwarded' :: ByteString -> [(ByteString, ByteString)]
parseForwarded' ByteString
s
| ByteString -> Bool
ByteString.null ByteString
s = []
| Bool
otherwise =
let (ByteString
x, ByteString
y) = Word8 -> ByteString -> (ByteString, ByteString)
breakDiscard Word8
59 ByteString
s
in ByteString -> (ByteString, ByteString)
parsePart ByteString
x (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: ByteString -> [(ByteString, ByteString)]
parseForwarded' ByteString
y
parsePart :: ByteString -> (ByteString, ByteString)
parsePart :: ByteString -> (ByteString, ByteString)
parsePart ByteString
s = (ByteString
key', ByteString
value)
where
(ByteString
key, ByteString
value) =
Word8 -> ByteString -> (ByteString, ByteString)
breakDiscard Word8
61 ByteString
s
key' :: ByteString
key' =
(Word8 -> Bool) -> ByteString -> ByteString
ByteString.dropWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
32) ByteString
key
breakDiscard :: Word8 -> ByteString -> (ByteString, ByteString)
breakDiscard :: Word8 -> ByteString -> (ByteString, ByteString)
breakDiscard Word8
w ByteString
s = (ByteString
x, Int -> ByteString -> ByteString
ByteString.drop Int
1 ByteString
y)
where
(ByteString
x, ByteString
y) =
(Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
ByteString.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
w) ByteString
s
serializeForwarded :: Forwarded -> ByteString
serializeForwarded :: Forwarded -> ByteString
serializeForwarded Forwarded { Maybe ByteString
Maybe (CI ByteString)
forwardedProto :: Maybe (CI ByteString)
forwardedHost :: Maybe ByteString
forwardedFor :: Maybe ByteString
forwardedBy :: Maybe ByteString
forwardedProto :: Forwarded -> Maybe (CI ByteString)
forwardedHost :: Forwarded -> Maybe ByteString
forwardedFor :: Forwarded -> Maybe ByteString
forwardedBy :: Forwarded -> Maybe ByteString
.. } =
ByteString -> [ByteString] -> ByteString
ByteString.intercalate ByteString
"; " ([ByteString] -> ByteString) -> [ByteString] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Maybe ByteString] -> [ByteString]
forall a. [Maybe a] -> [a]
catMaybes [Maybe ByteString]
xs
where
xs :: [Maybe ByteString]
xs =
[ ByteString -> Maybe ByteString -> Maybe ByteString
forall a. (Semigroup a, IsString a) => a -> Maybe a -> Maybe a
strVal ByteString
"by" Maybe ByteString
forwardedBy
, ByteString -> Maybe ByteString -> Maybe ByteString
forall a. (Semigroup a, IsString a) => a -> Maybe a -> Maybe a
strVal ByteString
"for" Maybe ByteString
forwardedFor
, ByteString -> Maybe ByteString -> Maybe ByteString
forall a. (Semigroup a, IsString a) => a -> Maybe a -> Maybe a
strVal ByteString
"host" Maybe ByteString
forwardedHost
, ByteString -> Maybe ByteString -> Maybe ByteString
forall a. (Semigroup a, IsString a) => a -> Maybe a -> Maybe a
strVal ByteString
"proto" (Maybe ByteString -> Maybe ByteString)
-> Maybe ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CaseInsensitive.original (CI ByteString -> ByteString)
-> Maybe (CI ByteString) -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CI ByteString)
forwardedProto
]
strVal :: a -> Maybe a -> Maybe a
strVal a
_ Maybe a
Nothing = Maybe a
forall a. Maybe a
Nothing
strVal a
key (Just a
val) = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ a
key a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"=" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
val