{-# 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

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

-- | Replaces multiple WPSs to a single SP.
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 -- xxx
    | 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 -- 13 == '\r'
    | Bool
otherwise = ByteString
bs

-- |
--
-- >>> blines "foo\r\n\r\nbar\r\nbaz"
-- ["foo","","bar","baz"]
-- >>> blines "foo\r\n"
-- ["foo"]
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