{-# 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
(+++) = forall a. Monoid a => a -> a -> a
mappend

empty :: Monoid a => a
empty :: forall a. Monoid a => a
empty = forall a. Monoid a => a
mempty

(!!!) :: ByteString -> Int -> Word8
!!! :: ByteString -> Int -> Word8
(!!!) = HasCallStack => ByteString -> Int -> Word8
BS.index

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

appendCRLF :: Builder -> Builder -> Builder
appendCRLF :: Builder -> Builder -> Builder
appendCRLF Builder
x Builder
y = Builder
x forall a. Monoid a => a -> a -> a
+++ Builder
crlf forall a. Monoid a => a -> a -> a
+++ Builder
y

appendCRLF' :: ByteString -> Builder -> Builder
appendCRLF' :: ByteString -> Builder -> Builder
appendCRLF' = Builder -> Builder -> Builder
appendCRLF 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) forall a. Monoid a => a -> a -> a
+++ Builder
crlf forall a. Monoid a => a -> a -> a
+++ Builder
y

concatCRLF :: [ByteString] -> Builder
concatCRLF :: [ByteString] -> Builder
concatCRLF = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> Builder -> Builder
appendCRLF' forall a. Monoid a => a
empty

concatCRLFWith :: (a -> ByteString) -> [a] -> Builder
concatCRLFWith :: forall a. (a -> ByteString) -> [a] -> Builder
concatCRLFWith a -> ByteString
modify = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (forall a. (a -> ByteString) -> a -> Builder -> Builder
appendCRLFWith a -> ByteString
modify) 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
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
" " 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 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
notforall 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool) -> Cook
BS.dropWhile Word8 -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cook
BS.reverse 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 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 forall a. Num a => a -> a -> a
- Int
1)

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

chop :: ByteString -> ByteString
chop :: Cook
chop ByteString
"" = ByteString
""
chop ByteString
bs
  | HasCallStack => ByteString -> Word8
BS.last ByteString
bs forall a. Eq a => a -> a -> Bool
== Word8
13 = HasCallStack => 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 = forall a b. (a -> b) -> [a] -> [b]
map Cook
chop 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 (forall a. Eq a => a -> a -> Bool
==Word8
c) ByteString
bs
    s :: ByteString
s = if ByteString
s' forall a. Eq a => a -> a -> Bool
== ByteString
""
        then ByteString
""
        else HasCallStack => 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 forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
57
isUpper :: Word8 -> Bool
isUpper Word8
c = Word8
65 forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
90
isLower :: Word8 -> Bool
isLower Word8
c = Word8
97 forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c forall a. Ord a => a -> a -> Bool
<= Word8
122
isSpace :: Word8 -> Bool
isSpace Word8
c = Word8
c 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