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 module App.Type.DMARC where
import Prelude import Prelude
import Data.Generic.Rep (class Generic) import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.Tuple (Tuple(..))
import App.Type.GenericSerialization (generic_serialization) import App.Type.GenericSerialization (generic_serialization)
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
@ -43,19 +44,51 @@ type DMARC
, fo :: Maybe ReportOccasion , fo :: Maybe ReportOccasion
-- | rua= Optional. Addresses to which aggregate feedback is to be sent. -- | rua= Optional. Addresses to which aggregate feedback is to be sent.
-- | A size limit can be provided (in KB). -- | **TODO**: A size limit can be provided (in KB).
, rua :: Maybe (Array (Tuple MailTo Int)) , rua :: Maybe (Array MailTo)
-- | ruf= Optional. Addresses to which message-specific failure information is to be reported. -- | 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= 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= Optional. Interval requested between aggregate reports. Default is 86400.
, ri :: Maybe Int , 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 data ReportOccasion
-- | Both DKIM and SPF should be in error to have a report. -- | Both DKIM and SPF should be in error to have a report.
= Both = Both
@ -66,6 +99,22 @@ data ReportOccasion
-- | Produce a report whether SPF or DKIM is erroneous. -- | Produce a report whether SPF or DKIM is erroneous.
| Any | 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 data ConsistencyPolicy
-- | s = strict. -- | s = strict.
-- | -- |
@ -96,15 +145,56 @@ data ConsistencyPolicy
-- | See https://publicsuffix.org/ for a list of organizational domains. -- | See https://publicsuffix.org/ for a list of organizational domains.
| Relaxed | 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. -- | Authentication Failure Reporting Format, see RFC6591. Currently the only format referenced in RFC7489.
= AFRF = 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 data Version
-- | Version of DMARC only accepts DMARC1 currently. -- | Version of DMARC only accepts DMARC1 currently.
-- | So, for dnsmanager, this field is just ignored for now. -- | So, for dnsmanager, this field is just ignored for now.
= DMARC1 = 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 data Policy
-- | "None" means to basically just accept the mail. -- | "None" means to basically just accept the mail.
= None = None
@ -112,3 +202,18 @@ data Policy
| Quarantine | Quarantine
-- | "Reject" means to not accept any failure of DKIM or SPF. -- | "Reject" means to not accept any failure of DKIM or SPF.
| Reject | 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