module Network.DomainAuth.Mail.Mail where
import Blaze.ByteString.Builder
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.Foldable as F (foldr)
import Data.List
import Data.Sequence (Seq, viewr, ViewR(..), empty)
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 key hdr = find (ckey `isKeyOf`) hdr
where
ckey = canonicalizeKey key
fieldsFrom :: FieldKey -> Header -> Header
fieldsFrom key = dropWhile (ckey `isNotKeyOf`)
where
ckey = canonicalizeKey key
fieldsAfter :: FieldKey -> Header -> Header
fieldsAfter key = safeTail . fieldsFrom key
where
safeTail [] = []
safeTail xs = tail xs
fieldsWith :: [CanonFieldKey] -> Header -> Header
fieldsWith [] _ = []
fieldsWith _ [] = []
fieldsWith (k:ks) is
| fs == [] = fieldsWith (k:ks) (tail is')
| otherwise = take len (reverse fs) ++ fieldsWith ks' is'
where
(fs,is') = span (\fld -> fieldSearchKey fld == k) is
(kx,ks') = span (==k) ks
len = length kx + 1
isKeyOf :: CanonFieldKey -> Field -> Bool
isKeyOf key fld = fieldSearchKey fld == key
isNotKeyOf :: CanonFieldKey -> Field -> Bool
isNotKeyOf key fld = fieldSearchKey fld /= key
fieldValueFolded :: Field -> RawFieldValue
fieldValueFolded = toByteString . concatCRLF . fieldValue
fieldValueUnfolded :: Field -> RawFieldValue
fieldValueUnfolded = BS.concat . fieldValue
fromBody :: Body -> Builder
fromBody = fromBodyWith id
fromBodyWith :: (ByteString -> ByteString) -> Body -> Builder
fromBodyWith modify = F.foldr (appendCRLFWith modify) B.empty
removeTrailingEmptyLine :: Body -> Body
removeTrailingEmptyLine = dropWhileR (=="")
dropWhileR :: (a -> Bool) -> Seq a -> Seq a
dropWhileR p xs = case viewr xs of
EmptyR -> empty
xs' :> x
| p x -> dropWhileR p xs'
| otherwise -> xs