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

-- $setup
-- >>> import Text.Pretty.Simple
-- >>> import Data.ByteString.Char8 as BS8

-- | Parsing DKIM-Signature:.
--
-- >>> :{
-- let dkim = BS8.concat [
--                   "v=1; a=rsa-sha256; s=brisbane; d=example.com;\n"
--                 , "         c=relaxed/simple; q=dns/txt; i=joe@football.example.com;\n"
--                 , "         h=Received : From : To : Subject : Date : Message-ID;\n"
--                 , "         bh=2jUSOH9NhtVGCQWNr9BrIAPreKQjO6Sn7XIkfJVOzv8=;\n"
--                 , "         b=AuUoFEfDxTDkHlLXSZEpZj79LICEps6eda7W3deTVFOk4yAUoqOB\n"
--                 , "           4nujc7YopdG5dWLSdNg6xNAZpOPr+kHxt1IrE+NahM6L/LbvaHut\n"
--                 , "           KVdkLLkpVaVVQPzeRDI009SO2Il5Lu7rDNH6mZckBdrIx0orEtZV\n"
--                 , "           4bmp/YzhwvcubU4=;"
--                 ]
-- in pPrintNoColor $ parseDKIM dkim
-- :}
-- Just 
--     ( DKIM 
--         { dkimVersion = "1"
--         , dkimSigAlgo = RSA_SHA256
--         , dkimSignature = "AuUoFEfDxTDkHlLXSZEpZj79LICEps6eda7W3deTVFOk4yAUoqOB4nujc7YopdG5dWLSdNg6xNAZpOPr+kHxt1IrE+NahM6L/LbvaHutKVdkLLkpVaVVQPzeRDI009SO2Il5Lu7rDNH6mZckBdrIx0orEtZV4bmp/YzhwvcubU4="
--         , dkimBodyHash = "2jUSOH9NhtVGCQWNr9BrIAPreKQjO6Sn7XIkfJVOzv8="
--         , dkimHeaderCanon = DKIM_RELAXED
--         , dkimBodyCanon = DKIM_SIMPLE
--         , dkimDomain0 = "example.com"
--         , dkimFields = 
--             [ "received"
--             , "from"
--             , "to"
--             , "subject"
--             , "date"
--             , "message-id"
--             ] 
--         , dkimLength = Nothing
--         , dkimSelector0 = "brisbane"
--         } 
--     )
--
-- >>> :{
-- let dkim = BS8.concat [
--                  "v=1; a=rsa-sha256; s=brisbane; d=example.com;\n"
--                , "         q=dns/txt; i=joe@football.example.com;\n"
--                , "         h=Received : From : To : Subject : Date : Message-ID;\n"
--                , "         bh=2jUSOH9NhtVGCQWNr9BrIAPreKQjO6Sn7XIkfJVOzv8=;\n"
--                , "         b=AuUoFEfDxTDkHlLXSZEpZj79LICEps6eda7W3deTVFOk4yAUoqOB\n"
--                , "           4nujc7YopdG5dWLSdNg6xNAZpOPr+kHxt1IrE+NahM6L/LbvaHut\n"
--                , "           KVdkLLkpVaVVQPzeRDI009SO2Il5Lu7rDNH6mZckBdrIx0orEtZV\n"
--                , "           4bmp/YzhwvcubU4=;"
--                ]
-- in pPrintNoColor $ parseDKIM dkim
-- :}
-- Just 
--     ( DKIM 
--         { dkimVersion = "1"
--         , dkimSigAlgo = RSA_SHA256
--         , dkimSignature = "AuUoFEfDxTDkHlLXSZEpZj79LICEps6eda7W3deTVFOk4yAUoqOB4nujc7YopdG5dWLSdNg6xNAZpOPr+kHxt1IrE+NahM6L/LbvaHutKVdkLLkpVaVVQPzeRDI009SO2Il5Lu7rDNH6mZckBdrIx0orEtZV4bmp/YzhwvcubU4="
--         , dkimBodyHash = "2jUSOH9NhtVGCQWNr9BrIAPreKQjO6Sn7XIkfJVOzv8="
--         , dkimHeaderCanon = DKIM_SIMPLE
--         , dkimBodyCanon = DKIM_SIMPLE
--         , dkimDomain0 = "example.com"
--         , dkimFields = 
--             [ "received"
--             , "from"
--             , "to"
--             , "subject"
--             , "date"
--             , "message-id"
--             ] 
--         , dkimLength = Nothing
--         , dkimSelector0 = "brisbane"
--         } 
--     )
parseDKIM :: RawFieldValue -> Maybe DKIM
parseDKIM :: ByteString -> Maybe DKIM
parseDKIM ByteString
val = MDKIM -> Maybe DKIM
toDKIM MDKIM
domkey
  where
    ([ByteString]
ts,[ByteString]
vs) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ ByteString -> [(ByteString, ByteString)]
parseTaggedValue ByteString
val
    fs :: [ByteString -> MDKIM -> MDKIM]
fs = forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString -> MDKIM -> MDKIM
tagToSetter [ByteString]
ts
    tagToSetter :: ByteString -> ByteString -> MDKIM -> MDKIM
tagToSetter ByteString
tag = forall a. a -> Maybe a -> a
fromMaybe (\ByteString
_ MDKIM
mdkim -> MDKIM
mdkim) forall a b. (a -> b) -> a -> b
$ 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 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. (a -> b) -> a -> b
($) [ByteString -> MDKIM -> MDKIM]
fs [ByteString]
vs
    domkey :: MDKIM
domkey = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr 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
        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
  , MDKIM -> Maybe DkimCanonAlgo
mdkimHeaderCanon :: 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MDKIM -> MDKIM -> Bool
$c/= :: MDKIM -> MDKIM -> Bool
== :: MDKIM -> MDKIM -> Bool
$c== :: MDKIM -> MDKIM -> Bool
Eq,Int -> MDKIM -> ShowS
[MDKIM] -> ShowS
MDKIM -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MDKIM] -> ShowS
$cshowList :: [MDKIM] -> ShowS
show :: MDKIM -> [Char]
$cshow :: MDKIM -> [Char]
showsPrec :: Int -> MDKIM -> ShowS
$cshowsPrec :: Int -> MDKIM -> ShowS
Show)

initialMDKIM :: MDKIM
initialMDKIM :: MDKIM
initialMDKIM = MDKIM {
    mdkimVersion :: Maybe ByteString
mdkimVersion     = forall a. Maybe a
Nothing
  , mdkimSigAlgo :: Maybe DkimSigAlgo
mdkimSigAlgo     = forall a. Maybe a
Nothing
  , mdkimSignature :: Maybe ByteString
mdkimSignature   = forall a. Maybe a
Nothing
  , mdkimBodyHash :: Maybe ByteString
mdkimBodyHash    = forall a. Maybe a
Nothing
  , mdkimHeaderCanon :: Maybe DkimCanonAlgo
mdkimHeaderCanon = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
  , mdkimBodyCanon :: Maybe DkimCanonAlgo
mdkimBodyCanon   = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
  , mdkimDomain :: Maybe ByteString
mdkimDomain      = forall a. Maybe a
Nothing
  , mdkimFields :: Maybe [ByteString]
mdkimFields      = forall a. Maybe a
Nothing
  , mdkimLength :: Maybe Int
mdkimLength      = forall a. Maybe a
Nothing
  , mdkimSelector :: Maybe ByteString
mdkimSelector    = 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 :: Maybe ByteString
mdkimVersion = forall a. a -> Maybe a
Just ByteString
ver }

setDkimSigAlgo :: DKIMSetter
setDkimSigAlgo :: ByteString -> MDKIM -> MDKIM
setDkimSigAlgo ByteString
"rsa-sha1" MDKIM
dkim = MDKIM
dkim { mdkimSigAlgo :: Maybe DkimSigAlgo
mdkimSigAlgo = forall a. a -> Maybe a
Just DkimSigAlgo
RSA_SHA1 }
setDkimSigAlgo ByteString
"rsa-sha256" MDKIM
dkim = MDKIM
dkim { mdkimSigAlgo :: Maybe DkimSigAlgo
mdkimSigAlgo = forall a. a -> Maybe a
Just DkimSigAlgo
RSA_SHA256 }
setDkimSigAlgo ByteString
_ MDKIM
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"setDkimSigAlgo"

setDkimSignature :: DKIMSetter
setDkimSignature :: ByteString -> MDKIM -> MDKIM
setDkimSignature ByteString
sig MDKIM
dkim = MDKIM
dkim { mdkimSignature :: Maybe ByteString
mdkimSignature = forall a. a -> Maybe a
Just ByteString
sig }

setDkimBodyHash :: DKIMSetter
setDkimBodyHash :: ByteString -> MDKIM -> MDKIM
setDkimBodyHash ByteString
bh MDKIM
dkim = MDKIM
dkim { mdkimBodyHash :: Maybe ByteString
mdkimBodyHash = forall a. a -> Maybe a
Just ByteString
bh }

setDkimCanonAlgo :: DKIMSetter
setDkimCanonAlgo :: ByteString -> MDKIM -> MDKIM
setDkimCanonAlgo ByteString
"relaxed" MDKIM
dkim = MDKIM
dkim {
    mdkimHeaderCanon :: Maybe DkimCanonAlgo
mdkimHeaderCanon = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_RELAXED
  , mdkimBodyCanon :: Maybe DkimCanonAlgo
mdkimBodyCanon   = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
  }
setDkimCanonAlgo ByteString
"relaxed/relaxed" MDKIM
dkim = MDKIM
dkim {
    mdkimHeaderCanon :: Maybe DkimCanonAlgo
mdkimHeaderCanon = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_RELAXED
  , mdkimBodyCanon :: Maybe DkimCanonAlgo
mdkimBodyCanon   = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_RELAXED
  }
setDkimCanonAlgo ByteString
"relaxed/simple" MDKIM
dkim = MDKIM
dkim {
    mdkimHeaderCanon :: Maybe DkimCanonAlgo
mdkimHeaderCanon = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_RELAXED
  , mdkimBodyCanon :: Maybe DkimCanonAlgo
mdkimBodyCanon   = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
  }
setDkimCanonAlgo ByteString
"simple/relaxed" MDKIM
dkim = MDKIM
dkim {
    mdkimHeaderCanon :: Maybe DkimCanonAlgo
mdkimHeaderCanon = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
  , mdkimBodyCanon :: Maybe DkimCanonAlgo
mdkimBodyCanon   = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_RELAXED
  }
setDkimCanonAlgo ByteString
"simple/simple" MDKIM
dkim = MDKIM
dkim {
    mdkimHeaderCanon :: Maybe DkimCanonAlgo
mdkimHeaderCanon = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
  , mdkimBodyCanon :: Maybe DkimCanonAlgo
mdkimBodyCanon   = forall a. a -> Maybe a
Just DkimCanonAlgo
DKIM_SIMPLE
  }
setDkimCanonAlgo ByteString
_ MDKIM
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"setDkimCanonAlgo"

setDkimDomain :: DKIMSetter
setDkimDomain :: ByteString -> MDKIM -> MDKIM
setDkimDomain ByteString
dom MDKIM
dkim = MDKIM
dkim { mdkimDomain :: Maybe ByteString
mdkimDomain = forall a. a -> Maybe a
Just ByteString
dom }

setDkimFields :: DKIMSetter
setDkimFields :: ByteString -> MDKIM -> MDKIM
setDkimFields ByteString
keys MDKIM
dkim = MDKIM
dkim { mdkimFields :: Maybe [ByteString]
mdkimFields = forall a. a -> Maybe a
Just [ByteString]
flds }
  where
    flds :: [ByteString]
flds = forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
canonicalizeKey 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 :: Maybe Int
mdkimLength = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (Int, ByteString)
BS.readInt ByteString
len }

setDkimSelector :: DKIMSetter
setDkimSelector :: ByteString -> MDKIM -> MDKIM
setDkimSelector ByteString
sel MDKIM
dkim = MDKIM
dkim { mdkimSelector :: Maybe ByteString
mdkimSelector = forall a. a -> Maybe a
Just ByteString
sel }