{-# LANGUAGE OverloadedStrings #-}
module Network.DomainAuth.Utils where
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Builder
import qualified Data.ByteString.Char8 as BS (lines)
import Data.Word
crlf :: Builder
crlf :: Builder
crlf = ByteString -> Builder
byteString ByteString
"\r\n"
(+++) :: Monoid a => a -> a -> a
+++ :: forall a. Monoid a => a -> a -> a
(+++) = a -> a -> a
forall a. Monoid a => a -> a -> a
mappend
empty :: Monoid a => a
empty :: forall a. Monoid a => a
empty = a
forall a. Monoid a => a
mempty
(!!!) :: ByteString -> Int -> Word8
!!! :: ByteString -> Int -> Word8
(!!!) = HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
BS.index
appendCRLF :: Builder -> Builder -> Builder
appendCRLF :: Builder -> Builder -> Builder
appendCRLF Builder
x Builder
y = Builder
x Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
+++ Builder
crlf Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
+++ Builder
y
appendCRLF' :: ByteString -> Builder -> Builder
appendCRLF' :: ByteString -> Builder -> Builder
appendCRLF' = Builder -> Builder -> Builder
appendCRLF (Builder -> Builder -> Builder)
-> (ByteString -> Builder) -> ByteString -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteString
appendCRLFWith :: (a -> ByteString) -> a -> Builder -> Builder
appendCRLFWith :: forall a. (a -> ByteString) -> a -> Builder -> Builder
appendCRLFWith a -> ByteString
modify a
x Builder
y = ByteString -> Builder
byteString (a -> ByteString
modify a
x) Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
+++ Builder
crlf Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
+++ Builder
y
concatCRLF :: [ByteString] -> Builder
concatCRLF :: [ByteString] -> Builder
concatCRLF = (ByteString -> Builder -> Builder)
-> Builder -> [ByteString] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> Builder -> Builder
appendCRLF' Builder
forall a. Monoid a => a
empty
concatCRLFWith :: (a -> ByteString) -> [a] -> Builder
concatCRLFWith :: forall a. (a -> ByteString) -> [a] -> Builder
concatCRLFWith a -> ByteString
modify = (a -> Builder -> Builder) -> Builder -> [a] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((a -> ByteString) -> a -> Builder -> Builder
forall a. (a -> ByteString) -> a -> Builder -> Builder
appendCRLFWith a -> ByteString
modify) Builder
forall a. Monoid a => a
empty
reduceWSP :: Cook
reduceWSP :: Cook
reduceWSP ByteString
"" = ByteString
""
reduceWSP ByteString
bs
| Word8 -> Bool
isSpace (HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.head ByteString
bs) = Cook
inSP ByteString
bs
| Bool
otherwise = Cook
outSP ByteString
bs
inSP :: Cook
inSP :: Cook
inSP ByteString
"" = ByteString
""
inSP ByteString
bs = ByteString
" " ByteString -> Cook
forall a. Monoid a => a -> a -> a
+++ Cook
outSP ByteString
bs'
where
(ByteString
_, ByteString
bs') = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span Word8 -> Bool
isSpace ByteString
bs
outSP :: Cook
outSP :: Cook
outSP ByteString
"" = ByteString
""
outSP ByteString
bs = ByteString
nonSP ByteString -> Cook
forall a. Monoid a => a -> a -> a
+++ Cook
inSP ByteString
bs'
where
(ByteString
nonSP, ByteString
bs') = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break Word8 -> Bool
isSpace ByteString
bs
type FWSRemover = ByteString -> ByteString
removeFWS :: FWSRemover
removeFWS :: Cook
removeFWS = (Word8 -> Bool) -> Cook
BS.filter (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isSpace)
type Cook = ByteString -> ByteString
removeTrailingWSP :: Cook
removeTrailingWSP :: Cook
removeTrailingWSP ByteString
bs
| Bool
slowPath = Cook
BS.reverse Cook -> Cook -> Cook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Cook
BS.dropWhile Word8 -> Bool
isSpace Cook -> Cook -> Cook
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cook
BS.reverse Cook -> Cook
forall a b. (a -> b) -> a -> b
$ ByteString
bs
| Bool
otherwise = ByteString
bs
where
slowPath :: Bool
slowPath = ByteString -> Bool
hasTrailingWSP ByteString
bs
hasTrailingWSP :: ByteString -> Bool
hasTrailingWSP :: ByteString -> Bool
hasTrailingWSP ByteString
bs
| Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
False
| Bool
otherwise = Word8 -> Bool
isSpace Word8
lastChar
where
len :: Int
len = ByteString -> Int
BS.length ByteString
bs
lastChar :: Word8
lastChar = ByteString
bs ByteString -> Int -> Word8
!!! (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
chop :: ByteString -> ByteString
chop :: Cook
chop ByteString
"" = ByteString
""
chop ByteString
bs
| HasCallStack => ByteString -> Word8
ByteString -> Word8
BS.last ByteString
bs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
13 = HasCallStack => Cook
Cook
BS.init ByteString
bs
| Bool
otherwise = ByteString
bs
blines :: ByteString -> [ByteString]
blines :: ByteString -> [ByteString]
blines = Cook -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Cook
chop ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
BS.lines
break' :: Word8 -> ByteString -> (ByteString, ByteString)
break' :: Word8 -> ByteString -> (ByteString, ByteString)
break' Word8
c ByteString
bs = (ByteString
f, ByteString
s)
where
(ByteString
f, ByteString
s') = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
c) ByteString
bs
s :: ByteString
s =
if ByteString
s' ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
""
then ByteString
""
else HasCallStack => Cook
Cook
BS.tail ByteString
s'
isAlphaNum, isUpper, isLower, isDigit, isSpace :: Word8 -> Bool
isAlphaNum :: Word8 -> Bool
isAlphaNum Word8
c = Word8 -> Bool
isUpper Word8
c Bool -> Bool -> Bool
|| Word8 -> Bool
isLower Word8
c Bool -> Bool -> Bool
|| Word8 -> Bool
isDigit Word8
c
isDigit :: Word8 -> Bool
isDigit Word8
c = Word8
48 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
57
isUpper :: Word8 -> Bool
isUpper Word8
c = Word8
65 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
90
isLower :: Word8 -> Bool
isLower Word8
c = Word8
97 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
122
isSpace :: Word8 -> Bool
isSpace Word8
c = Word8
c Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8
cSP, Word8
cTB, Word8
cLF, Word8
cCR]
cCR, cLF, cSP, cTB :: Word8
cCR :: Word8
cCR = Word8
13
cLF :: Word8
cLF = Word8
10
cSP :: Word8
cSP = Word8
32
cTB :: Word8
cTB = Word8
9
cPlus, cSlash, cEqual, cSmallA, cA, cZero :: Word8
cPlus :: Word8
cPlus = Word8
43
cSlash :: Word8
cSlash = Word8
47
cEqual :: Word8
cEqual = Word8
61
cSmallA :: Word8
cSmallA = Word8
97
cA :: Word8
cA = Word8
65
cZero :: Word8
cZero = Word8
48
cColon, cSemiColon :: Word8
cColon :: Word8
cColon = Word8
58
cSemiColon :: Word8
cSemiColon = Word8
59