JSON encoding of DMARC. Lacks size limit on reports.

This commit is contained in:
Philippe PITTOLI 2024-04-11 23:29:13 +02:00
parent a6bc098d93
commit 1e19f664a5

View File

@ -1,10 +1,11 @@
-- | DMARC is a spam mitigation mechanism described in RFC7489.
-- | DMARC is built on top of DKIM and SPF.
module App.Type.DMARC where
import Prelude
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
import Data.Tuple (Tuple(..))
import App.Type.GenericSerialization (generic_serialization)
import Data.Maybe (Maybe(..))
@ -43,19 +44,51 @@ type DMARC
, fo :: Maybe ReportOccasion
-- | rua= Optional. Addresses to which aggregate feedback is to be sent.
-- | A size limit can be provided (in KB).
, rua :: Maybe (Array (Tuple MailTo Int))
-- | **TODO**: A size limit can be provided (in KB).
, rua :: Maybe (Array MailTo)
-- | ruf= Optional. Addresses to which message-specific failure information is to be reported.
, ruf :: Array MailTo
, ruf :: Maybe (Array MailTo)
-- | rf= Optional. List of accepted report format, AFRF by default.
, rf :: Maybe (Array Format)
, rf :: Maybe (Array ReportFormat)
-- | ri= Optional. Interval requested between aggregate reports. Default is 86400.
, ri :: Maybe Int
}
emptyDMARCRR :: DMARC
emptyDMARCRR =
{ adkim: Nothing
, aspf: Nothing
, v: Nothing -- default: DMARC1
, pct: Nothing -- default: 100%
, p: Reject
, sp: Nothing
, fo: Nothing
, rua: Nothing
, ruf: Nothing
, rf: Nothing -- default: AFRF
, ri: Nothing -- default: 86400
}
codec :: JsonCodec DMARC
codec = CA.object "DMARC"
(CAR.record
{ v: CAR.optional codecVersion
, adkim: CAR.optional codecConsistencyPolicy
, aspf: CAR.optional codecConsistencyPolicy
, pct: CAR.optional CA.int
, p: codecPolicy
, sp: CAR.optional codecPolicy
, fo: CAR.optional codecReportOccasion
, rua: CAR.optional (CA.array CA.string)
, ruf: CAR.optional (CA.array CA.string)
, rf: CAR.optional (CA.array codecReportFormat)
, ri: CAR.optional CA.int
})
data ReportOccasion
-- | Both DKIM and SPF should be in error to have a report.
= Both
@ -66,6 +99,22 @@ data ReportOccasion
-- | Produce a report whether SPF or DKIM is erroneous.
| Any
-- | Codec for just encoding a single value of type `ReportOccasion`.
codecReportOccasion :: CA.JsonCodec ReportOccasion
codecReportOccasion = CA.prismaticCodec "ReportOccasion" str_to_report_occasion generic_serialization CA.string
str_to_report_occasion :: String -> Maybe ReportOccasion
str_to_report_occasion = case _ of
"both" -> Just Both
"dkimonly" -> Just DKIMonly
"spfonly" -> Just SPFonly
"any" -> Just Any
_ -> Nothing
derive instance genericReportOccasion :: Generic ReportOccasion _
instance showReportOccasion :: Show ReportOccasion where
show = genericShow
data ConsistencyPolicy
-- | s = strict.
-- |
@ -96,15 +145,56 @@ data ConsistencyPolicy
-- | See https://publicsuffix.org/ for a list of organizational domains.
| Relaxed
data Format
-- | Codec for just encoding a single value of type `ConsistencyPolicy`.
codecConsistencyPolicy :: CA.JsonCodec ConsistencyPolicy
codecConsistencyPolicy
= CA.prismaticCodec "ConsistencyPolicy" str_to_consistency_policy generic_serialization CA.string
str_to_consistency_policy :: String -> Maybe ConsistencyPolicy
str_to_consistency_policy = case _ of
"relaxed" -> Just Relaxed
"strict" -> Just Strict
_ -> Nothing
derive instance genericConsistencyPolicy :: Generic ConsistencyPolicy _
instance showConsistencyPolicy :: Show ConsistencyPolicy where
show = genericShow
data ReportFormat
-- | Authentication Failure Reporting Format, see RFC6591. Currently the only format referenced in RFC7489.
= AFRF
-- | Codec for just encoding a single value of type `ReportFormat`.
codecReportFormat :: CA.JsonCodec ReportFormat
codecReportFormat = CA.prismaticCodec "ReportFormat" str_to_report_format generic_serialization CA.string
str_to_report_format :: String -> Maybe ReportFormat
str_to_report_format = case _ of
"afrf" -> Just AFRF
_ -> Nothing
derive instance genericFormat :: Generic ReportFormat _
instance showFormat :: Show ReportFormat where
show = genericShow
data Version
-- | Version of DMARC only accepts DMARC1 currently.
-- | So, for dnsmanager, this field is just ignored for now.
= DMARC1
-- | Codec for just encoding a single value of type `Version`.
codecVersion :: CA.JsonCodec Version
codecVersion = CA.prismaticCodec "Version" str_to_version generic_serialization CA.string
str_to_version :: String -> Maybe Version
str_to_version = case _ of
"dmarc1" -> Just DMARC1
_ -> Nothing
derive instance genericVersion :: Generic Version _
instance showVersion :: Show Version where
show = genericShow
data Policy
-- | "None" means to basically just accept the mail.
= None
@ -112,3 +202,18 @@ data Policy
| Quarantine
-- | "Reject" means to not accept any failure of DKIM or SPF.
| Reject
-- | Codec for just encoding a single value of type `Policy`.
codecPolicy :: CA.JsonCodec Policy
codecPolicy = CA.prismaticCodec "Policy" str_to_policy generic_serialization CA.string
str_to_policy :: String -> Maybe Policy
str_to_policy = case _ of
"none" -> Just None
"quarantine" -> Just Quarantine
"reject" -> Just Reject
_ -> Nothing
derive instance genericPolicy :: Generic Policy _
instance showPolicy :: Show Policy where
show = genericShow