{-# LANGUAGE OverloadedStrings #-}
module Network.DomainAuth.DKIM.Parser (
parseDKIM,
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Maybe
import Network.DomainAuth.DKIM.Types
import Network.DomainAuth.Mail
parseDKIM :: RawFieldValue -> Maybe DKIM
parseDKIM :: ByteString -> Maybe DKIM
parseDKIM ByteString
val = MDKIM -> Maybe DKIM
toDKIM MDKIM
domkey
where
([ByteString]
ts, [ByteString]
vs) = [(ByteString, ByteString)] -> ([ByteString], [ByteString])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(ByteString, ByteString)] -> ([ByteString], [ByteString]))
-> [(ByteString, ByteString)] -> ([ByteString], [ByteString])
forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, ByteString)]
parseTaggedValue ByteString
val
fs :: [ByteString -> MDKIM -> MDKIM]
fs = (ByteString -> ByteString -> MDKIM -> MDKIM)
-> [ByteString] -> [ByteString -> MDKIM -> MDKIM]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString -> MDKIM -> MDKIM
tagToSetter [ByteString]
ts
tagToSetter :: ByteString -> ByteString -> MDKIM -> MDKIM
tagToSetter ByteString
tag = (ByteString -> MDKIM -> MDKIM)
-> Maybe (ByteString -> MDKIM -> MDKIM)
-> ByteString
-> MDKIM
-> MDKIM
forall a. a -> Maybe a -> a
fromMaybe (\ByteString
_ MDKIM
mdkim -> MDKIM
mdkim) (Maybe (ByteString -> MDKIM -> MDKIM)
-> ByteString -> MDKIM -> MDKIM)
-> Maybe (ByteString -> MDKIM -> MDKIM)
-> ByteString
-> MDKIM
-> MDKIM
forall a b. (a -> b) -> a -> b
$ [Char]
-> [([Char], ByteString -> MDKIM -> MDKIM)]
-> Maybe (ByteString -> MDKIM -> MDKIM)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (ByteString -> [Char]
BS.unpack ByteString
tag) [([Char], ByteString -> MDKIM -> MDKIM)]
dkimTagDB
pfs :: [MDKIM -> MDKIM]
pfs = ((ByteString -> MDKIM -> MDKIM) -> ByteString -> MDKIM -> MDKIM)
-> [ByteString -> MDKIM -> MDKIM]
-> [ByteString]
-> [MDKIM -> MDKIM]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (ByteString -> MDKIM -> MDKIM) -> ByteString -> MDKIM -> MDKIM
forall a b. (a -> b) -> a -> b
($) [ByteString -> MDKIM -> MDKIM]
fs [ByteString]
vs
domkey :: MDKIM
domkey = ((MDKIM -> MDKIM) -> MDKIM -> MDKIM)
-> MDKIM -> [MDKIM -> MDKIM] -> MDKIM
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (MDKIM -> MDKIM) -> MDKIM -> MDKIM
forall a b. (a -> b) -> a -> b
($) MDKIM
initialMDKIM [MDKIM -> MDKIM]
pfs
toDKIM :: MDKIM -> Maybe DKIM
toDKIM MDKIM
mdkim = do
ByteString
ver <- MDKIM -> Maybe ByteString
mdkimVersion MDKIM
mdkim
DkimSigAlgo
alg <- MDKIM -> Maybe DkimSigAlgo
mdkimSigAlgo MDKIM
mdkim
ByteString
sig <- MDKIM -> Maybe ByteString
mdkimSignature MDKIM
mdkim
ByteString
bhs <- MDKIM -> Maybe ByteString
mdkimBodyHash MDKIM
mdkim
DkimCanonAlgo
hca <- MDKIM -> Maybe DkimCanonAlgo
mdkimHeaderCanon MDKIM
mdkim
DkimCanonAlgo
bca <- MDKIM -> Maybe DkimCanonAlgo
mdkimBodyCanon MDKIM
mdkim
ByteString
dom <- MDKIM -> Maybe ByteString
mdkimDomain MDKIM
mdkim
[ByteString]
fld <- MDKIM -> Maybe [ByteString]
mdkimFields MDKIM
mdkim
ByteString
sel <- MDKIM -> Maybe ByteString
mdkimSelector MDKIM
mdkim
DKIM -> Maybe DKIM
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return
DKIM
{ dkimVersion :: ByteString
dkimVersion = ByteString
ver
, dkimSigAlgo :: DkimSigAlgo
dkimSigAlgo = DkimSigAlgo
alg
, dkimSignature :: ByteString
dkimSignature = ByteString
sig
, dkimBodyHash :: ByteString
dkimBodyHash = ByteString
bhs
, dkimHeaderCanon :: DkimCanonAlgo
dkimHeaderCanon = DkimCanonAlgo
hca
, dkimBodyCanon :: DkimCanonAlgo
dkimBodyCanon = DkimCanonAlgo
bca
, dkimDomain0 :: ByteString
dkimDomain0 = ByteString
dom
, dkimFields :: [ByteString]
dkimFields = [ByteString]
fld
, dkimLength :: Maybe Int
dkimLength = MDKIM -> Maybe Int
mdkimLength MDKIM
mdkim
, dkimSelector0 :: ByteString
dkimSelector0 = ByteString
sel
}
data MDKIM = MDKIM
{ MDKIM -> Maybe ByteString
mdkimVersion :: Maybe ByteString
, MDKIM -> Maybe DkimSigAlgo
mdkimSigAlgo :: Maybe DkimSigAlgo
, MDKIM -> Maybe ByteString
mdkimSignature :: Maybe ByteString
, MDKIM -> Maybe ByteString
mdkimBodyHash :: Maybe ByteString
, :: Maybe DkimCanonAlgo
, MDKIM -> Maybe DkimCanonAlgo
mdkimBodyCanon :: Maybe DkimCanonAlgo
, MDKIM -> Maybe ByteString
mdkimDomain :: Maybe ByteString
, MDKIM -> Maybe [ByteString]
mdkimFields :: Maybe [CanonFieldKey]
, MDKIM -> Maybe Int
mdkimLength :: Maybe Int
, MDKIM -> Maybe ByteString
mdkimSelector :: Maybe ByteString
}
deriving (MDKIM -> MDKIM -> Bool
(MDKIM -> MDKIM -> Bool) -> (MDKIM -> MDKIM -> Bool) -> Eq MDKIM
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MDKIM -> MDKIM -> Bool
== :: MDKIM -> MDKIM -> Bool
$c/= :: MDKIM -> MDKIM -> Bool
/= :: MDKIM -> MDKIM -> Bool
Eq, Int -> MDKIM -> ShowS
[MDKIM] -> ShowS
MDKIM -> [Char]
(Int -> MDKIM -> ShowS)
-> (MDKIM -> [Char]) -> ([MDKIM] -> ShowS) -> Show MDKIM
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MDKIM -> ShowS
showsPrec :: Int -> MDKIM -> ShowS
$cshow :: MDKIM -> [Char]
show :: MDKIM -> [Char]
$cshowList :: [MDKIM] -> ShowS
showList :: [MDKIM] -> ShowS
Show)
initialMDKIM :: MDKIM
initialMDKIM :: MDKIM
initialMDKIM =
MDKIM
{ mdkimVersion :: Maybe ByteString
mdkimVersion = Maybe ByteString
forall a. Maybe a
Nothing
, mdkimSigAlgo :: Maybe DkimSigAlgo
mdkimSigAlgo = Maybe DkimSigAlgo
forall a. Maybe a
Nothing
, mdkimSignature :: Maybe ByteString
mdkimSignature = Maybe ByteString
forall a. Maybe a
Nothing
, mdkimBodyHash :: Maybe ByteString
mdkimBodyHash = Maybe ByteString
forall a. Maybe a
Nothing
, mdkimHeaderCanon :: Maybe DkimCanonAlgo
mdkimHeaderCanon = DkimCanonAlgo -> Maybe DkimCanonAlgo
forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
, mdkimBodyCanon :: Maybe DkimCanonAlgo
mdkimBodyCanon = DkimCanonAlgo -> Maybe DkimCanonAlgo
forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
, mdkimDomain :: Maybe ByteString
mdkimDomain = Maybe ByteString
forall a. Maybe a
Nothing
, mdkimFields :: Maybe [ByteString]
mdkimFields = Maybe [ByteString]
forall a. Maybe a
Nothing
, mdkimLength :: Maybe Int
mdkimLength = Maybe Int
forall a. Maybe a
Nothing
, mdkimSelector :: Maybe ByteString
mdkimSelector = Maybe ByteString
forall a. Maybe a
Nothing
}
type DKIMSetter = ByteString -> MDKIM -> MDKIM
dkimTagDB :: [(String, DKIMSetter)]
dkimTagDB :: [([Char], ByteString -> MDKIM -> MDKIM)]
dkimTagDB =
[ ([Char]
"v", ByteString -> MDKIM -> MDKIM
setDkimVersion)
, ([Char]
"a", ByteString -> MDKIM -> MDKIM
setDkimSigAlgo)
, ([Char]
"b", ByteString -> MDKIM -> MDKIM
setDkimSignature)
, ([Char]
"bh", ByteString -> MDKIM -> MDKIM
setDkimBodyHash)
, ([Char]
"c", ByteString -> MDKIM -> MDKIM
setDkimCanonAlgo)
, ([Char]
"d", ByteString -> MDKIM -> MDKIM
setDkimDomain)
, ([Char]
"h", ByteString -> MDKIM -> MDKIM
setDkimFields)
, ([Char]
"l", ByteString -> MDKIM -> MDKIM
setDkimLength)
, ([Char]
"s", ByteString -> MDKIM -> MDKIM
setDkimSelector)
]
setDkimVersion :: DKIMSetter
setDkimVersion :: ByteString -> MDKIM -> MDKIM
setDkimVersion ByteString
ver MDKIM
dkim = MDKIM
dkim{mdkimVersion = Just ver}
setDkimSigAlgo :: DKIMSetter
setDkimSigAlgo :: ByteString -> MDKIM -> MDKIM
setDkimSigAlgo ByteString
"rsa-sha1" MDKIM
dkim = MDKIM
dkim{mdkimSigAlgo = Just RSA_SHA1}
setDkimSigAlgo ByteString
"rsa-sha256" MDKIM
dkim = MDKIM
dkim{mdkimSigAlgo = Just RSA_SHA256}
setDkimSigAlgo ByteString
_ MDKIM
_ = [Char] -> MDKIM
forall a. HasCallStack => [Char] -> a
error [Char]
"setDkimSigAlgo"
setDkimSignature :: DKIMSetter
setDkimSignature :: ByteString -> MDKIM -> MDKIM
setDkimSignature ByteString
sig MDKIM
dkim = MDKIM
dkim{mdkimSignature = Just sig}
setDkimBodyHash :: DKIMSetter
setDkimBodyHash :: ByteString -> MDKIM -> MDKIM
setDkimBodyHash ByteString
bh MDKIM
dkim = MDKIM
dkim{mdkimBodyHash = Just bh}
setDkimCanonAlgo :: DKIMSetter
setDkimCanonAlgo :: ByteString -> MDKIM -> MDKIM
setDkimCanonAlgo ByteString
"relaxed" MDKIM
dkim =
MDKIM
dkim
{ mdkimHeaderCanon = Just DKIM_RELAXED
, mdkimBodyCanon = Just DKIM_SIMPLE
}
setDkimCanonAlgo ByteString
"relaxed/relaxed" MDKIM
dkim =
MDKIM
dkim
{ mdkimHeaderCanon = Just DKIM_RELAXED
, mdkimBodyCanon = Just DKIM_RELAXED
}
setDkimCanonAlgo ByteString
"relaxed/simple" MDKIM
dkim =
MDKIM
dkim
{ mdkimHeaderCanon = Just DKIM_RELAXED
, mdkimBodyCanon = Just DKIM_SIMPLE
}
setDkimCanonAlgo ByteString
"simple/relaxed" MDKIM
dkim =
MDKIM
dkim
{ mdkimHeaderCanon = Just DKIM_SIMPLE
, mdkimBodyCanon = Just DKIM_RELAXED
}
setDkimCanonAlgo ByteString
"simple/simple" MDKIM
dkim =
MDKIM
dkim
{ mdkimHeaderCanon = Just DKIM_SIMPLE
, mdkimBodyCanon = Just DKIM_SIMPLE
}
setDkimCanonAlgo ByteString
_ MDKIM
_ = [Char] -> MDKIM
forall a. HasCallStack => [Char] -> a
error [Char]
"setDkimCanonAlgo"
setDkimDomain :: DKIMSetter
setDkimDomain :: ByteString -> MDKIM -> MDKIM
setDkimDomain ByteString
dom MDKIM
dkim = MDKIM
dkim{mdkimDomain = Just dom}
setDkimFields :: DKIMSetter
setDkimFields :: ByteString -> MDKIM -> MDKIM
setDkimFields ByteString
keys MDKIM
dkim = MDKIM
dkim{mdkimFields = Just flds}
where
flds :: [ByteString]
flds = (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
canonicalizeKey ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BS.split Char
':' ByteString
keys
setDkimLength :: DKIMSetter
setDkimLength :: ByteString -> MDKIM -> MDKIM
setDkimLength ByteString
len MDKIM
dkim = MDKIM
dkim{mdkimLength = fst <$> BS.readInt len}
setDkimSelector :: DKIMSetter
setDkimSelector :: ByteString -> MDKIM -> MDKIM
setDkimSelector ByteString
sel MDKIM
dkim = MDKIM
dkim{mdkimSelector = Just sel}