Simplification: SRV protocol is no more a simple text, anywhere.

caa
Philippe Pittoli 2024-11-09 00:49:22 +01:00
parent 408f8da669
commit bfa249585c
2 changed files with 6 additions and 13 deletions

View File

@ -59,7 +59,7 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR
, qualifiers , qualifiers
, mechanism_types, qualifier_types, modifier_types) , mechanism_types, qualifier_types, modifier_types)
import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..), SRVProtocol(..) import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..), SRVProtocol(..)
, srv_protocols_txt, str_to_srv_protocol) as RR , srv_protocols, srv_protocols_txt) as RR
import App.Type.DKIM as DKIM import App.Type.DKIM as DKIM
import App.Type.DMARC as DMARC import App.Type.DMARC as DMARC
@ -252,8 +252,6 @@ type State =
, _currentRR_errors :: Array Validation.Error , _currentRR_errors :: Array Validation.Error
, _dmarc_mail_errors :: Array Email.Error , _dmarc_mail_errors :: Array Email.Error
, srv_protocol :: String -- :: RR.SRVProtocol
-- SPF details. -- SPF details.
, spf_mechanism_q :: String , spf_mechanism_q :: String
, spf_mechanism_t :: String , spf_mechanism_t :: String
@ -314,8 +312,6 @@ initialState domain =
, _dmarc_mail_errors: [] , _dmarc_mail_errors: []
, _zonefile: Nothing , _zonefile: Nothing
, srv_protocol: "tcp" -- RR.TCP
, spf_mechanism_q: "pass" , spf_mechanism_q: "pass"
, spf_mechanism_t: "a" , spf_mechanism_t: "a"
, spf_mechanism_v: "" , spf_mechanism_v: ""
@ -484,7 +480,8 @@ render state
, Bulma.box_input "domainSRV" "Service name" "service name" , Bulma.box_input "domainSRV" "Service name" "service name"
(updateForm Field_Domain) (updateForm Field_Domain)
state._currentRR.name state._currentRR.name
, Bulma.selection_field "protocolSRV" "Protocol" SRV_Protocol RR.srv_protocols_txt state.srv_protocol , Bulma.selection_field "protocolSRV" "Protocol" SRV_Protocol RR.srv_protocols_txt
(maybe "udp" (toLower <<< show) state._currentRR.protocol)
, Bulma.box_input ("targetSRV") "Where the server is" "www" , Bulma.box_input ("targetSRV") "Where the server is" "www"
(updateForm Field_Target) (updateForm Field_Target)
state._currentRR.target state._currentRR.target
@ -751,7 +748,6 @@ handleAction = case _ of
-- TODO: should the code design change? Would the code be simplified by working only on _currentRR.dkim? -- TODO: should the code design change? Would the code be simplified by working only on _currentRR.dkim?
-- 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
SRV -> H.modify_ \state -> state { _currentRR { protocol = RR.str_to_srv_protocol state.srv_protocol }}
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 } } DMARC -> H.modify_ \state -> state { _currentRR { dmarc = Just state.dmarc } }
_ -> pure unit _ -> pure unit
@ -765,7 +761,6 @@ handleAction = case _ of
Right newrr -> do Right newrr -> do
H.modify_ _ { _currentRR_errors = [] H.modify_ _ { _currentRR_errors = []
, _dmarc_mail_errors = [] , _dmarc_mail_errors = []
, srv_protocol = "tcp"
, dkim = DKIM.emptyDKIMRR , dkim = DKIM.emptyDKIMRR
, dmarc = DMARC.emptyDMARCRR , dmarc = DMARC.emptyDMARCRR
} }
@ -797,7 +792,6 @@ 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
"SRV" -> H.modify_ _ { _currentRR { protocol = RR.str_to_srv_protocol state0.srv_protocol }}
"DKIM" -> H.modify_ _ { _currentRR { dkim = Just state0.dkim } } "DKIM" -> H.modify_ _ { _currentRR { dkim = Just state0.dkim } }
"DMARC" -> H.modify_ _ { _currentRR { dmarc = Just state0.dmarc } } "DMARC" -> H.modify_ _ { _currentRR { dmarc = Just state0.dmarc } }
_ -> pure unit _ -> pure unit
@ -814,7 +808,6 @@ handleAction = case _ of
H.modify_ _ { spf_mechanism_q = "pass" H.modify_ _ { spf_mechanism_q = "pass"
, spf_mechanism_t = "a" , spf_mechanism_t = "a"
, spf_mechanism_v = "" , spf_mechanism_v = ""
, srv_protocol = "tcp"
, spf_modifier_t = "redirect" , spf_modifier_t = "redirect"
, spf_modifier_v = "" , spf_modifier_v = ""
, dmarc_mail = "" , dmarc_mail = ""
@ -866,7 +859,7 @@ handleAction = case _ of
let new_caa = (fromMaybe default_caa state._currentRR.caa) { tag = fromMaybe CAA.Issue $ CAA.tags A.!! v } let new_caa = (fromMaybe default_caa state._currentRR.caa) { tag = fromMaybe CAA.Issue $ CAA.tags A.!! v }
H.modify_ _ { _currentRR { caa = Just new_caa } } H.modify_ _ { _currentRR { caa = Just new_caa } }
SRV_Protocol v -> H.modify_ _ { srv_protocol = maybe "tcp" id $ RR.srv_protocols_txt A.!! v } SRV_Protocol v -> H.modify_ _ { _currentRR { protocol = RR.srv_protocols A.!! v } }
SPF_Mechanism_q v -> H.modify_ _ { spf_mechanism_q = maybe "pass" id $ qualifier_types A.!! v } SPF_Mechanism_q v -> H.modify_ _ { spf_mechanism_q = maybe "pass" id $ qualifier_types A.!! v }
SPF_Mechanism_t v -> H.modify_ _ { spf_mechanism_t = maybe "a" id $ mechanism_types A.!! v } SPF_Mechanism_t v -> H.modify_ _ { spf_mechanism_t = maybe "a" id $ mechanism_types A.!! v }

View File

@ -263,8 +263,8 @@ show_qualifier = case _ of
HardFail -> "hard_fail" HardFail -> "hard_fail"
data SRVProtocol = TCP | UDP data SRVProtocol = TCP | UDP
-- srv_protocols :: Array SRVProtocol srv_protocols :: Array SRVProtocol
-- srv_protocols = [TCP, UDP] srv_protocols = [TCP, UDP]
srv_protocols_txt :: Array String srv_protocols_txt :: Array String
srv_protocols_txt = ["tcp", "udp"] srv_protocols_txt = ["tcp", "udp"]