JSON encoding of DMARC. Lacks size limit on reports.
This commit is contained in:
parent
a6bc098d93
commit
1e19f664a5
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user