dnsmanager-webclient/src/App/Type/DMARC.purs

-- | 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 App.Type.GenericSerialization (generic_serialization)
import Data.Maybe (Maybe(..))

import Data.Codec.Argonaut (JsonCodec)
import Data.Codec.Argonaut as CA
import Data.Codec.Argonaut.Record as CAR

type DMARC
  = {
    -- | adkim= Optional.
    -- | Consistency policy for DKIM.
    -- | Either strict (dkim signature domain = "From:" field) or relaxed (both in the same Organizational Domain).
      adkim :: Maybe ConsistencyPolicy

    -- | aspf= Optional.
    -- | Consistency policy for SPF.
    -- | Either strict ("MailFrom:" same as "From:") or relaxed (both in the same Organizational Domain).
    , aspf :: Maybe ConsistencyPolicy

    -- | v= Required. Default is "DMARC1", so the implementation doesn't actually require it.
    , v :: Maybe Version

    -- | pct= Optional. Percentage of messages subjected to the requested policy [0...100], 100 by default.
    , pct :: Maybe Int

    -- | p= Required. Requested Mail Receiver policy (None, Quarantine, Reject).
    , p :: Policy

    -- | sp= Optional. Requested Mail Receiver policy for all subdomains.
    , sp :: Maybe Policy

    -- | fo= Optional. When to send a report (on DKIM or SPF error? Any? Both?).
    , fo :: Maybe ReportOccasion

    -- | rua= Optional. Addresses to which aggregate feedback is to be sent.
    , rua :: Maybe (Array DMARCURI)

    -- | ruf= Optional. Addresses to which message-specific failure information is to be reported.
    , ruf :: Maybe (Array DMARCURI)

    -- | rf= Optional. List of accepted report format, AFRF by default.
    , 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 codecDMARCURI)
    , ruf:   CAR.optional (CA.array codecDMARCURI)
    , rf:    CAR.optional (CA.array codecReportFormat)
    , ri:    CAR.optional CA.int
    })

-- | DMARCURI is both an email and an eventual size.
-- | This is a simplification of the actual specs, but that's good enough.
type DMARCURI = { mail :: String, limit :: Maybe Int }

-- | Codec for just encoding a single value of type `DMARCURI`.
codecDMARCURI :: JsonCodec DMARCURI
codecDMARCURI = CA.object "DMARCURI" (CAR.record { mail: CA.string, limit: CAR.optional CA.int })

data ReportOccasion
  -- | Both DKIM and SPF should be in error to have a report.
  = Both
  -- | DKIM should be erroneous to produce a report.
  | DKIMonly
  -- | SPF should be erroneous to produce a report.
  | SPFonly
  -- | Produce a report whether SPF or DKIM is erroneous.
  | Any

report_occasions :: Array ReportOccasion
report_occasions = [Both, DKIMonly, SPFonly, Any]

report_occasions_txt :: Array String
report_occasions_txt
  = [ "Do not tell when to send reports (default: when both fail)"
    , "When both SPF and DKIM fail"
    , "Upon a DKIM error"
    , "Upon an SPF error"
    , "Upon any error"
    ]

report_occasions_raw :: Array String
report_occasions_raw = map show report_occasions

-- | 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.
  -- |
  -- | For DKIM: DKIM signature should first be verified.
  -- | Then, the "From:" field should be the exact same domain as the DKIM signature domain.
  -- |
  -- | For SPF: first, SPF should produce a passing result. Then, the "From:" and the "MailFrom:" fields are checked.
  -- | In strict mode, Both "MailFrom:" and "From:" fields should have the same value.
  -- |
  -- | From RFC7489: For example, if a message passes an SPF check with an
  -- | RFC5321.MailFrom domain of "cbg.bounces.example.com", and the address
  -- | portion of the RFC5322.From field contains "payments@example.com",
  -- | the Authenticated RFC5321.MailFrom domain identifier and the
  -- | RFC5322.From domain are considered to be "in alignment" in relaxed
  -- | mode, but not in strict mode.
  -- | See https://publicsuffix.org/ for a list of organizational domains.
  = Strict
  -- | r = relaxed, default.
  -- |
  -- | For DKIM: DKIM signature should first be verified.
  -- | Then, the "From:" field should have the same domain as the DKIM signature domain or be in the same
  -- | Organizational Domain.
  -- | Example: "From:" is example@foo.example.org, DKIM signature can be d=example.org or d=bar.example.org.
  -- |
  -- | For SPF: as for "strict" policy, SPF should first produce a passing result.
  -- | Then, the "From:" and the "MailFrom:" fields should be checked.
  -- | In relaxed mode, they can be different, but in the same Organizational Domain.
  -- | See https://publicsuffix.org/ for a list of organizational domains.
  | Relaxed

consistency_policies :: Array ConsistencyPolicy
consistency_policies = [Strict, Relaxed]

consistency_policies_txt :: Array String
consistency_policies_txt
  = [ "Do not provide policy advice"
    , "Strict: same domain"
    , "Relaxed: same organizational domain"
    ]

consistency_policies_raw :: Array String
consistency_policies_raw = map show consistency_policies

-- | 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
  -- | "Quarantine" means to consider the mail as suspicious, by giving it a bad spam score or something like that.
  | Quarantine
  -- | "Reject" means to not accept any failure of DKIM or SPF.
  | Reject

policies :: Array Policy
policies = [None, Quarantine, Reject]

policies_raw :: Array String
policies_raw = map show policies

policies_txt :: Array String
policies_txt =
  [ "None (let the receiver decide)"
  , "Quarantine (high spam score, flag, etc.)"
  , "Reject"
  ]

policies_txt_with_null :: Array String
policies_txt_with_null = [ "Do not provide policy advice" ] <> policies_txt

-- | 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