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

-- | Utilities for parsing an SMTP-TLRPT aggregated report, following RFC 8460. These functions also handle decompression (gzip or pkzip)

module Data.Mail.TLSRPT.Reports (
  -- * Parsers
  tlsReportFromStrict,
  tlsReportFromLazy,
  tlsReportFromStream,
  tlsReportFromJson,
  -- * Data types
  Report(..),
  Policy(..),
  PolicyDesc(..),
  FailureDetails(..),
  IpAddress,
  PolicySummary(..),
  PolicyType(..),
  ResultType(..)
  ) where

import Data.Mail.DMARC.Reports (uncompressStream)
import Streaming
import qualified Streaming.Prelude as S
import Data.Aeson
import Data.Aeson.Types
import Data.Time.Clock
import Data.Time.Format
import qualified Data.Text as T
import Text.Read (readMaybe)
import Data.Aeson.Encoding (string)
import qualified Streaming.ByteString as Q
import Control.Monad.Trans.Resource
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import System.IO.Unsafe

type IpAddress = String

data PolicyType = NoPolicyFound -- ^ neither MTA-STS nor DANE
                | TlsaPolicy    -- ^ DANE policy (TLSA record)
                | StsPolicy     -- ^ MTA-STS policy
                deriving (PolicyType -> PolicyType -> Bool
(PolicyType -> PolicyType -> Bool)
-> (PolicyType -> PolicyType -> Bool) -> Eq PolicyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyType -> PolicyType -> Bool
$c/= :: PolicyType -> PolicyType -> Bool
== :: PolicyType -> PolicyType -> Bool
$c== :: PolicyType -> PolicyType -> Bool
Eq)

instance Show PolicyType where
  show :: PolicyType -> String
show PolicyType
NoPolicyFound = String
"no-policy-found"
  show PolicyType
TlsaPolicy = String
"tlsa"
  show PolicyType
StsPolicy = String
"sts"

instance Read PolicyType where
  readsPrec :: Int -> ReadS PolicyType
readsPrec Int
_ String
r =
    [(PolicyType
NoPolicyFound,String
s) | (String
"no-policy-found",String
s) <- String -> [(String, String)]
lex' String
r]
    [(PolicyType, String)]
-> [(PolicyType, String)] -> [(PolicyType, String)]
forall a. [a] -> [a] -> [a]
++[(PolicyType
TlsaPolicy,String
s) | (String
"tlsa",String
s) <- String -> [(String, String)]
lex' String
r]
    [(PolicyType, String)]
-> [(PolicyType, String)] -> [(PolicyType, String)]
forall a. [a] -> [a] -> [a]
++[(PolicyType
StsPolicy,String
s) | (String
"sts",String
s) <- String -> [(String, String)]
lex' String
r]

instance ToJSON PolicyType where
  toJSON :: PolicyType -> Value
toJSON = PolicyType -> Value
forall a. Show a => a -> Value
toJSONShow
  toEncoding :: PolicyType -> Encoding
toEncoding = PolicyType -> Encoding
forall a. Show a => a -> Encoding
toEncodingShow

toJSONShow :: Show a => a -> Value
toJSONShow :: a -> Value
toJSONShow = Text -> Value
String (Text -> Value) -> (a -> Text) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

toEncodingShow :: Show a => a -> Encoding
toEncodingShow :: a -> Encoding
toEncodingShow = String -> Encoding
forall a. String -> Encoding' a
string (String -> Encoding) -> (a -> String) -> a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

instance FromJSON PolicyType where
  parseJSON :: Value -> Parser PolicyType
parseJSON = String -> Value -> Parser PolicyType
forall a. Read a => String -> Value -> Parser a
parseJSONRead String
"PolicyType"

parseJSONRead :: Read a => String -> Value -> Parser a
parseJSONRead :: String -> Value -> Parser a
parseJSONRead String
desc = String -> (Text -> Parser a) -> Value -> Parser a
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
desc ((Text -> Parser a) -> Value -> Parser a)
-> (Text -> Parser a) -> Value -> Parser a
forall a b. (a -> b) -> a -> b
$ \Text
t ->
  case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) of
    Maybe a
Nothing -> String -> Value -> Parser a
forall a. String -> Value -> Parser a
typeMismatch String
desc (Text -> Value
String Text
t)
    Just a
a -> a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Description of the evaluated policy
data PolicyDesc = PolicyDesc {
  -- | Policy type (DANE or MTA-STS)
  PolicyDesc -> PolicyType
pdPolicyType :: PolicyType,
  -- | Applied policy as strings
  PolicyDesc -> [Text]
pdPolicyString :: [T.Text],
  -- | domain (if punycode: A-labels, not U-labels)
  PolicyDesc -> Text
pdPolicyDomain :: T.Text,
  -- | if MTA-STS, then this is a list of mx host patterns
  PolicyDesc -> [Text]
pdMxHost :: [T.Text]
  } deriving (PolicyDesc -> PolicyDesc -> Bool
(PolicyDesc -> PolicyDesc -> Bool)
-> (PolicyDesc -> PolicyDesc -> Bool) -> Eq PolicyDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicyDesc -> PolicyDesc -> Bool
$c/= :: PolicyDesc -> PolicyDesc -> Bool
== :: PolicyDesc -> PolicyDesc -> Bool
$c== :: PolicyDesc -> PolicyDesc -> Bool
Eq, Int -> PolicyDesc -> ShowS
[PolicyDesc] -> ShowS
PolicyDesc -> String
(Int -> PolicyDesc -> ShowS)
-> (PolicyDesc -> String)
-> ([PolicyDesc] -> ShowS)
-> Show PolicyDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicyDesc] -> ShowS
$cshowList :: [PolicyDesc] -> ShowS
show :: PolicyDesc -> String
$cshow :: PolicyDesc -> String
showsPrec :: Int -> PolicyDesc -> ShowS
$cshowsPrec :: Int -> PolicyDesc -> ShowS
Show, ReadPrec [PolicyDesc]
ReadPrec PolicyDesc
Int -> ReadS PolicyDesc
ReadS [PolicyDesc]
(Int -> ReadS PolicyDesc)
-> ReadS [PolicyDesc]
-> ReadPrec PolicyDesc
-> ReadPrec [PolicyDesc]
-> Read PolicyDesc
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PolicyDesc]
$creadListPrec :: ReadPrec [PolicyDesc]
readPrec :: ReadPrec PolicyDesc
$creadPrec :: ReadPrec PolicyDesc
readList :: ReadS [PolicyDesc]
$creadList :: ReadS [PolicyDesc]
readsPrec :: Int -> ReadS PolicyDesc
$creadsPrec :: Int -> ReadS PolicyDesc
Read)

instance ToJSON PolicyDesc where
  toJSON :: PolicyDesc -> Value
toJSON PolicyDesc{[Text]
Text
PolicyType
pdMxHost :: [Text]
pdPolicyDomain :: Text
pdPolicyString :: [Text]
pdPolicyType :: PolicyType
pdMxHost :: PolicyDesc -> [Text]
pdPolicyDomain :: PolicyDesc -> Text
pdPolicyString :: PolicyDesc -> [Text]
pdPolicyType :: PolicyDesc -> PolicyType
..} =
    [Pair] -> Value
object [Text
"policy-type" Text -> PolicyType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PolicyType
pdPolicyType,
            Text
"policy-string" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
pdPolicyString,
            Text
"policy-domain" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
pdPolicyDomain,
            Text
"mx-host" Text -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
pdMxHost]
  toEncoding :: PolicyDesc -> Encoding
toEncoding PolicyDesc{[Text]
Text
PolicyType
pdMxHost :: [Text]
pdPolicyDomain :: Text
pdPolicyString :: [Text]
pdPolicyType :: PolicyType
pdMxHost :: PolicyDesc -> [Text]
pdPolicyDomain :: PolicyDesc -> Text
pdPolicyString :: PolicyDesc -> [Text]
pdPolicyType :: PolicyDesc -> PolicyType
..} =
    Series -> Encoding
pairs (Text
"policy-type" Text -> PolicyType -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PolicyType
pdPolicyType Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
           Text
"policy-string" Text -> [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
pdPolicyString Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
           Text
"policy-domain" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
pdPolicyDomain Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
           Text
"mx-host" Text -> [Text] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Text]
pdMxHost)

instance FromJSON PolicyDesc where
  parseJSON :: Value -> Parser PolicyDesc
parseJSON = String
-> (Object -> Parser PolicyDesc) -> Value -> Parser PolicyDesc
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PolicyDesc" ((Object -> Parser PolicyDesc) -> Value -> Parser PolicyDesc)
-> (Object -> Parser PolicyDesc) -> Value -> Parser PolicyDesc
forall a b. (a -> b) -> a -> b
$
    \Object
o -> PolicyType -> [Text] -> Text -> [Text] -> PolicyDesc
PolicyDesc
          (PolicyType -> [Text] -> Text -> [Text] -> PolicyDesc)
-> Parser PolicyType
-> Parser ([Text] -> Text -> [Text] -> PolicyDesc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser PolicyType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"policy-type"
          Parser ([Text] -> Text -> [Text] -> PolicyDesc)
-> Parser [Text] -> Parser (Text -> [Text] -> PolicyDesc)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"policy-string" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []
          Parser (Text -> [Text] -> PolicyDesc)
-> Parser Text -> Parser ([Text] -> PolicyDesc)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"policy-domain"
          Parser ([Text] -> PolicyDesc) -> Parser [Text] -> Parser PolicyDesc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"mx-host" Parser (Maybe [Text]) -> [Text] -> Parser [Text]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

-- | Summary of policy evaluation
data PolicySummary = PolicySummary {
  -- | Successful sessions
  PolicySummary -> Int
psTotalSuccessfulSessionCount :: Int,
  -- | Failed sessions
  PolicySummary -> Int
psTotalFailureSessionCount :: Int
  } deriving (PolicySummary -> PolicySummary -> Bool
(PolicySummary -> PolicySummary -> Bool)
-> (PolicySummary -> PolicySummary -> Bool) -> Eq PolicySummary
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PolicySummary -> PolicySummary -> Bool
$c/= :: PolicySummary -> PolicySummary -> Bool
== :: PolicySummary -> PolicySummary -> Bool
$c== :: PolicySummary -> PolicySummary -> Bool
Eq, Int -> PolicySummary -> ShowS
[PolicySummary] -> ShowS
PolicySummary -> String
(Int -> PolicySummary -> ShowS)
-> (PolicySummary -> String)
-> ([PolicySummary] -> ShowS)
-> Show PolicySummary
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PolicySummary] -> ShowS
$cshowList :: [PolicySummary] -> ShowS
show :: PolicySummary -> String
$cshow :: PolicySummary -> String
showsPrec :: Int -> PolicySummary -> ShowS
$cshowsPrec :: Int -> PolicySummary -> ShowS
Show, ReadPrec [PolicySummary]
ReadPrec PolicySummary
Int -> ReadS PolicySummary
ReadS [PolicySummary]
(Int -> ReadS PolicySummary)
-> ReadS [PolicySummary]
-> ReadPrec PolicySummary
-> ReadPrec [PolicySummary]
-> Read PolicySummary
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PolicySummary]
$creadListPrec :: ReadPrec [PolicySummary]
readPrec :: ReadPrec PolicySummary
$creadPrec :: ReadPrec PolicySummary
readList :: ReadS [PolicySummary]
$creadList :: ReadS [PolicySummary]
readsPrec :: Int -> ReadS PolicySummary
$creadsPrec :: Int -> ReadS PolicySummary
Read)

instance ToJSON PolicySummary where
  toJSON :: PolicySummary -> Value
toJSON PolicySummary{Int
psTotalFailureSessionCount :: Int
psTotalSuccessfulSessionCount :: Int
psTotalFailureSessionCount :: PolicySummary -> Int
psTotalSuccessfulSessionCount :: PolicySummary -> Int
..} =
    [Pair] -> Value
object [Text
"total-successful-session-count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
psTotalSuccessfulSessionCount,
            Text
"total-failure-session-count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
psTotalFailureSessionCount]
  toEncoding :: PolicySummary -> Encoding
toEncoding PolicySummary{Int
psTotalFailureSessionCount :: Int
psTotalSuccessfulSessionCount :: Int
psTotalFailureSessionCount :: PolicySummary -> Int
psTotalSuccessfulSessionCount :: PolicySummary -> Int
..} =
    Series -> Encoding
pairs (Text
"total-successful-session-count" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
psTotalSuccessfulSessionCount Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
           Text
"total-failure-session-count" Text -> Int -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
psTotalFailureSessionCount)

instance FromJSON PolicySummary where
  parseJSON :: Value -> Parser PolicySummary
parseJSON = String
-> (Object -> Parser PolicySummary)
-> Value
-> Parser PolicySummary
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"PolicySummary" ((Object -> Parser PolicySummary) -> Value -> Parser PolicySummary)
-> (Object -> Parser PolicySummary)
-> Value
-> Parser PolicySummary
forall a b. (a -> b) -> a -> b
$
    \Object
o -> Int -> Int -> PolicySummary
PolicySummary
          (Int -> Int -> PolicySummary)
-> Parser Int -> Parser (Int -> PolicySummary)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"total-successful-session-count"
          Parser (Int -> PolicySummary) -> Parser Int -> Parser PolicySummary
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"total-failure-session-count"

-- | Failure types
data ResultType = StarttlsNotSupported -- ^ recipient MX did not support STARTTLS
                | CertificateHostMismatch -- ^ MX hostname does not match any of the subject alternative names in the certificate
                | CertificateExpired -- ^ certificate has expired
                | CertificateNotTrusted -- ^ certificate is not signed by any trusted CA
                | ValidationFailure -- ^ general negotiation failure (other)
                | TlsaInvalid -- ^ validation error in the TLSA record
                | DnssecInvalid -- ^ no valid records were returned from the recursive resolver
                | DaneRequired -- ^ sending system is configured to require DANE TLSA records for all the MX hosts of the destination domain, but no DNSSEC-validated TLSA records were present for the MX host
                | StsPolicyFetchError -- ^ failure to retrieve an MTA-STS policy (e.g. host unreachable)
                | StsPolicyInvalid -- ^ validation error for the overall MTA-STS policy
                | StsWebpkiInvalid -- ^ MTA-STS policy could not be authenticated using PKIX validation
                deriving (ResultType -> ResultType -> Bool
(ResultType -> ResultType -> Bool)
-> (ResultType -> ResultType -> Bool) -> Eq ResultType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResultType -> ResultType -> Bool
$c/= :: ResultType -> ResultType -> Bool
== :: ResultType -> ResultType -> Bool
$c== :: ResultType -> ResultType -> Bool
Eq)

instance Show ResultType where
  show :: ResultType -> String
show ResultType
StarttlsNotSupported = String
"starttls-not-supported"
  show ResultType
CertificateHostMismatch = String
"certificate-host-mismatch"
  show ResultType
CertificateExpired = String
"certificate-expired"
  show ResultType
CertificateNotTrusted = String
"certificate-not-trusted"
  show ResultType
ValidationFailure = String
"validation-failure"
  show ResultType
TlsaInvalid = String
"tlsa-invalid"
  show ResultType
DnssecInvalid = String
"dnssec-invalid"
  show ResultType
DaneRequired = String
"dane-required"
  show ResultType
StsPolicyFetchError = String
"sts-policy-fetch-error"
  show ResultType
StsPolicyInvalid = String
"sts-policy-invalid"
  show ResultType
StsWebpkiInvalid = String
"sts-webpki-invalid"

instance Read ResultType where
  readsPrec :: Int -> ReadS ResultType
readsPrec Int
_ String
r =
    [(ResultType
rt,String
s)
    | (String
w,String
s) <- String -> [(String, String)]
lex' String
r,
      let rt :: ResultType
rt = case String
w of
            String
"starttls-not-supported" -> ResultType
StarttlsNotSupported
            String
"certificate-host-mismatch" -> ResultType
CertificateHostMismatch
            String
"certificate-expired" -> ResultType
CertificateExpired
            String
"certificate-not-trusted" -> ResultType
CertificateNotTrusted
            String
"validation-failure" -> ResultType
ValidationFailure
            String
"tlsa-invalid" -> ResultType
TlsaInvalid
            String
"dnssec-invalid" -> ResultType
DnssecInvalid
            String
"dane-required" -> ResultType
DaneRequired
            String
"sts-policy-fetch-error" -> ResultType
StsPolicyFetchError
            String
"sts-policy-invalid" -> ResultType
StsPolicyInvalid
            String
"sts-webpki-invalid" -> ResultType
StsWebpkiInvalid]

lex' :: String -> [(String, String)]
lex' String
r = [(Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (\Char
c -> Char
c Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char
'-'Char -> ShowS
forall a. a -> [a] -> [a]
:[Char
'a'..Char
'z'])) String
r]
      
instance FromJSON ResultType where
  parseJSON :: Value -> Parser ResultType
parseJSON = String -> Value -> Parser ResultType
forall a. Read a => String -> Value -> Parser a
parseJSONRead String
"ResultType"

instance ToJSON ResultType where
  toJSON :: ResultType -> Value
toJSON = ResultType -> Value
forall a. Show a => a -> Value
toJSONShow
  toEncoding :: ResultType -> Encoding
toEncoding = ResultType -> Encoding
forall a. Show a => a -> Encoding
toEncodingShow

data FailureDetails = FailureDetails {
  FailureDetails -> ResultType
fdResultType :: ResultType,             -- ^ failure type
  FailureDetails -> String
fdSendingMtaIp :: IpAddress,            -- ^ address of the sending MTA
  FailureDetails -> Text
fdReceivingMxHostname :: T.Text,        -- ^ hostname of the receiving MTA MX record
  FailureDetails -> Maybe Text
fdReceivingMxHelo :: Maybe T.Text,      -- ^ the HELO or EHLO string from thte banner announced during the reported session
  FailureDetails -> String
fdReceivingIp :: IpAddress,             -- ^ destination IP address
  FailureDetails -> Int
fdFailedSessionCount :: Int,            -- ^ number of attempted sessions that match the result type
  FailureDetails -> Maybe Text
fdAdditionalInformation :: Maybe T.Text,-- ^ URI that points to additional information
  FailureDetails -> Maybe Text
fdFailureReasonCode :: Maybe T.Text     -- ^ failure code, esp. useful if result type is validation-failure
  } deriving (FailureDetails -> FailureDetails -> Bool
(FailureDetails -> FailureDetails -> Bool)
-> (FailureDetails -> FailureDetails -> Bool) -> Eq FailureDetails
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailureDetails -> FailureDetails -> Bool
$c/= :: FailureDetails -> FailureDetails -> Bool
== :: FailureDetails -> FailureDetails -> Bool
$c== :: FailureDetails -> FailureDetails -> Bool
Eq, Int -> FailureDetails -> ShowS
[FailureDetails] -> ShowS
FailureDetails -> String
(Int -> FailureDetails -> ShowS)
-> (FailureDetails -> String)
-> ([FailureDetails] -> ShowS)
-> Show FailureDetails
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailureDetails] -> ShowS
$cshowList :: [FailureDetails] -> ShowS
show :: FailureDetails -> String
$cshow :: FailureDetails -> String
showsPrec :: Int -> FailureDetails -> ShowS
$cshowsPrec :: Int -> FailureDetails -> ShowS
Show, ReadPrec [FailureDetails]
ReadPrec FailureDetails
Int -> ReadS FailureDetails
ReadS [FailureDetails]
(Int -> ReadS FailureDetails)
-> ReadS [FailureDetails]
-> ReadPrec FailureDetails
-> ReadPrec [FailureDetails]
-> Read FailureDetails
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FailureDetails]
$creadListPrec :: ReadPrec [FailureDetails]
readPrec :: ReadPrec FailureDetails
$creadPrec :: ReadPrec FailureDetails
readList :: ReadS [FailureDetails]
$creadList :: ReadS [FailureDetails]
readsPrec :: Int -> ReadS FailureDetails
$creadsPrec :: Int -> ReadS FailureDetails
Read)

instance ToJSON FailureDetails where
  toJSON :: FailureDetails -> Value
toJSON FailureDetails{Int
String
Maybe Text
Text
ResultType
fdFailureReasonCode :: Maybe Text
fdAdditionalInformation :: Maybe Text
fdFailedSessionCount :: Int
fdReceivingIp :: String
fdReceivingMxHelo :: Maybe Text
fdReceivingMxHostname :: Text
fdSendingMtaIp :: String
fdResultType :: ResultType
fdFailureReasonCode :: FailureDetails -> Maybe Text
fdAdditionalInformation :: FailureDetails -> Maybe Text
fdFailedSessionCount :: FailureDetails -> Int
fdReceivingIp :: FailureDetails -> String
fdReceivingMxHelo :: FailureDetails -> Maybe Text
fdReceivingMxHostname :: FailureDetails -> Text
fdSendingMtaIp :: FailureDetails -> String
fdResultType :: FailureDetails -> ResultType
..} =
    [Pair] -> Value
object ([Text
"result-type" Text -> ResultType -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResultType
fdResultType,
             Text
"sending-mta-ip" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
fdSendingMtaIp,
             Text
"receiving-mx-hostname" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
fdReceivingMxHostname,
             Text
"receiving-ip" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
fdReceivingIp,
             Text
"failed-session-count" Text -> Int -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Int
fdFailedSessionCount]
             [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++[Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
h -> [Text
"receiving-mx-helo" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
h]) Maybe Text
fdReceivingMxHelo
             [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++[Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
h -> [Text
"additional-information" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
h]) Maybe Text
fdAdditionalInformation
             [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++[Pair] -> (Text -> [Pair]) -> Maybe Text -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
h -> [Text
"failure-reason-code" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
h]) Maybe Text
fdFailureReasonCode)

instance FromJSON FailureDetails where
  parseJSON :: Value -> Parser FailureDetails
parseJSON = String
-> (Object -> Parser FailureDetails)
-> Value
-> Parser FailureDetails
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"FailureDetails" ((Object -> Parser FailureDetails)
 -> Value -> Parser FailureDetails)
-> (Object -> Parser FailureDetails)
-> Value
-> Parser FailureDetails
forall a b. (a -> b) -> a -> b
$
    \Object
o -> ResultType
-> String
-> Text
-> Maybe Text
-> String
-> Int
-> Maybe Text
-> Maybe Text
-> FailureDetails
FailureDetails
          (ResultType
 -> String
 -> Text
 -> Maybe Text
 -> String
 -> Int
 -> Maybe Text
 -> Maybe Text
 -> FailureDetails)
-> Parser ResultType
-> Parser
     (String
      -> Text
      -> Maybe Text
      -> String
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> FailureDetails)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser ResultType
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"result-type"
          Parser
  (String
   -> Text
   -> Maybe Text
   -> String
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> FailureDetails)
-> Parser String
-> Parser
     (Text
      -> Maybe Text
      -> String
      -> Int
      -> Maybe Text
      -> Maybe Text
      -> FailureDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sending-mta-ip"
          Parser
  (Text
   -> Maybe Text
   -> String
   -> Int
   -> Maybe Text
   -> Maybe Text
   -> FailureDetails)
-> Parser Text
-> Parser
     (Maybe Text
      -> String -> Int -> Maybe Text -> Maybe Text -> FailureDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"receiving-mx-hostname"
          Parser
  (Maybe Text
   -> String -> Int -> Maybe Text -> Maybe Text -> FailureDetails)
-> Parser (Maybe Text)
-> Parser
     (String -> Int -> Maybe Text -> Maybe Text -> FailureDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"receiving-mx-helo"
          Parser
  (String -> Int -> Maybe Text -> Maybe Text -> FailureDetails)
-> Parser String
-> Parser (Int -> Maybe Text -> Maybe Text -> FailureDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"receiving-ip"
          Parser (Int -> Maybe Text -> Maybe Text -> FailureDetails)
-> Parser Int
-> Parser (Maybe Text -> Maybe Text -> FailureDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"failed-session-count"
          Parser (Maybe Text -> Maybe Text -> FailureDetails)
-> Parser (Maybe Text) -> Parser (Maybe Text -> FailureDetails)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"additional-information"
          Parser (Maybe Text -> FailureDetails)
-> Parser (Maybe Text) -> Parser FailureDetails
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"failure-reason-code"

data Policy = Policy {
  -- | description of the evaluated policy
  Policy -> PolicyDesc
pcPolicy :: PolicyDesc,
  -- | failure/success summary
  Policy -> PolicySummary
pcSummary :: PolicySummary,
  -- | details about failure types
  Policy -> [FailureDetails]
pcFailureDetails :: [FailureDetails]
  } deriving (Policy -> Policy -> Bool
(Policy -> Policy -> Bool)
-> (Policy -> Policy -> Bool) -> Eq Policy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Policy -> Policy -> Bool
$c/= :: Policy -> Policy -> Bool
== :: Policy -> Policy -> Bool
$c== :: Policy -> Policy -> Bool
Eq, Int -> Policy -> ShowS
[Policy] -> ShowS
Policy -> String
(Int -> Policy -> ShowS)
-> (Policy -> String) -> ([Policy] -> ShowS) -> Show Policy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Policy] -> ShowS
$cshowList :: [Policy] -> ShowS
show :: Policy -> String
$cshow :: Policy -> String
showsPrec :: Int -> Policy -> ShowS
$cshowsPrec :: Int -> Policy -> ShowS
Show, ReadPrec [Policy]
ReadPrec Policy
Int -> ReadS Policy
ReadS [Policy]
(Int -> ReadS Policy)
-> ReadS [Policy]
-> ReadPrec Policy
-> ReadPrec [Policy]
-> Read Policy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Policy]
$creadListPrec :: ReadPrec [Policy]
readPrec :: ReadPrec Policy
$creadPrec :: ReadPrec Policy
readList :: ReadS [Policy]
$creadList :: ReadS [Policy]
readsPrec :: Int -> ReadS Policy
$creadsPrec :: Int -> ReadS Policy
Read)

instance ToJSON Policy where
  toJSON :: Policy -> Value
toJSON Policy{[FailureDetails]
PolicySummary
PolicyDesc
pcFailureDetails :: [FailureDetails]
pcSummary :: PolicySummary
pcPolicy :: PolicyDesc
pcFailureDetails :: Policy -> [FailureDetails]
pcSummary :: Policy -> PolicySummary
pcPolicy :: Policy -> PolicyDesc
..} =
    [Pair] -> Value
object [Text
"policy" Text -> PolicyDesc -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PolicyDesc
pcPolicy,
            Text
"summary" Text -> PolicySummary -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= PolicySummary
pcSummary,
            Text
"failure-details" Text -> [FailureDetails] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [FailureDetails]
pcFailureDetails]

instance FromJSON Policy where
  parseJSON :: Value -> Parser Policy
parseJSON = String -> (Object -> Parser Policy) -> Value -> Parser Policy
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Policy" ((Object -> Parser Policy) -> Value -> Parser Policy)
-> (Object -> Parser Policy) -> Value -> Parser Policy
forall a b. (a -> b) -> a -> b
$
    \Object
o -> PolicyDesc -> PolicySummary -> [FailureDetails] -> Policy
Policy
          (PolicyDesc -> PolicySummary -> [FailureDetails] -> Policy)
-> Parser PolicyDesc
-> Parser (PolicySummary -> [FailureDetails] -> Policy)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser PolicyDesc
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"policy"
          Parser (PolicySummary -> [FailureDetails] -> Policy)
-> Parser PolicySummary -> Parser ([FailureDetails] -> Policy)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser PolicySummary
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"summary"
          Parser ([FailureDetails] -> Policy)
-> Parser [FailureDetails] -> Parser Policy
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe [FailureDetails])
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"failure-details" Parser (Maybe [FailureDetails])
-> [FailureDetails] -> Parser [FailureDetails]
forall a. Parser (Maybe a) -> a -> Parser a
.!= []

-- | The entire SMTP-TLSRPT report
data Report = Report {
  -- | organization responsible for the report
  Report -> Text
rpOrganizationName :: T.Text,
  -- | start and end times for the report range
  Report -> (UTCTime, UTCTime)
rpDateRange :: (UTCTime, UTCTime),
  -- | e-mail address of the party responsible for the report
  Report -> Text
rpContactInfo :: T.Text,
  -- | unique identifier
  Report -> Text
rpReportId :: T.Text,
  -- | results for each policy
  Report -> [Policy]
rpPolicies :: [Policy]
  } deriving (Report -> Report -> Bool
(Report -> Report -> Bool)
-> (Report -> Report -> Bool) -> Eq Report
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Report -> Report -> Bool
$c/= :: Report -> Report -> Bool
== :: Report -> Report -> Bool
$c== :: Report -> Report -> Bool
Eq, Int -> Report -> ShowS
[Report] -> ShowS
Report -> String
(Int -> Report -> ShowS)
-> (Report -> String) -> ([Report] -> ShowS) -> Show Report
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Report] -> ShowS
$cshowList :: [Report] -> ShowS
show :: Report -> String
$cshow :: Report -> String
showsPrec :: Int -> Report -> ShowS
$cshowsPrec :: Int -> Report -> ShowS
Show, ReadPrec [Report]
ReadPrec Report
Int -> ReadS Report
ReadS [Report]
(Int -> ReadS Report)
-> ReadS [Report]
-> ReadPrec Report
-> ReadPrec [Report]
-> Read Report
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Report]
$creadListPrec :: ReadPrec [Report]
readPrec :: ReadPrec Report
$creadPrec :: ReadPrec Report
readList :: ReadS [Report]
$creadList :: ReadS [Report]
readsPrec :: Int -> ReadS Report
$creadsPrec :: Int -> ReadS Report
Read)

instance ToJSON Report where
  toJSON :: Report -> Value
toJSON Report{[Policy]
(UTCTime, UTCTime)
Text
rpPolicies :: [Policy]
rpReportId :: Text
rpContactInfo :: Text
rpDateRange :: (UTCTime, UTCTime)
rpOrganizationName :: Text
rpPolicies :: Report -> [Policy]
rpReportId :: Report -> Text
rpContactInfo :: Report -> Text
rpDateRange :: Report -> (UTCTime, UTCTime)
rpOrganizationName :: Report -> Text
..} =
    [Pair] -> Value
object [Text
"organization-name" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
rpOrganizationName,
            Text
"date-range" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Pair] -> Value
object
             [Text
"start-datetime" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime -> String
fmt ((UTCTime, UTCTime) -> UTCTime
forall a b. (a, b) -> a
fst (UTCTime, UTCTime)
rpDateRange),
              Text
"end-datetime" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= UTCTime -> String
fmt ((UTCTime, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd (UTCTime, UTCTime)
rpDateRange)],
            Text
"contact-info" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
rpContactInfo,
            Text
"report-id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
rpReportId,
            Text
"policies" Text -> [Policy] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Policy]
rpPolicies]
    where fmt :: UTCTime -> String
fmt = TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%FT%X%Z"
  
instance FromJSON Report where
  parseJSON :: Value -> Parser Report
parseJSON = String -> (Object -> Parser Report) -> Value -> Parser Report
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Report" ((Object -> Parser Report) -> Value -> Parser Report)
-> (Object -> Parser Report) -> Value -> Parser Report
forall a b. (a -> b) -> a -> b
$
    \Object
o -> Text -> (UTCTime, UTCTime) -> Text -> Text -> [Policy] -> Report
Report
          (Text -> (UTCTime, UTCTime) -> Text -> Text -> [Policy] -> Report)
-> Parser Text
-> Parser
     ((UTCTime, UTCTime) -> Text -> Text -> [Policy] -> Report)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"organization-name"
          Parser ((UTCTime, UTCTime) -> Text -> Text -> [Policy] -> Report)
-> Parser (UTCTime, UTCTime)
-> Parser (Text -> Text -> [Policy] -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser (UTCTime, UTCTime)
forall a b. (ParseTime a, ParseTime b) => Object -> Parser (a, b)
mtime Object
o
          Parser (Text -> Text -> [Policy] -> Report)
-> Parser Text -> Parser (Text -> [Policy] -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"contact-info"
          Parser (Text -> [Policy] -> Report)
-> Parser Text -> Parser ([Policy] -> Report)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"report-id"
          Parser ([Policy] -> Report) -> Parser [Policy] -> Parser Report
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser [Policy]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"policies"
    where mtime :: Object -> Parser (a, b)
mtime Object
o = do
            Object
range <- Object
o Object -> Text -> Parser Object
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"date-range"
            String
start <- Object
range Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"start-datetime"
            String
end <- Object
range Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"end-datetime"
            a
start' <- Bool -> TimeLocale -> String -> String -> Parser a
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%FT%X%Z" String
start
            b
end' <- Bool -> TimeLocale -> String -> String -> Parser b
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM Bool
True TimeLocale
defaultTimeLocale String
"%FT%X%Z" String
end
            (a, b) -> Parser (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
start', b
end')

-- | Parse a TLSRPT report from a JSON 'Value'
tlsReportFromJson :: Value -> Either String Report
tlsReportFromJson :: Value -> Either String Report
tlsReportFromJson Value
v =
  case Value -> Result Report
forall a. FromJSON a => Value -> Result a
fromJSON Value
v of
    Error String
s -> String -> Either String Report
forall a b. a -> Either a b
Left String
s
    Success Report
r -> Report -> Either String Report
forall a b. b -> Either a b
Right Report
r

-- | Parse a TLSRPT report from a strict 'B.ByteString'
tlsReportFromStrict :: B.ByteString -> Either String Report
tlsReportFromStrict :: ByteString -> Either String Report
tlsReportFromStrict = IO (Either String Report) -> Either String Report
forall a. IO a -> a
unsafePerformIO (IO (Either String Report) -> Either String Report)
-> (ByteString -> IO (Either String Report))
-> ByteString
-> Either String Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStream IO () -> IO (Either String Report)
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> m (Either String Report)
tlsReportFromStream (ByteStream IO () -> IO (Either String Report))
-> (ByteString -> ByteStream IO ())
-> ByteString
-> IO (Either String Report)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStream IO ()
forall (m :: * -> *). ByteString -> ByteStream m ()
Q.fromStrict

-- | Parse a TLSRPT report from a lazy 'L.ByteString'
tlsReportFromLazy :: L.ByteString -> Either String Report
tlsReportFromLazy :: ByteString -> Either String Report
tlsReportFromLazy = IO (Either String Report) -> Either String Report
forall a. IO a -> a
unsafePerformIO (IO (Either String Report) -> Either String Report)
-> (ByteString -> IO (Either String Report))
-> ByteString
-> Either String Report
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteStream IO () -> IO (Either String Report)
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> m (Either String Report)
tlsReportFromStream (ByteStream IO () -> IO (Either String Report))
-> (ByteString -> ByteStream IO ())
-> ByteString
-> IO (Either String Report)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteStream IO ()
forall (m :: * -> *). Monad m => ByteString -> ByteStream m ()
Q.fromLazy

-- | Parse a TLSRPT report from a 'Q.ByteStream'
tlsReportFromStream :: (MonadFail m, MonadIO m) => Q.ByteStream m r -> m (Either String Report)
tlsReportFromStream :: ByteStream m r -> m (Either String Report)
tlsReportFromStream 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'
  Either String Report -> m (Either String Report)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Report -> m (Either String Report))
-> Either String Report -> m (Either String Report)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Report
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
lbs

test :: IO ()
test :: IO ()
test = do
  let filename :: String
filename = String
"../google.com!enumeration.eu!1607990400!1608076799!001.json.gz"
  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
    Either String Report
erpt <- ByteStream (ResourceT IO) () -> ResourceT IO (Either String Report)
forall (m :: * -> *) r.
(MonadFail m, MonadIO m) =>
ByteStream m r -> m (Either String Report)
tlsReportFromStream (ByteStream (ResourceT IO) ()
 -> ResourceT IO (Either String Report))
-> ByteStream (ResourceT IO) ()
-> ResourceT IO (Either String Report)
forall a b. (a -> b) -> a -> b
$ String -> ByteStream (ResourceT IO) ()
forall (m :: * -> *). MonadResource m => String -> ByteStream m ()
Q.readFile String
filename
    case Either String Report
erpt of
      Left String
e -> 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
e
      Right Report
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
$ Report -> String
forall a. Show a => a -> String
show Report
x