DMARC: display DMARC RRs.

This commit is contained in:
Philippe PITTOLI 2024-04-14 17:44:57 +02:00
parent a57f7cd026
commit f29265fe8b
2 changed files with 50 additions and 2 deletions

View File

@ -712,6 +712,7 @@ handleAction = case _ of
-- Since _currentRR.dkim isn't modified directly, it is copied from `State`. -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
_ <- case t of _ <- case t of
DKIM -> H.modify_ \state -> state { _currentRR { dkim = Just state.dkim } } DKIM -> H.modify_ \state -> state { _currentRR { dkim = Just state.dkim } }
DMARC -> H.modify_ \state -> state { _currentRR { dmarc = Just state.dmarc } }
_ -> pure unit _ -> pure unit
state <- H.get state <- H.get
@ -721,7 +722,11 @@ handleAction = case _ of
-- loopE (\v -> H.raise $ Log $ ErrorLog $ "==> " <> show_error v) actual_errors -- loopE (\v -> H.raise $ Log $ ErrorLog $ "==> " <> show_error v) actual_errors
H.modify_ _ { _currentRR_errors = actual_errors } H.modify_ _ { _currentRR_errors = actual_errors }
Right newrr -> do Right newrr -> do
H.modify_ _ { _currentRR_errors = [], _dmarc_mail_errors = [], dkim = DKIM.emptyDKIMRR } H.modify_ _ { _currentRR_errors = []
, _dmarc_mail_errors = []
, dkim = DKIM.emptyDKIMRR
, dmarc = DMARC.emptyDMARCRR
}
handleAction $ AddRR t newrr handleAction $ AddRR t newrr
handleAction CancelModal handleAction CancelModal
@ -750,7 +755,8 @@ handleAction = case _ of
-- Since _currentRR.dkim isn't modified directly, it is copied from `State`. -- Since _currentRR.dkim isn't modified directly, it is copied from `State`.
state0 <- H.get state0 <- H.get
_ <- case state0._currentRR.rrtype of _ <- case state0._currentRR.rrtype of
"DKIM" -> H.modify_ _ { _currentRR { dkim = Just state0.dkim } } "DKIM" -> H.modify_ _ { _currentRR { dkim = Just state0.dkim } }
"DMARC" -> H.modify_ _ { _currentRR { dmarc = Just state0.dmarc } }
_ -> pure unit _ -> pure unit
state <- H.get state <- H.get
@ -1006,6 +1012,7 @@ render_resources records
<> (rr_box tag_srv [] Bulma.srv_table_header table_content all_srv_rr) <> (rr_box tag_srv [] Bulma.srv_table_header table_content all_srv_rr)
<> (rr_box tag_spf [] Bulma.spf_table_header table_content all_spf_rr) <> (rr_box tag_spf [] Bulma.spf_table_header table_content all_spf_rr)
<> (rr_box tag_dkim [] Bulma.dkim_table_header table_content all_dkim_rr) <> (rr_box tag_dkim [] Bulma.dkim_table_header table_content all_dkim_rr)
<> (rr_box tag_dmarc [] Bulma.dmarc_table_header table_content all_dmarc_rr)
<> (rr_box tag_basic_ro bg_color_ro Bulma.simple_table_header_ro table_content_w_seps all_basic_ro_rr) <> (rr_box tag_basic_ro bg_color_ro Bulma.simple_table_header_ro table_content_w_seps all_basic_ro_rr)
where where
all_basic_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records all_basic_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records
@ -1016,6 +1023,7 @@ render_resources records
all_srv_rr = all_XX_rr "SRV" all_srv_rr = all_XX_rr "SRV"
all_spf_rr = all_XX_rr "SPF" all_spf_rr = all_XX_rr "SPF"
all_dkim_rr = all_XX_rr "DKIM" all_dkim_rr = all_XX_rr "DKIM"
all_dmarc_rr = all_XX_rr "DMARC"
tag_soa = tags [tag_ro "SOA", tag_ro "read only"] tag_soa = tags [tag_ro "SOA", tag_ro "read only"]
tag_basic = tags [tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"] tag_basic = tags [tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"]
@ -1023,6 +1031,7 @@ render_resources records
tag_srv = tags [tag "SRV"] tag_srv = tags [tag "SRV"]
tag_spf = tags [tag "SPF"] tag_spf = tags [tag "SPF"]
tag_dkim = tags [tag "DKIM"] tag_dkim = tags [tag "DKIM"]
tag_dmarc = tags [tag "DMARC"]
tag_basic_ro = tags [tag_ro "Basic Resource Records", tag_ro "read only"] tag_basic_ro = tags [tag_ro "Basic Resource Records", tag_ro "read only"]
rr_box :: HH.HTML w Action -- box title (type of data) rr_box :: HH.HTML w Action -- box title (type of data)
@ -1106,6 +1115,27 @@ render_resources records
else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ] else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
] ]
Nothing -> [Bulma.p "Problem: there is no DKIM data." ] Nothing -> [Bulma.p "Problem: there is no DKIM data." ]
"DMARC" ->
[ HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ show rr.ttl ]
] <> case rr.dmarc of
Just dmarc ->
[
-- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DMARC1.
HH.td_ [ Bulma.p $ show dmarc.p ]
, HH.td_ [ Bulma.p $ maybe "" show dmarc.sp ]
, HH.td_ [ Bulma.p $ maybe "" show dmarc.adkim ]
, HH.td_ [ Bulma.p $ maybe "" show dmarc.aspf ]
, HH.td_ [ Bulma.p $ maybe "" show dmarc.pct ]
, HH.td_ [ Bulma.p $ maybe "" show dmarc.fo ]
, HH.td_ [ Bulma.p $ maybe "" show dmarc.ri ]
-- TODO? rua & ruf
-- , HH.td_ [ ] -- For now, assume AFRF.
, if rr.readonly
then HH.td_ [ Bulma.btn_readonly ]
else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
]
Nothing -> [Bulma.p "Problem: there is no DMARC data." ]
"MX" -> "MX" ->
[ HH.td_ [ Bulma.p rr.name ] [ HH.td_ [ Bulma.p rr.name ]
, HH.td_ [ Bulma.p $ show rr.ttl ] , HH.td_ [ Bulma.p $ show rr.ttl ]

View File

@ -155,6 +155,24 @@ dkim_table_header
] ]
] ]
dmarc_table_header :: forall w i. HH.HTML w i
dmarc_table_header
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
, HH.th_ [ HH.text "TTL" ]
-- , HH.th_ [ HH.text "Version" ] -- For now, version isn't displayed. Assume DMARC1.
, HH.th_ [ HH.text "Policy" ] -- p
, HH.th_ [ HH.text "Subdomain Policy" ] -- sp
, HH.th_ [ HH.text "DKIM policy" ] -- adkim
, HH.th_ [ HH.text "SPF policy" ] -- aspf
, HH.th_ [ HH.text "Sample rate" ] -- pct
, HH.th_ [ HH.text "Report on" ] -- fo
, HH.th_ [ HH.text "Report interval" ] -- ri
-- TODO? rua & ruf
-- , HH.th_ [ HH.text "Accepted report formats" ] -- For now, assume AFRF.
, HH.th_ [ HH.text "" ]
]
]
soa_table_header :: forall w i. HH.HTML w i soa_table_header :: forall w i. HH.HTML w i
soa_table_header soa_table_header
= HH.thead_ [ HH.tr [ HP.classes C.has_background_warning_light ] = HH.thead_ [ HH.tr [ HP.classes C.has_background_warning_light ]