{-# LANGUAGE OverloadedStrings, FlexibleContexts, RecordWildCards #-}

-- | Utilities for parsing a DMARC aggregated report, following RFC 7489. These functions also handle decompression (gzip or pkzip)

module Data.Mail.DMARC.Reports (
  -- * Parsers
  dmarcFeedbackFromStrict,
  dmarcFeedbackFromLazy,
  dmarcFeedbackFromXml,
  -- * Data types
  Feedback(..),
  ReportMetadata(..),
  Record(..),
  Row(..),
  PolicyPublished(..),
  PolicyEvaluated(..),
  DkimAuth(..),
  SpfAuth(..),
  AuthResult(..),
  IpAddress,
  AlignmentMode(..),
  PolicyAction(..),
  -- * Utility
  uncompressString
  ) where

import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as B
import qualified Codec.Archive.Zip as Z
import qualified Codec.Compression.GZip as GZ
import Control.Monad.Trans
import Control.Applicative
import Text.XML.Light
import Text.Read (readMaybe)
import Data.Time.Clock
import Data.Time.Format
import Data.Maybe
import qualified Data.Text as T
import System.IO.Unsafe

-- | Uncompress gzip or pkzip bytestring. If it is neither gzipped or pkzipped, return the string unmodified.
uncompressString :: L.ByteString -> L.ByteString
uncompressString :: ByteString -> ByteString
uncompressString ByteString
bs =
  let magic :: ByteString
magic = Int64 -> ByteString -> ByteString
L.take Int64
2 ByteString
bs
  in if ByteString
magic ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"PK"
     then ByteString -> ByteString
pkunzip ByteString
bs
     else if ByteString
magic ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\x1F\x8b"
          then ByteString -> ByteString
GZ.decompress ByteString
bs
          else ByteString
bs
  where pkunzip :: ByteString -> ByteString
pkunzip ByteString
bs =
          let a :: Archive
a = ByteString -> Archive
Z.toArchive ByteString
bs
          in case Archive -> [Entry]
Z.zEntries Archive
a of
               [] -> [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error [Char]
"Empty PKZip archive :("
               (Entry
e:[Entry]
_) -> Entry -> ByteString
Z.fromEntry Entry
e

data ReportMetadata = ReportMetadata {
  ReportMetadata -> Maybe Text
rmOrgName :: Maybe T.Text,
  ReportMetadata -> Maybe Text
rmEmail :: Maybe T.Text,
  ReportMetadata -> Maybe Text
rmExtraContactInfo :: Maybe T.Text,
  ReportMetadata -> Maybe Integer
rmReportId :: Maybe Integer,
  ReportMetadata -> Maybe (UTCTime, UTCTime)
rmDateRange :: Maybe (UTCTime, UTCTime)
  } deriving (ReportMetadata -> ReportMetadata -> Bool
(ReportMetadata -> ReportMetadata -> Bool)
-> (ReportMetadata -> ReportMetadata -> Bool) -> Eq ReportMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReportMetadata -> ReportMetadata -> Bool
$c/= :: ReportMetadata -> ReportMetadata -> Bool
== :: ReportMetadata -> ReportMetadata -> Bool
$c== :: ReportMetadata -> ReportMetadata -> Bool
Eq,Int -> ReportMetadata -> ShowS
[ReportMetadata] -> ShowS
ReportMetadata -> [Char]
(Int -> ReportMetadata -> ShowS)
-> (ReportMetadata -> [Char])
-> ([ReportMetadata] -> ShowS)
-> Show ReportMetadata
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ReportMetadata] -> ShowS
$cshowList :: [ReportMetadata] -> ShowS
show :: ReportMetadata -> [Char]
$cshow :: ReportMetadata -> [Char]
showsPrec :: Int -> ReportMetadata -> ShowS
$cshowsPrec :: Int -> ReportMetadata -> ShowS
Show,ReadPrec [ReportMetadata]
ReadPrec ReportMetadata
Int -> ReadS ReportMetadata
ReadS [ReportMetadata]
(Int -> ReadS ReportMetadata)
-> ReadS [ReportMetadata]
-> ReadPrec ReportMetadata
-> ReadPrec [ReportMetadata]
-> Read ReportMetadata
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReportMetadata]
$creadListPrec :: ReadPrec [ReportMetadata]
readPrec :: ReadPrec ReportMetadata
$creadPrec :: ReadPrec ReportMetadata
readList :: ReadS [ReportMetadata]
$creadList :: ReadS [ReportMetadata]
readsPrec :: Int -> ReadS ReportMetadata
$creadsPrec :: Int -> ReadS ReportMetadata
Read)

data AlignmentMode = Strict | Relaxed deriving (AlignmentMode -> AlignmentMode -> Bool
(AlignmentMode -> AlignmentMode -> Bool)
-> (AlignmentMode -> AlignmentMode -> Bool) -> Eq AlignmentMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AlignmentMode -> AlignmentMode -> Bool
$c/= :: AlignmentMode -> AlignmentMode -> Bool
== :: AlignmentMode -> AlignmentMode -> Bool
$c== :: AlignmentMode -> AlignmentMode -> Bool
Eq)

instance Show AlignmentMode where
  show :: AlignmentMode -> [Char]
show AlignmentMode
Strict = [Char]
"s"
  show AlignmentMode
Relaxed = [Char]
"r"

instance Read AlignmentMode where
  readsPrec :: Int -> ReadS AlignmentMode
readsPrec Int
_ [Char]
r =
    [(AlignmentMode
Strict,[Char]
s) | ([Char]
"s",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AlignmentMode, [Char])]
-> [(AlignmentMode, [Char])] -> [(AlignmentMode, [Char])]
forall a. [a] -> [a] -> [a]
++[(AlignmentMode
Relaxed,[Char]
s) | ([Char]
"r",[Char]
s) <- ReadS [Char]
lex [Char]
r]

data PolicyAction = NoPolicy
                  | Quarantine
                  | Reject deriving (PolicyAction -> PolicyAction -> Bool
(PolicyAction -> PolicyAction -> Bool)
-> (PolicyAction -> PolicyAction -> Bool) -> Eq PolicyAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyAction -> PolicyAction -> Bool
$c/= :: PolicyAction -> PolicyAction -> Bool
== :: PolicyAction -> PolicyAction -> Bool
$c== :: PolicyAction -> PolicyAction -> Bool
Eq)

instance Show PolicyAction where
  show :: PolicyAction -> [Char]
show PolicyAction
NoPolicy = [Char]
"none"
  show PolicyAction
Quarantine = [Char]
"quarantine"
  show PolicyAction
Reject = [Char]
"reject"

instance Read PolicyAction where
  readsPrec :: Int -> ReadS PolicyAction
readsPrec Int
_ [Char]
r =
    [(PolicyAction
NoPolicy,[Char]
s) | ([Char]
"none",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(PolicyAction, [Char])]
-> [(PolicyAction, [Char])] -> [(PolicyAction, [Char])]
forall a. [a] -> [a] -> [a]
++[(PolicyAction
Quarantine,[Char]
s) | ([Char]
"quarantine",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(PolicyAction, [Char])]
-> [(PolicyAction, [Char])] -> [(PolicyAction, [Char])]
forall a. [a] -> [a] -> [a]
++[(PolicyAction
Reject,[Char]
s) | ([Char]
"reject",[Char]
s) <- ReadS [Char]
lex [Char]
r]
  
data PolicyPublished = PolicyPublished {
  PolicyPublished -> Text
ppDomain :: T.Text,
  PolicyPublished -> AlignmentMode
ppDkimAlignment :: AlignmentMode,
  PolicyPublished -> AlignmentMode
ppSpfAlignment :: AlignmentMode,
  PolicyPublished -> PolicyAction
ppPolicy :: PolicyAction,
  PolicyPublished -> PolicyAction
ppSubdomainPolicy :: PolicyAction,
  PolicyPublished -> Int
ppPercent :: Int
  } deriving (PolicyPublished -> PolicyPublished -> Bool
(PolicyPublished -> PolicyPublished -> Bool)
-> (PolicyPublished -> PolicyPublished -> Bool)
-> Eq PolicyPublished
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyPublished -> PolicyPublished -> Bool
$c/= :: PolicyPublished -> PolicyPublished -> Bool
== :: PolicyPublished -> PolicyPublished -> Bool
$c== :: PolicyPublished -> PolicyPublished -> Bool
Eq,Int -> PolicyPublished -> ShowS
[PolicyPublished] -> ShowS
PolicyPublished -> [Char]
(Int -> PolicyPublished -> ShowS)
-> (PolicyPublished -> [Char])
-> ([PolicyPublished] -> ShowS)
-> Show PolicyPublished
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PolicyPublished] -> ShowS
$cshowList :: [PolicyPublished] -> ShowS
show :: PolicyPublished -> [Char]
$cshow :: PolicyPublished -> [Char]
showsPrec :: Int -> PolicyPublished -> ShowS
$cshowsPrec :: Int -> PolicyPublished -> ShowS
Show,ReadPrec [PolicyPublished]
ReadPrec PolicyPublished
Int -> ReadS PolicyPublished
ReadS [PolicyPublished]
(Int -> ReadS PolicyPublished)
-> ReadS [PolicyPublished]
-> ReadPrec PolicyPublished
-> ReadPrec [PolicyPublished]
-> Read PolicyPublished
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PolicyPublished]
$creadListPrec :: ReadPrec [PolicyPublished]
readPrec :: ReadPrec PolicyPublished
$creadPrec :: ReadPrec PolicyPublished
readList :: ReadS [PolicyPublished]
$creadList :: ReadS [PolicyPublished]
readsPrec :: Int -> ReadS PolicyPublished
$creadsPrec :: Int -> ReadS PolicyPublished
Read)

data AuthResult = NoAuth    -- ^ no policy published
                | AuthPass  -- ^ successful authentication
                | AuthFail  -- ^ authentication failed
                | TempError -- ^ temporary error in resolving the policy
                | PermError -- ^ permanent error in resolving the policy
                | AuthNeutral -- ^ ??? (DKIM only)
                | AuthPolicy  -- ^ ??? (DKIM only)
                | SoftFail  -- ^ auth failed, but won't reject (SPF only)
                deriving (AuthResult -> AuthResult -> Bool
(AuthResult -> AuthResult -> Bool)
-> (AuthResult -> AuthResult -> Bool) -> Eq AuthResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthResult -> AuthResult -> Bool
$c/= :: AuthResult -> AuthResult -> Bool
== :: AuthResult -> AuthResult -> Bool
$c== :: AuthResult -> AuthResult -> Bool
Eq)

instance Show AuthResult where
  show :: AuthResult -> [Char]
show AuthResult
NoAuth = [Char]
"none"
  show AuthResult
AuthPass = [Char]
"pass"
  show AuthResult
AuthFail = [Char]
"fail"
  show AuthResult
TempError = [Char]
"temperror"
  show AuthResult
PermError = [Char]
"permerror"
  show AuthResult
AuthNeutral = [Char]
"neutral"
  show AuthResult
AuthPolicy = [Char]
"policy"
  show AuthResult
SoftFail = [Char]
"softfail"

instance Read AuthResult where
  readsPrec :: Int -> ReadS AuthResult
readsPrec Int
_ [Char]
r =
    [(AuthResult
NoAuth,[Char]
s) | ([Char]
"none",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AuthResult, [Char])]
-> [(AuthResult, [Char])] -> [(AuthResult, [Char])]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthPass,[Char]
s) | ([Char]
"pass",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AuthResult, [Char])]
-> [(AuthResult, [Char])] -> [(AuthResult, [Char])]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthFail,[Char]
s) | ([Char]
"fail",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AuthResult, [Char])]
-> [(AuthResult, [Char])] -> [(AuthResult, [Char])]
forall a. [a] -> [a] -> [a]
++[(AuthResult
TempError,[Char]
s) | ([Char]
"temperror",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AuthResult, [Char])]
-> [(AuthResult, [Char])] -> [(AuthResult, [Char])]
forall a. [a] -> [a] -> [a]
++[(AuthResult
PermError,[Char]
s) | ([Char]
"permerror",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AuthResult, [Char])]
-> [(AuthResult, [Char])] -> [(AuthResult, [Char])]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthNeutral,[Char]
s) | ([Char]
"neutral",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AuthResult, [Char])]
-> [(AuthResult, [Char])] -> [(AuthResult, [Char])]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthPolicy,[Char]
s) | ([Char]
"policy",[Char]
s) <- ReadS [Char]
lex [Char]
r]
    [(AuthResult, [Char])]
-> [(AuthResult, [Char])] -> [(AuthResult, [Char])]
forall a. [a] -> [a] -> [a]
++[(AuthResult
SoftFail,[Char]
s) | ([Char]
"softfail",[Char]
s) <- ReadS [Char]
lex [Char]
r]

type IpAddress = String

data PolicyEvaluated = PolicyEvaluated {
  PolicyEvaluated -> PolicyAction
peDisposition :: PolicyAction,
  PolicyEvaluated -> AuthResult
peDkimResult :: AuthResult,
  PolicyEvaluated -> AuthResult
peSpfResult :: AuthResult
  } deriving (PolicyEvaluated -> PolicyEvaluated -> Bool
(PolicyEvaluated -> PolicyEvaluated -> Bool)
-> (PolicyEvaluated -> PolicyEvaluated -> Bool)
-> Eq PolicyEvaluated
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyEvaluated -> PolicyEvaluated -> Bool
$c/= :: PolicyEvaluated -> PolicyEvaluated -> Bool
== :: PolicyEvaluated -> PolicyEvaluated -> Bool
$c== :: PolicyEvaluated -> PolicyEvaluated -> Bool
Eq, Int -> PolicyEvaluated -> ShowS
[PolicyEvaluated] -> ShowS
PolicyEvaluated -> [Char]
(Int -> PolicyEvaluated -> ShowS)
-> (PolicyEvaluated -> [Char])
-> ([PolicyEvaluated] -> ShowS)
-> Show PolicyEvaluated
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PolicyEvaluated] -> ShowS
$cshowList :: [PolicyEvaluated] -> ShowS
show :: PolicyEvaluated -> [Char]
$cshow :: PolicyEvaluated -> [Char]
showsPrec :: Int -> PolicyEvaluated -> ShowS
$cshowsPrec :: Int -> PolicyEvaluated -> ShowS
Show, ReadPrec [PolicyEvaluated]
ReadPrec PolicyEvaluated
Int -> ReadS PolicyEvaluated
ReadS [PolicyEvaluated]
(Int -> ReadS PolicyEvaluated)
-> ReadS [PolicyEvaluated]
-> ReadPrec PolicyEvaluated
-> ReadPrec [PolicyEvaluated]
-> Read PolicyEvaluated
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PolicyEvaluated]
$creadListPrec :: ReadPrec [PolicyEvaluated]
readPrec :: ReadPrec PolicyEvaluated
$creadPrec :: ReadPrec PolicyEvaluated
readList :: ReadS [PolicyEvaluated]
$creadList :: ReadS [PolicyEvaluated]
readsPrec :: Int -> ReadS PolicyEvaluated
$creadsPrec :: Int -> ReadS PolicyEvaluated
Read)

data Row = Row {
  Row -> [Char]
rwSourceIp :: IpAddress,
  Row -> Int
rwCount :: Int,
  Row -> PolicyEvaluated
rwPolicyEvaluated :: PolicyEvaluated
  } deriving (Row -> Row -> Bool
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Int -> Row -> ShowS
[Row] -> ShowS
Row -> [Char]
(Int -> Row -> ShowS)
-> (Row -> [Char]) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> [Char]
$cshow :: Row -> [Char]
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show, ReadPrec [Row]
ReadPrec Row
Int -> ReadS Row
ReadS [Row]
(Int -> ReadS Row)
-> ReadS [Row] -> ReadPrec Row -> ReadPrec [Row] -> Read Row
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Row]
$creadListPrec :: ReadPrec [Row]
readPrec :: ReadPrec Row
$creadPrec :: ReadPrec Row
readList :: ReadS [Row]
$creadList :: ReadS [Row]
readsPrec :: Int -> ReadS Row
$creadsPrec :: Int -> ReadS Row
Read)

data Record = Record {
  Record -> Row
rcRow :: Row,
  Record -> Maybe DkimAuth
rcAuthDkim :: Maybe DkimAuth,
  Record -> Maybe SpfAuth
rcAuthSpf :: Maybe SpfAuth
  } deriving (Record -> Record -> Bool
(Record -> Record -> Bool)
-> (Record -> Record -> Bool) -> Eq Record
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Record -> Record -> Bool
$c/= :: Record -> Record -> Bool
== :: Record -> Record -> Bool
$c== :: Record -> Record -> Bool
Eq, Int -> Record -> ShowS
[Record] -> ShowS
Record -> [Char]
(Int -> Record -> ShowS)
-> (Record -> [Char]) -> ([Record] -> ShowS) -> Show Record
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Record] -> ShowS
$cshowList :: [Record] -> ShowS
show :: Record -> [Char]
$cshow :: Record -> [Char]
showsPrec :: Int -> Record -> ShowS
$cshowsPrec :: Int -> Record -> ShowS
Show, ReadPrec [Record]
ReadPrec Record
Int -> ReadS Record
ReadS [Record]
(Int -> ReadS Record)
-> ReadS [Record]
-> ReadPrec Record
-> ReadPrec [Record]
-> Read Record
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Record]
$creadListPrec :: ReadPrec [Record]
readPrec :: ReadPrec Record
$creadPrec :: ReadPrec Record
readList :: ReadS [Record]
$creadList :: ReadS [Record]
readsPrec :: Int -> ReadS Record
$creadsPrec :: Int -> ReadS Record
Read)

data DkimAuth = DkimAuth {
  DkimAuth -> AuthResult
daResult :: AuthResult,
  DkimAuth -> Text
daDomain :: T.Text,
  DkimAuth -> Text
daSelector :: T.Text
  } deriving (DkimAuth -> DkimAuth -> Bool
(DkimAuth -> DkimAuth -> Bool)
-> (DkimAuth -> DkimAuth -> Bool) -> Eq DkimAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DkimAuth -> DkimAuth -> Bool
$c/= :: DkimAuth -> DkimAuth -> Bool
== :: DkimAuth -> DkimAuth -> Bool
$c== :: DkimAuth -> DkimAuth -> Bool
Eq, Int -> DkimAuth -> ShowS
[DkimAuth] -> ShowS
DkimAuth -> [Char]
(Int -> DkimAuth -> ShowS)
-> (DkimAuth -> [Char]) -> ([DkimAuth] -> ShowS) -> Show DkimAuth
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [DkimAuth] -> ShowS
$cshowList :: [DkimAuth] -> ShowS
show :: DkimAuth -> [Char]
$cshow :: DkimAuth -> [Char]
showsPrec :: Int -> DkimAuth -> ShowS
$cshowsPrec :: Int -> DkimAuth -> ShowS
Show, ReadPrec [DkimAuth]
ReadPrec DkimAuth
Int -> ReadS DkimAuth
ReadS [DkimAuth]
(Int -> ReadS DkimAuth)
-> ReadS [DkimAuth]
-> ReadPrec DkimAuth
-> ReadPrec [DkimAuth]
-> Read DkimAuth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DkimAuth]
$creadListPrec :: ReadPrec [DkimAuth]
readPrec :: ReadPrec DkimAuth
$creadPrec :: ReadPrec DkimAuth
readList :: ReadS [DkimAuth]
$creadList :: ReadS [DkimAuth]
readsPrec :: Int -> ReadS DkimAuth
$creadsPrec :: Int -> ReadS DkimAuth
Read)

data SpfAuth = SpfAuth {
  SpfAuth -> AuthResult
saResult :: AuthResult,
  SpfAuth -> Text
saDomain :: T.Text
  } deriving (SpfAuth -> SpfAuth -> Bool
(SpfAuth -> SpfAuth -> Bool)
-> (SpfAuth -> SpfAuth -> Bool) -> Eq SpfAuth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpfAuth -> SpfAuth -> Bool
$c/= :: SpfAuth -> SpfAuth -> Bool
== :: SpfAuth -> SpfAuth -> Bool
$c== :: SpfAuth -> SpfAuth -> Bool
Eq, Int -> SpfAuth -> ShowS
[SpfAuth] -> ShowS
SpfAuth -> [Char]
(Int -> SpfAuth -> ShowS)
-> (SpfAuth -> [Char]) -> ([SpfAuth] -> ShowS) -> Show SpfAuth
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SpfAuth] -> ShowS
$cshowList :: [SpfAuth] -> ShowS
show :: SpfAuth -> [Char]
$cshow :: SpfAuth -> [Char]
showsPrec :: Int -> SpfAuth -> ShowS
$cshowsPrec :: Int -> SpfAuth -> ShowS
Show, ReadPrec [SpfAuth]
ReadPrec SpfAuth
Int -> ReadS SpfAuth
ReadS [SpfAuth]
(Int -> ReadS SpfAuth)
-> ReadS [SpfAuth]
-> ReadPrec SpfAuth
-> ReadPrec [SpfAuth]
-> Read SpfAuth
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpfAuth]
$creadListPrec :: ReadPrec [SpfAuth]
readPrec :: ReadPrec SpfAuth
$creadPrec :: ReadPrec SpfAuth
readList :: ReadS [SpfAuth]
$creadList :: ReadS [SpfAuth]
readsPrec :: Int -> ReadS SpfAuth
$creadsPrec :: Int -> ReadS SpfAuth
Read)
  
data Feedback = Feedback {
  Feedback -> ReportMetadata
fbReportMetadata :: ReportMetadata,
  Feedback -> PolicyPublished
fbPolicyPublished :: PolicyPublished,
  Feedback -> [Record]
fbRecords :: [Record]
  } deriving (Feedback -> Feedback -> Bool
(Feedback -> Feedback -> Bool)
-> (Feedback -> Feedback -> Bool) -> Eq Feedback
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Feedback -> Feedback -> Bool
$c/= :: Feedback -> Feedback -> Bool
== :: Feedback -> Feedback -> Bool
$c== :: Feedback -> Feedback -> Bool
Eq,Int -> Feedback -> ShowS
[Feedback] -> ShowS
Feedback -> [Char]
(Int -> Feedback -> ShowS)
-> (Feedback -> [Char]) -> ([Feedback] -> ShowS) -> Show Feedback
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Feedback] -> ShowS
$cshowList :: [Feedback] -> ShowS
show :: Feedback -> [Char]
$cshow :: Feedback -> [Char]
showsPrec :: Int -> Feedback -> ShowS
$cshowsPrec :: Int -> Feedback -> ShowS
Show,ReadPrec [Feedback]
ReadPrec Feedback
Int -> ReadS Feedback
ReadS [Feedback]
(Int -> ReadS Feedback)
-> ReadS [Feedback]
-> ReadPrec Feedback
-> ReadPrec [Feedback]
-> Read Feedback
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Feedback]
$creadListPrec :: ReadPrec [Feedback]
readPrec :: ReadPrec Feedback
$creadPrec :: ReadPrec Feedback
readList :: ReadS [Feedback]
$creadList :: ReadS [Feedback]
readsPrec :: Int -> ReadS Feedback
$creadsPrec :: Int -> ReadS Feedback
Read)

test :: IO ()
test :: IO ()
test = do
  let filename :: [Char]
filename = [Char]
"../google.com!enumeration.eu!1607299200!1607385599.zip"
  ByteString
lbs <- [Char] -> IO ByteString
L.readFile [Char]
filename
  case ByteString -> Maybe Feedback
dmarcFeedbackFromLazy ByteString
lbs of
    Maybe Feedback
Nothing -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn [Char]
"nothing :("
    Just Feedback
x -> IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ Feedback -> [Char]
forall a. Show a => a -> [Char]
show Feedback
x

-- | Parse a DMARC report from a strict 'B.ByteString'
dmarcFeedbackFromStrict :: B.ByteString -> Maybe Feedback
dmarcFeedbackFromStrict :: ByteString -> Maybe Feedback
dmarcFeedbackFromStrict = ByteString -> Maybe Feedback
dmarcFeedbackFromLazy (ByteString -> Maybe Feedback)
-> (ByteString -> ByteString) -> ByteString -> Maybe Feedback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.fromStrict

-- | Parse a DMARC report from a lazy 'L.ByteString'
dmarcFeedbackFromLazy :: L.ByteString -> Maybe Feedback
dmarcFeedbackFromLazy :: ByteString -> Maybe Feedback
dmarcFeedbackFromLazy ByteString
lbs = do
  Element
doc <- ByteString -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc (ByteString -> ByteString
uncompressString ByteString
lbs)
  Element -> Maybe Feedback
processXml Element
doc

-- | Parse a DMARC report from an XML document
dmarcFeedbackFromXml :: Element -> Maybe Feedback
dmarcFeedbackFromXml = Element -> Maybe Feedback
processXml

-- | Parse a DMARC report from an XML document (also: 'dmarcFeedbackFromXml')
processXml :: Element -> Maybe Feedback
processXml :: Element -> Maybe Feedback
processXml Element
root =
  let strContent' :: Element -> Text
strContent' = [Char] -> Text
T.pack ([Char] -> Text) -> (Element -> [Char]) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> [Char]
strContent
      reportMetadata :: Maybe Element
reportMetadata = QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"report_metadata") Element
root
      policyPublished :: Maybe Element
policyPublished = QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"policy_published") Element
root
      rmOrgName :: Maybe Text
rmOrgName = Element -> Text
strContent' (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"org_name") (Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Element
reportMetadata)
      rmEmail :: Maybe Text
rmEmail = Element -> Text
strContent' (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"email") (Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Element
reportMetadata)
      rmExtraContactInfo :: Maybe Text
rmExtraContactInfo = Element -> Text
strContent' (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"extra_contact_info") (Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Element
reportMetadata)
      rmReportId :: Maybe Integer
rmReportId = [Char] -> Maybe Integer
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Integer) -> Maybe [Char] -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"report_id") (Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Element
reportMetadata)
      rmDateRange :: Maybe (UTCTime, UTCTime)
rmDateRange = do
        Element
rm <- Maybe Element
reportMetadata
        Element
rangee <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"date_range") Element
rm
        Element
begine <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"begin") Element
rangee
        Element
ende <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"end") Element
rangee
        let begins :: [Char]
begins = Element -> [Char]
strContent Element
begine
            ends :: [Char]
ends = Element -> [Char]
strContent Element
ende
        UTCTime
begint <- Bool -> TimeLocale -> [Char] -> [Char] -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale [Char]
"%s" [Char]
begins
        UTCTime
endt <- Bool -> TimeLocale -> [Char] -> [Char] -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> [Char] -> [Char] -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale [Char]
"%s" [Char]
ends
        (UTCTime, UTCTime) -> Maybe (UTCTime, UTCTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (UTCTime
begint, UTCTime
endt)
      mpolicy :: Maybe PolicyPublished
mpolicy = do
        Element
pp <- Maybe Element
policyPublished
        Text
ppDomain <- Element -> Text
strContent' (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"domain") Element
pp
        AlignmentMode
ppDkimAlignment <- (do
          Element
adkim <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"adkim") Element
pp
          [Char] -> Maybe AlignmentMode
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe AlignmentMode) -> [Char] -> Maybe AlignmentMode
forall a b. (a -> b) -> a -> b
$ Element -> [Char]
strContent Element
adkim) Maybe AlignmentMode -> Maybe AlignmentMode -> Maybe AlignmentMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AlignmentMode -> Maybe AlignmentMode
forall a. a -> Maybe a
Just AlignmentMode
Relaxed
        AlignmentMode
ppSpfAlignment <- (do
          Element
aspf <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"spf") Element
pp
          [Char] -> Maybe AlignmentMode
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe AlignmentMode) -> [Char] -> Maybe AlignmentMode
forall a b. (a -> b) -> a -> b
$ Element -> [Char]
strContent Element
aspf) Maybe AlignmentMode -> Maybe AlignmentMode -> Maybe AlignmentMode
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AlignmentMode -> Maybe AlignmentMode
forall a. a -> Maybe a
Just AlignmentMode
Relaxed
        PolicyAction
ppPolicy <- (do
          Element
p <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"p") Element
pp
          [Char] -> Maybe PolicyAction
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe PolicyAction) -> [Char] -> Maybe PolicyAction
forall a b. (a -> b) -> a -> b
$ Element -> [Char]
strContent Element
p) Maybe PolicyAction -> Maybe PolicyAction -> Maybe PolicyAction
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PolicyAction -> Maybe PolicyAction
forall a. a -> Maybe a
Just PolicyAction
NoPolicy
        PolicyAction
ppSubdomainPolicy <- (do
          Element
sp <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"sp") Element
pp
          [Char] -> Maybe PolicyAction
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe PolicyAction) -> [Char] -> Maybe PolicyAction
forall a b. (a -> b) -> a -> b
$ Element -> [Char]
strContent Element
sp) Maybe PolicyAction -> Maybe PolicyAction -> Maybe PolicyAction
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PolicyAction -> Maybe PolicyAction
forall a. a -> Maybe a
Just PolicyAction
NoPolicy
        Int
ppPercent <- (do
          Element
pct <- QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"pct") Element
pp
          [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> [Char] -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Element -> [Char]
strContent Element
pct) Maybe Int -> Maybe Int -> Maybe Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
100
        PolicyPublished -> Maybe PolicyPublished
forall (m :: * -> *) a. Monad m => a -> m a
return PolicyPublished :: Text
-> AlignmentMode
-> AlignmentMode
-> PolicyAction
-> PolicyAction
-> Int
-> PolicyPublished
PolicyPublished{Int
Text
PolicyAction
AlignmentMode
ppPercent :: Int
ppSubdomainPolicy :: PolicyAction
ppPolicy :: PolicyAction
ppSpfAlignment :: AlignmentMode
ppDkimAlignment :: AlignmentMode
ppDomain :: Text
ppPercent :: Int
ppSubdomainPolicy :: PolicyAction
ppPolicy :: PolicyAction
ppSpfAlignment :: AlignmentMode
ppDkimAlignment :: AlignmentMode
ppDomain :: Text
..}
      mpe :: Element -> Maybe PolicyEvaluated
mpe Element
el = do
        PolicyAction
dispo <- ([Char] -> Maybe PolicyAction
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe PolicyAction)
-> Maybe [Char] -> Maybe PolicyAction
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"disposition") Element
el) Maybe PolicyAction -> Maybe PolicyAction -> Maybe PolicyAction
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PolicyAction -> Maybe PolicyAction
forall a. a -> Maybe a
Just PolicyAction
NoPolicy
        AuthResult
dkim <- ([Char] -> Maybe AuthResult
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe AuthResult) -> Maybe [Char] -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"dkim") Element
el) Maybe AuthResult -> Maybe AuthResult -> Maybe AuthResult
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AuthResult -> Maybe AuthResult
forall a. a -> Maybe a
Just AuthResult
NoAuth
        AuthResult
spf <- ([Char] -> Maybe AuthResult
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe AuthResult) -> Maybe [Char] -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"spf") Element
el) Maybe AuthResult -> Maybe AuthResult -> Maybe AuthResult
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> AuthResult -> Maybe AuthResult
forall a. a -> Maybe a
Just AuthResult
NoAuth
        PolicyEvaluated -> Maybe PolicyEvaluated
forall (m :: * -> *) a. Monad m => a -> m a
return (PolicyEvaluated -> Maybe PolicyEvaluated)
-> PolicyEvaluated -> Maybe PolicyEvaluated
forall a b. (a -> b) -> a -> b
$ PolicyAction -> AuthResult -> AuthResult -> PolicyEvaluated
PolicyEvaluated PolicyAction
dispo AuthResult
dkim AuthResult
spf
      mrow :: Element -> Maybe Row
mrow Element
el = do
        PolicyEvaluated
pe <- (Element -> Maybe PolicyEvaluated
mpe (Element -> Maybe PolicyEvaluated)
-> Maybe Element -> Maybe PolicyEvaluated
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"policy_evaluated") Element
el) Maybe PolicyEvaluated
-> Maybe PolicyEvaluated -> Maybe PolicyEvaluated
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> PolicyEvaluated -> Maybe PolicyEvaluated
forall a. a -> Maybe a
Just (PolicyAction -> AuthResult -> AuthResult -> PolicyEvaluated
PolicyEvaluated PolicyAction
NoPolicy AuthResult
NoAuth AuthResult
NoAuth)
        [Char]
sourceip <- Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"source_ip") Element
el
        Int
count <- [Char] -> Maybe Int
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe Int) -> Maybe [Char] -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"count") Element
el)
        Row -> Maybe Row
forall (m :: * -> *) a. Monad m => a -> m a
return (Row -> Maybe Row) -> Row -> Maybe Row
forall a b. (a -> b) -> a -> b
$ [Char] -> Int -> PolicyEvaluated -> Row
Row [Char]
sourceip Int
count PolicyEvaluated
pe
      mda :: Element -> Maybe DkimAuth
mda Element
el = do
        Text
domain <- Element -> Text
strContent' (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"domain") Element
el
        AuthResult
result <- [Char] -> Maybe AuthResult
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe AuthResult) -> Maybe [Char] -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"result") Element
el
        Text
selector <- Element -> Text
strContent' (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"selector") Element
el
        DkimAuth -> Maybe DkimAuth
forall (m :: * -> *) a. Monad m => a -> m a
return (DkimAuth -> Maybe DkimAuth) -> DkimAuth -> Maybe DkimAuth
forall a b. (a -> b) -> a -> b
$ AuthResult -> Text -> Text -> DkimAuth
DkimAuth AuthResult
result Text
domain Text
selector
      msa :: Element -> Maybe SpfAuth
msa Element
el = do
        Text
domain <- Element -> Text
strContent' (Element -> Text) -> Maybe Element -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"domain") Element
el
        AuthResult
result <- [Char] -> Maybe AuthResult
forall a. Read a => [Char] -> Maybe a
readMaybe ([Char] -> Maybe AuthResult) -> Maybe [Char] -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> [Char]
strContent (Element -> [Char]) -> Maybe Element -> Maybe [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"result") Element
el
        SpfAuth -> Maybe SpfAuth
forall (m :: * -> *) a. Monad m => a -> m a
return (SpfAuth -> Maybe SpfAuth) -> SpfAuth -> Maybe SpfAuth
forall a b. (a -> b) -> a -> b
$ AuthResult -> Text -> SpfAuth
SpfAuth AuthResult
result Text
domain
      mrecord :: Element -> Maybe Record
mrecord Element
el = do
        Row
row <- Element -> Maybe Row
mrow (Element -> Maybe Row) -> Maybe Element -> Maybe Row
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"row") Element
el
        let authresults :: Maybe Element
authresults = QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"auth_results") Element
el
        let da :: Maybe DkimAuth
da = Element -> Maybe DkimAuth
mda (Element -> Maybe DkimAuth) -> Maybe Element -> Maybe DkimAuth
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"dkim") (Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Element
authresults
        let sa :: Maybe SpfAuth
sa = Element -> Maybe SpfAuth
msa (Element -> Maybe SpfAuth) -> Maybe Element -> Maybe SpfAuth
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< QName -> Element -> Maybe Element
findChild ([Char] -> QName
unqual [Char]
"spf") (Element -> Maybe Element) -> Maybe Element -> Maybe Element
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe Element
authresults
        Record -> Maybe Record
forall (m :: * -> *) a. Monad m => a -> m a
return (Record -> Maybe Record) -> Record -> Maybe Record
forall a b. (a -> b) -> a -> b
$ Row -> Maybe DkimAuth -> Maybe SpfAuth -> Record
Record Row
row Maybe DkimAuth
da Maybe SpfAuth
sa
  in do
    PolicyPublished
policy <- Maybe PolicyPublished
mpolicy
    let records :: [Record]
records = (Element -> Maybe Record) -> [Element] -> [Record]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Element -> Maybe Record
mrecord ([Element] -> [Record]) -> [Element] -> [Record]
forall a b. (a -> b) -> a -> b
$ QName -> Element -> [Element]
findChildren ([Char] -> QName
unqual [Char]
"record") Element
root
    Feedback -> Maybe Feedback
forall (m :: * -> *) a. Monad m => a -> m a
return (Feedback -> Maybe Feedback) -> Feedback -> Maybe Feedback
forall a b. (a -> b) -> a -> b
$ ReportMetadata -> PolicyPublished -> [Record] -> Feedback
Feedback ReportMetadata :: Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Integer
-> Maybe (UTCTime, UTCTime)
-> ReportMetadata
ReportMetadata{Maybe Integer
Maybe (UTCTime, UTCTime)
Maybe Text
rmDateRange :: Maybe (UTCTime, UTCTime)
rmReportId :: Maybe Integer
rmExtraContactInfo :: Maybe Text
rmEmail :: Maybe Text
rmOrgName :: Maybe Text
rmDateRange :: Maybe (UTCTime, UTCTime)
rmReportId :: Maybe Integer
rmExtraContactInfo :: Maybe Text
rmEmail :: Maybe Text
rmOrgName :: Maybe Text
..} PolicyPublished
policy [Record]
records