{-# 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,
  dmarcFeedbackFromStream,
  dmarcFeedbackFromXml,
  -- * Data types
  Feedback(..),
  ReportMetadata(..),
  Record(..),
  Row(..),
  PolicyPublished(..),
  PolicyEvaluated(..),
  DkimAuth(..),
  SpfAuth(..),
  AuthResult(..),
  IpAddress,
  AlignmentMode(..),
  PolicyAction(..),
  -- * Utility
  uncompressStream
  ) where

import Streaming
import Streaming.Zip
import qualified Streaming.Prelude as S
import qualified Streaming.ByteString as Q
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString as B
import qualified Codec.Archive.Zip as Z
import Control.Monad.IO.Class
import Control.Monad.Trans
import Control.Monad.Trans.Resource
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 stream. If it is neither gzipped or pkzipped, return the stream unmodified.
uncompressStream :: (MonadFail m, MonadIO m) => Q.ByteStream m r -> Q.ByteStream m ()
uncompressStream :: ByteStream m r -> ByteStream m ()
uncompressStream ByteStream m r
stream = do
  ByteString
magic <- m ByteString -> ByteStream m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ByteStream m ByteString)
-> m ByteString -> ByteStream m ByteString
forall a b. (a -> b) -> a -> b
$ ByteStream m () -> m ByteString
forall (m :: * -> *). Monad m => ByteStream m () -> m ByteString
Q.toStrict_ (ByteStream m () -> m ByteString)
-> ByteStream m () -> m ByteString
forall a b. (a -> b) -> a -> b
$ Int64 -> ByteStream m r -> ByteStream m ()
forall (m :: * -> *) r.
Monad m =>
Int64 -> ByteStream m r -> ByteStream m ()
Q.take Int64
2 ByteStream m r
stream
  if ByteString
magic ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"PK"
    then ByteStream m r -> ByteStream m ()
forall (m :: * -> *) r.
MonadFail m =>
ByteStream m r -> ByteStream m ()
pkunzip ByteStream m r
stream
    else if ByteString
magic ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"\x1F\x8b"
         then ByteStream m r -> ByteStream m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ByteStream m r -> ByteStream m ())
-> ByteStream m r -> ByteStream m ()
forall a b. (a -> b) -> a -> b
$ ByteStream m r -> ByteStream m r
forall (m :: * -> *) r.
MonadIO m =>
ByteString m r -> ByteString m r
gunzip ByteStream m r
stream
         else ByteStream m r -> ByteStream m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ByteStream m r
stream
  where pkunzip :: ByteStream m r -> ByteStream m ()
pkunzip ByteStream m r
stream = do
          ByteString
lbs <- m ByteString -> ByteStream m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m ByteString -> ByteStream m ByteString)
-> m ByteString -> ByteStream m ByteString
forall a b. (a -> b) -> a -> b
$ ByteStream m r -> m ByteString
forall (m :: * -> *) r. Monad m => ByteStream m r -> m ByteString
Q.toLazy_ ByteStream m r
stream
          let a :: Archive
a = ByteString -> Archive
Z.toArchive ByteString
lbs
          case Archive -> [Entry]
Z.zEntries Archive
a of
            [] -> m () -> ByteStream m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ByteStream m ()) -> m () -> ByteStream m ()
forall a b. (a -> b) -> a -> b
$ String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Empty PKZip archive :("
            (Entry
e:[Entry]
_) -> ByteString -> ByteStream m ()
forall (m :: * -> *). Monad m => ByteString -> ByteStream m ()
Q.fromLazy (ByteString -> ByteStream m ()) -> ByteString -> ByteStream m ()
forall a b. (a -> b) -> a -> b
$ 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 -> String
(Int -> ReportMetadata -> ShowS)
-> (ReportMetadata -> String)
-> ([ReportMetadata] -> ShowS)
-> Show ReportMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReportMetadata] -> ShowS
$cshowList :: [ReportMetadata] -> ShowS
show :: ReportMetadata -> String
$cshow :: ReportMetadata -> String
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 -> String
show AlignmentMode
Strict = String
"s"
  show AlignmentMode
Relaxed = String
"r"

instance Read AlignmentMode where
  readsPrec :: Int -> ReadS AlignmentMode
readsPrec Int
_ String
r =
    [(AlignmentMode
Strict,String
s) | (String
"s",String
s) <- ReadS String
lex String
r]
    [(AlignmentMode, String)]
-> [(AlignmentMode, String)] -> [(AlignmentMode, String)]
forall a. [a] -> [a] -> [a]
++[(AlignmentMode
Relaxed,String
s) | (String
"r",String
s) <- ReadS String
lex String
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 -> String
show PolicyAction
NoPolicy = String
"none"
  show PolicyAction
Quarantine = String
"quarantine"
  show PolicyAction
Reject = String
"reject"

instance Read PolicyAction where
  readsPrec :: Int -> ReadS PolicyAction
readsPrec Int
_ String
r =
    [(PolicyAction
NoPolicy,String
s) | (String
"none",String
s) <- ReadS String
lex String
r]
    [(PolicyAction, String)]
-> [(PolicyAction, String)] -> [(PolicyAction, String)]
forall a. [a] -> [a] -> [a]
++[(PolicyAction
Quarantine,String
s) | (String
"quarantine",String
s) <- ReadS String
lex String
r]
    [(PolicyAction, String)]
-> [(PolicyAction, String)] -> [(PolicyAction, String)]
forall a. [a] -> [a] -> [a]
++[(PolicyAction
Reject,String
s) | (String
"reject",String
s) <- ReadS String
lex String
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 -> String
(Int -> PolicyPublished -> ShowS)
-> (PolicyPublished -> String)
-> ([PolicyPublished] -> ShowS)
-> Show PolicyPublished
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyPublished] -> ShowS
$cshowList :: [PolicyPublished] -> ShowS
show :: PolicyPublished -> String
$cshow :: PolicyPublished -> String
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 -> String
show AuthResult
NoAuth = String
"none"
  show AuthResult
AuthPass = String
"pass"
  show AuthResult
AuthFail = String
"fail"
  show AuthResult
TempError = String
"temperror"
  show AuthResult
PermError = String
"permerror"
  show AuthResult
AuthNeutral = String
"neutral"
  show AuthResult
AuthPolicy = String
"policy"
  show AuthResult
SoftFail = String
"softfail"

instance Read AuthResult where
  readsPrec :: Int -> ReadS AuthResult
readsPrec Int
_ String
r =
    [(AuthResult
NoAuth,String
s) | (String
"none",String
s) <- ReadS String
lex String
r]
    [(AuthResult, String)]
-> [(AuthResult, String)] -> [(AuthResult, String)]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthPass,String
s) | (String
"pass",String
s) <- ReadS String
lex String
r]
    [(AuthResult, String)]
-> [(AuthResult, String)] -> [(AuthResult, String)]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthFail,String
s) | (String
"fail",String
s) <- ReadS String
lex String
r]
    [(AuthResult, String)]
-> [(AuthResult, String)] -> [(AuthResult, String)]
forall a. [a] -> [a] -> [a]
++[(AuthResult
TempError,String
s) | (String
"temperror",String
s) <- ReadS String
lex String
r]
    [(AuthResult, String)]
-> [(AuthResult, String)] -> [(AuthResult, String)]
forall a. [a] -> [a] -> [a]
++[(AuthResult
PermError,String
s) | (String
"permerror",String
s) <- ReadS String
lex String
r]
    [(AuthResult, String)]
-> [(AuthResult, String)] -> [(AuthResult, String)]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthNeutral,String
s) | (String
"neutral",String
s) <- ReadS String
lex String
r]
    [(AuthResult, String)]
-> [(AuthResult, String)] -> [(AuthResult, String)]
forall a. [a] -> [a] -> [a]
++[(AuthResult
AuthPolicy,String
s) | (String
"policy",String
s) <- ReadS String
lex String
r]
    [(AuthResult, String)]
-> [(AuthResult, String)] -> [(AuthResult, String)]
forall a. [a] -> [a] -> [a]
++[(AuthResult
SoftFail,String
s) | (String
"softfail",String
s) <- ReadS String
lex String
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 -> String
(Int -> PolicyEvaluated -> ShowS)
-> (PolicyEvaluated -> String)
-> ([PolicyEvaluated] -> ShowS)
-> Show PolicyEvaluated
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyEvaluated] -> ShowS
$cshowList :: [PolicyEvaluated] -> ShowS
show :: PolicyEvaluated -> String
$cshow :: PolicyEvaluated -> String
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 -> String
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 -> String
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
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 -> String
(Int -> Record -> ShowS)
-> (Record -> String) -> ([Record] -> ShowS) -> Show Record
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Record] -> ShowS
$cshowList :: [Record] -> ShowS
show :: Record -> String
$cshow :: Record -> String
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 -> String
(Int -> DkimAuth -> ShowS)
-> (DkimAuth -> String) -> ([DkimAuth] -> ShowS) -> Show DkimAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DkimAuth] -> ShowS
$cshowList :: [DkimAuth] -> ShowS
show :: DkimAuth -> String
$cshow :: DkimAuth -> String
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 -> String
(Int -> SpfAuth -> ShowS)
-> (SpfAuth -> String) -> ([SpfAuth] -> ShowS) -> Show SpfAuth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpfAuth] -> ShowS
$cshowList :: [SpfAuth] -> ShowS
show :: SpfAuth -> String
$cshow :: SpfAuth -> String
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 -> String
(Int -> Feedback -> ShowS)
-> (Feedback -> String) -> ([Feedback] -> ShowS) -> Show Feedback
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Feedback] -> ShowS
$cshowList :: [Feedback] -> ShowS
show :: Feedback -> String
$cshow :: Feedback -> String
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)

-- | Gets an XML document root from a streaming bytestring
xmlFromStream :: (MonadFail m, MonadIO m) => Q.ByteStream m r -> m (Maybe Element)
xmlFromStream :: ByteStream m r -> m (Maybe Element)
xmlFromStream ByteStream m r
stream = do
  let stream' :: ByteStream m ()
stream' = ByteStream m r -> ByteStream m ()
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> ByteStream m ()
uncompressStream ByteStream m r
stream
  ByteString
lbs <- ByteStream m () -> m ByteString
forall (m :: * -> *) r. Monad m => ByteStream m r -> m ByteString
Q.toLazy_ ByteStream m ()
stream'
  Maybe Element -> m (Maybe Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Element -> m (Maybe Element))
-> Maybe Element -> m (Maybe Element)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Element
forall s. XmlSource s => s -> Maybe Element
parseXMLDoc ByteString
lbs

test :: IO ()
test :: IO ()
test = do
  let filename :: String
filename = String
"../google.com!enumeration.eu!1607299200!1607385599.zip"
  ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Maybe Feedback
mfb <- ByteStream (ResourceT IO) () -> ResourceT IO (Maybe Feedback)
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> m (Maybe Feedback)
dmarcFeedbackFromStream (ByteStream (ResourceT IO) () -> ResourceT IO (Maybe Feedback))
-> ByteStream (ResourceT IO) () -> ResourceT IO (Maybe Feedback)
forall a b. (a -> b) -> a -> b
$ String -> ByteStream (ResourceT IO) ()
forall (m :: * -> *). MonadResource m => String -> ByteStream m ()
Q.readFile String
filename
    case Maybe Feedback
mfb of
      Maybe Feedback
Nothing -> IO () -> ResourceT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn String
"nothing :("
      Just Feedback
x -> IO () -> ResourceT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Feedback -> String
forall a. Show a => a -> String
show Feedback
x

-- | Parse a DMARC report from a 'Q.ByteStream'
dmarcFeedbackFromStream :: (MonadFail m, MonadIO m) => Q.ByteStream m r -> m (Maybe Feedback)
dmarcFeedbackFromStream :: ByteStream m r -> m (Maybe Feedback)
dmarcFeedbackFromStream ByteStream m r
stream = do
  Maybe Element
mxml <- ByteStream m r -> m (Maybe Element)
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> m (Maybe Element)
xmlFromStream ByteStream m r
stream
  Maybe Feedback -> m (Maybe Feedback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Feedback -> m (Maybe Feedback))
-> Maybe Feedback -> m (Maybe Feedback)
forall a b. (a -> b) -> a -> b
$ Maybe Element
mxml Maybe Element -> (Element -> Maybe Feedback) -> Maybe Feedback
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Element -> Maybe Feedback
processXml

-- | Parse a DMARC report from a strict 'B.ByteString'
dmarcFeedbackFromStrict :: B.ByteString -> Maybe Feedback
dmarcFeedbackFromStrict :: ByteString -> Maybe Feedback
dmarcFeedbackFromStrict = IO (Maybe Feedback) -> Maybe Feedback
forall a. IO a -> a
unsafePerformIO (IO (Maybe Feedback) -> Maybe Feedback)
-> (ByteString -> IO (Maybe Feedback))
-> ByteString
-> Maybe Feedback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStream IO () -> IO (Maybe Feedback)
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> m (Maybe Feedback)
dmarcFeedbackFromStream (ByteStream IO () -> IO (Maybe Feedback))
-> (ByteString -> ByteStream IO ())
-> ByteString
-> IO (Maybe Feedback)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStream IO ()
forall (m :: * -> *). ByteString -> ByteStream m ()
Q.fromStrict

-- | Parse a DMARC report from a lazy 'L.ByteString'
dmarcFeedbackFromLazy :: L.ByteString -> Maybe Feedback
dmarcFeedbackFromLazy :: ByteString -> Maybe Feedback
dmarcFeedbackFromLazy = IO (Maybe Feedback) -> Maybe Feedback
forall a. IO a -> a
unsafePerformIO (IO (Maybe Feedback) -> Maybe Feedback)
-> (ByteString -> IO (Maybe Feedback))
-> ByteString
-> Maybe Feedback
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStream IO () -> IO (Maybe Feedback)
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> m (Maybe Feedback)
dmarcFeedbackFromStream (ByteStream IO () -> IO (Maybe Feedback))
-> (ByteString -> ByteStream IO ())
-> ByteString
-> IO (Maybe Feedback)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStream IO ()
forall (m :: * -> *). Monad m => ByteString -> ByteStream m ()
Q.fromLazy

-- | 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' = String -> Text
T.pack (String -> Text) -> (Element -> String) -> Element -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> String
strContent
      reportMetadata :: Maybe Element
reportMetadata = QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"report_metadata") Element
root
      policyPublished :: Maybe Element
policyPublished = QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 (String -> QName
unqual String
"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 (String -> QName
unqual String
"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 (String -> QName
unqual String
"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 = String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Integer) -> Maybe String -> Maybe Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 (String -> QName
unqual String
"date_range") Element
rm
        Element
begine <- QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"begin") Element
rangee
        Element
ende <- QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"end") Element
rangee
        let begins :: String
begins = Element -> String
strContent Element
begine
            ends :: String
ends = Element -> String
strContent Element
ende
        UTCTime
begint <- Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%s" String
begins
        UTCTime
endt <- Bool -> TimeLocale -> String -> String -> Maybe UTCTime
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%s" String
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 (String -> QName
unqual String
"domain") Element
pp
        AlignmentMode
ppDkimAlignment <- (do
          Element
adkim <- QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"adkim") Element
pp
          String -> Maybe AlignmentMode
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe AlignmentMode) -> String -> Maybe AlignmentMode
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (String -> QName
unqual String
"spf") Element
pp
          String -> Maybe AlignmentMode
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe AlignmentMode) -> String -> Maybe AlignmentMode
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (String -> QName
unqual String
"p") Element
pp
          String -> Maybe PolicyAction
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe PolicyAction) -> String -> Maybe PolicyAction
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (String -> QName
unqual String
"sp") Element
pp
          String -> Maybe PolicyAction
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe PolicyAction) -> String -> Maybe PolicyAction
forall a b. (a -> b) -> a -> b
$ Element -> String
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 (String -> QName
unqual String
"pct") Element
pp
          String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> String -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Element -> String
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 <- (String -> Maybe PolicyAction
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe PolicyAction)
-> Maybe String -> Maybe PolicyAction
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 <- (String -> Maybe AuthResult
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe AuthResult) -> Maybe String -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 <- (String -> Maybe AuthResult
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe AuthResult) -> Maybe String -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 (String -> QName
unqual String
"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)
        String
sourceip <- Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"source_ip") Element
el
        Int
count <- String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> Maybe String -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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
$ String -> Int -> PolicyEvaluated -> Row
Row String
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 (String -> QName
unqual String
"domain") Element
el
        AuthResult
result <- String -> Maybe AuthResult
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe AuthResult) -> Maybe String -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 (String -> QName
unqual String
"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 (String -> QName
unqual String
"domain") Element
el
        AuthResult
result <- String -> Maybe AuthResult
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe AuthResult) -> Maybe String -> Maybe AuthResult
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Element -> String
strContent (Element -> String) -> Maybe Element -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 (String -> QName
unqual String
"row") Element
el
        let authresults :: Maybe Element
authresults = QName -> Element -> Maybe Element
findChild (String -> QName
unqual String
"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 (String -> QName
unqual String
"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 (String -> QName
unqual String
"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 (String -> QName
unqual String
"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