{-# LANGUAGE OverloadedStrings #-}
module Network.DomainAuth.Mail.Mail (
lookupField,
fieldsFrom,
fieldsAfter,
fieldsWith,
fieldValueFolded,
fieldValueUnfolded,
fromBody,
fromBodyWith,
removeTrailingEmptyLine,
) where
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BL
import qualified Data.Foldable as F (foldr)
import Data.List
import Data.Maybe (catMaybes)
import Data.Sequence (Seq, ViewR (..), empty, viewr)
import Network.DomainAuth.Mail.Types
import Network.DomainAuth.Utils hiding (empty)
import qualified Network.DomainAuth.Utils as B (empty)
lookupField :: FieldKey -> Header -> Maybe Field
lookupField :: ByteString -> Header -> Maybe Field
lookupField ByteString
key Header
hdr = (Field -> Bool) -> Header -> Maybe Field
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (ByteString
ckey ByteString -> Field -> Bool
`isKeyOf`) Header
hdr
where
ckey :: ByteString
ckey = ByteString -> ByteString
canonicalizeKey ByteString
key
fieldsFrom :: FieldKey -> Header -> Header
fieldsFrom :: ByteString -> Header -> Header
fieldsFrom ByteString
key = (Field -> Bool) -> Header -> Header
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (ByteString
ckey ByteString -> Field -> Bool
`isNotKeyOf`)
where
ckey :: ByteString
ckey = ByteString -> ByteString
canonicalizeKey ByteString
key
fieldsAfter :: FieldKey -> Header -> Header
fieldsAfter :: ByteString -> Header -> Header
fieldsAfter ByteString
key = Header -> Header
forall {a}. [a] -> [a]
safeTail (Header -> Header) -> (Header -> Header) -> Header -> Header
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Header -> Header
fieldsFrom ByteString
key
where
safeTail :: [a] -> [a]
safeTail [] = []
safeTail [a]
xs = [a] -> [a]
forall a. HasCallStack => [a] -> [a]
tail [a]
xs
fieldsWith :: [CanonFieldKey] -> Header -> Header
fieldsWith :: [ByteString] -> Header -> Header
fieldsWith [ByteString]
kx Header
hx = [Maybe Field] -> Header
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Field] -> Header) -> [Maybe Field] -> Header
forall a b. (a -> b) -> a -> b
$ [ByteString]
-> Header -> (ByteString -> Field -> Bool) -> [Maybe Field]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]
enm [ByteString]
kx Header
hx (\ByteString
k Field
h -> ByteString
k ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Field -> ByteString
fieldSearchKey Field
h)
enm :: [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]
enm :: forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]
enm [] [b]
_ a -> b -> Bool
_ = []
enm [a]
_ [] a -> b -> Bool
_ = []
enm (a
k : [a]
kx) [b]
hs0 a -> b -> Bool
eq = case (b -> Bool) -> [b] -> Maybe (b, [b])
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
fnd (a -> b -> Bool
eq a
k) [b]
hs0 of
Maybe (b, [b])
Nothing -> Maybe b
forall a. Maybe a
Nothing Maybe b -> [Maybe b] -> [Maybe b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]
enm [a]
kx [b]
hs0 a -> b -> Bool
eq
Just (b
x, [b]
hs) -> b -> Maybe b
forall a. a -> Maybe a
Just b
x Maybe b -> [Maybe b] -> [Maybe b]
forall a. a -> [a] -> [a]
: [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]
forall a b. [a] -> [b] -> (a -> b -> Bool) -> [Maybe b]
enm [a]
kx [b]
hs a -> b -> Bool
eq
fnd :: (a -> Bool) -> [a] -> Maybe (a, [a])
fnd :: forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
fnd a -> Bool
_ [] = Maybe (a, [a])
forall a. Maybe a
Nothing
fnd a -> Bool
p (a
x : [a]
xs)
| a -> Bool
p a
x = (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
x, [a]
xs)
| Bool
otherwise = case (a -> Bool) -> [a] -> Maybe (a, [a])
forall a. (a -> Bool) -> [a] -> Maybe (a, [a])
fnd a -> Bool
p [a]
xs of
Maybe (a, [a])
Nothing -> Maybe (a, [a])
forall a. Maybe a
Nothing
Just (a
y, [a]
ys) -> (a, [a]) -> Maybe (a, [a])
forall a. a -> Maybe a
Just (a
y, a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
ys)
isKeyOf :: CanonFieldKey -> Field -> Bool
isKeyOf :: ByteString -> Field -> Bool
isKeyOf ByteString
key Field
fld = Field -> ByteString
fieldSearchKey Field
fld ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
key
isNotKeyOf :: CanonFieldKey -> Field -> Bool
isNotKeyOf :: ByteString -> Field -> Bool
isNotKeyOf ByteString
key Field
fld = Field -> ByteString
fieldSearchKey Field
fld ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
key
fieldValueFolded :: Field -> RawFieldValue
fieldValueFolded :: Field -> ByteString
fieldValueFolded = ByteString -> ByteString
BL.toStrict (ByteString -> ByteString)
-> (Field -> ByteString) -> Field -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BB.toLazyByteString (Builder -> ByteString)
-> (Field -> Builder) -> Field -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Builder
concatCRLF ([ByteString] -> Builder)
-> (Field -> [ByteString]) -> Field -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> [ByteString]
fieldValue
fieldValueUnfolded :: Field -> RawFieldValue
fieldValueUnfolded :: Field -> ByteString
fieldValueUnfolded = [ByteString] -> ByteString
BS8.concat ([ByteString] -> ByteString)
-> (Field -> [ByteString]) -> Field -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> [ByteString]
fieldValue
fromBody :: Body -> Builder
fromBody :: Body -> Builder
fromBody = (ByteString -> ByteString) -> Body -> Builder
fromBodyWith ByteString -> ByteString
forall a. a -> a
id
fromBodyWith :: (ByteString -> ByteString) -> Body -> Builder
fromBodyWith :: (ByteString -> ByteString) -> Body -> Builder
fromBodyWith ByteString -> ByteString
modify = (ByteString -> Builder -> Builder) -> Builder -> Body -> Builder
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr ((ByteString -> ByteString) -> ByteString -> Builder -> Builder
forall a. (a -> ByteString) -> a -> Builder -> Builder
appendCRLFWith ByteString -> ByteString
modify) Builder
forall a. Monoid a => a
B.empty
removeTrailingEmptyLine :: Body -> Body
removeTrailingEmptyLine :: Body -> Body
removeTrailingEmptyLine = (ByteString -> Bool) -> Body -> Body
forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"")
dropWhileR :: (a -> Bool) -> Seq a -> Seq a
dropWhileR :: forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR a -> Bool
p Seq a
xs = case Seq a -> ViewR a
forall a. Seq a -> ViewR a
viewr Seq a
xs of
ViewR a
EmptyR -> Seq a
forall a. Seq a
empty
Seq a
xs' :> a
x
| a -> Bool
p a
x -> (a -> Bool) -> Seq a -> Seq a
forall a. (a -> Bool) -> Seq a -> Seq a
dropWhileR a -> Bool
p Seq a
xs'
| Bool
otherwise -> Seq a
xs