From fc21cee4ae7dc616daa5184ccc84b8178a85788a Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 5 May 2025 05:03:58 +0200 Subject: [PATCH] Compiles again, yay --- src/App/Page/Zone.purs | 190 +++++++++-------------------------- src/App/Templates/Modal.purs | 20 ++-- src/App/Type/RRForm.purs | 106 ++++++++++++++++++- 3 files changed, 162 insertions(+), 154 deletions(-) diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index ae38811..c8d9a57 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -64,6 +64,8 @@ import App.Type.LogMessage (LogMessage(..)) import App.Message.DNSManagerDaemon as DNSManager import App.Validation.DNS as Validation +import App.Type.RRForm + -- | `App.Page.Zone` can send messages through websocket interface -- | connected to dnsmanagerd. See `App.WS`. -- | @@ -150,14 +152,15 @@ data Action -- | Modification of any attribute of the current RR. | RRUpdate RRUpdateValue + -- | Ask a (new) token for a resource record. + | NewToken RRId + data Tab = Zone | TheBasics | TokenExplanation derive instance eqTab :: Eq Tab derive instance genericTab :: Generic Tab _ instance showTab :: Show Tab where show = genericShow -import App.Type.RRForm - -- FIXME: this state is a mess. type State = { _domain :: String @@ -227,7 +230,7 @@ render state is_tab_active tab = state.current_tab == tab call_to_current_rr_modal - = Modal.current_rr_modal state._domain state._currentRR state.rr_modal + = Modal.current_rr_modal state._domain state._rr_form state.rr_modal UpdateCurrentRR NewToken RRUpdate ValidateRR ValidateLocal CancelModal render_zone = @@ -243,7 +246,7 @@ render state , Table.resource_records (sorted state._resources) CreateUpdateRRModal DeleteRRModal NewToken , Web.hr , render_new_records state - , render_zonefile state._zonefile + , render_zonefile state._rr_form._zonefile ] sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l)) @@ -259,9 +262,11 @@ handleAction = case _ of -- | Cancel the current modal being presented. -- | Works for both "new RR", "update RR" and "remove RR" modals. CancelModal -> do - H.modify_ _ { rr_modal = NoModal } - H.modify_ _ { _errors = [] } - H.modify_ _ { _dmarc_mail_errors = [] } + H.modify_ _ { rr_modal = NoModal + , _rr_form { _errors = [] + , _dmarc_mail_errors = [] + } + } handleAction $ ResetTemporaryValues -- | Create the RR modal. @@ -287,8 +292,8 @@ handleAction = case _ of Just rr -> do H.modify_ _ { _rr_form { _rr = rr } } _ <- case rr.rrtype of - "DKIM" -> H.modify_ _ { dkim = fromMaybe DKIM.emptyDKIMRR rr.dkim } - "DMARC" -> H.modify_ _ { dmarc = fromMaybe DMARC.emptyDMARCRR rr.dmarc } + "DKIM" -> H.modify_ _ { _rr_form { tmp { dkim = fromMaybe DKIM.emptyDKIMRR rr.dkim } }} + "DMARC" -> H.modify_ _ { _rr_form { tmp { dmarc = fromMaybe DMARC.emptyDMARCRR rr.dmarc } }} _ -> pure unit H.modify_ _ { rr_modal = UpdateRRModal } @@ -323,8 +328,8 @@ handleAction = case _ of -- TODO: should the code design change? Would the code be simplified by working only on _rr_form._rr.dkim? -- Since _rr_form._rr.dkim isn't modified directly, it is copied from `State`. _ <- case t of - DKIM -> H.modify_ \state -> state { _rr_form { _rr { dkim = Just state.dkim } } } - DMARC -> H.modify_ \state -> state { _rr_form { _rr { dmarc = Just state.dmarc } } } + DKIM -> H.modify_ \state -> state { _rr_form { _rr { dkim = Just state._rr_form.tmp.dkim } } } + DMARC -> H.modify_ \state -> state { _rr_form { _rr { dmarc = Just state._rr_form.tmp.dmarc } } } _ -> pure unit state <- H.get @@ -332,12 +337,14 @@ handleAction = case _ of Left actual_errors -> do -- H.raise $ Log $ ErrorLog $ "Cannot add this " <> show t <> " resource record, some errors occured in the record:" -- loopE (\v -> H.raise $ Log $ ErrorLog $ "==> " <> show_error v) actual_errors - H.modify_ _ { _errors = actual_errors } + H.modify_ _ { _rr_form { _errors = actual_errors } } Right newrr -> do - H.modify_ _ { _errors = [] - , _dmarc_mail_errors = [] - , dkim = DKIM.emptyDKIMRR - , dmarc = DMARC.emptyDMARCRR + H.modify_ _ { _rr_form { _errors = [] + , _dmarc_mail_errors = [] + , tmp { dkim = DKIM.emptyDKIMRR + , dmarc = DMARC.emptyDMARCRR + } + } } handleAction $ AddRR t newrr handleAction CancelModal @@ -347,7 +354,7 @@ handleAction = case _ of AddRR t newrr -> do state <- H.get H.raise $ Log $ SystemLog $ "Add new " <> show t - H.modify_ _ { _zonefile = Nothing } + H.modify_ _ { _rr_form { _zonefile = Nothing } } message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAddRR { domain: state._domain, rr: newrr } @@ -367,33 +374,36 @@ handleAction = case _ of -- Since _rr_form._rr.dkim isn't modified directly, it is copied from `State`. state0 <- H.get _ <- case state0._rr_form._rr.rrtype of - "DKIM" -> H.modify_ _ { _rr_form { _rr { dkim = Just state0.dkim } } } - "DMARC" -> H.modify_ _ { _rr_form { _rr { dmarc = Just state0.dmarc } } } + "DKIM" -> H.modify_ _ { _rr_form { _rr { dkim = Just state0._rr_form.tmp.dkim } } } + "DMARC" -> H.modify_ _ { _rr_form { _rr { dmarc = Just state0._rr_form.tmp.dmarc } } } _ -> pure unit state <- H.get case Validation.validation state._rr_form._rr of Left actual_errors -> do - H.modify_ _ { _errors = actual_errors } + H.modify_ _ { _rr_form { _errors = actual_errors } } Right rr -> do - H.modify_ _ { _errors = [], _dmarc_mail_errors = [] } + H.modify_ _ { _rr_form { _errors = [], _dmarc_mail_errors = [] } } handleAction $ SaveRR rr ResetTemporaryValues -> do - H.modify_ _ { _rr_form { tmp { spf { mechanism_q = "pass" } } } - , _rr_form { tmp { spf { mechanism_t = "a" } } } - , _rr_form { tmp { spf { mechanism_v = "" } } } - , _rr_form { tmp { spf { modifier_t = "redirect" } } } - , _rr_form { tmp { spf { modifier_v = "" } } } - , dmarc_mail = "" - , dmarc_mail_limit = Nothing - , _dmarc_mail_errors = [] + H.modify_ _ { _rr_form { tmp { spf { mechanism_q = "pass" + , mechanism_t = "a" + , mechanism_v = "" + , modifier_t = "redirect" + , modifier_v = "" + } + , dmarc_mail = "" + , dmarc_mail_limit = Nothing + } + , _dmarc_mail_errors = [] + } } SaveRR rr -> do state <- H.get H.raise $ Log $ SystemLog $ "Updating resource record " <> show rr.rrid - H.modify_ _ { _zonefile = Nothing } + H.modify_ _ { _rr_form { _zonefile = Nothing } } message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkUpdateRR { domain: state._domain, rr: rr } @@ -403,7 +413,7 @@ handleAction = case _ of RemoveRR rr_id -> do { _domain } <- H.get H.raise $ Log $ SystemLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")" - H.modify_ _ { _zonefile = Nothing } + H.modify_ _ { _rr_form { _zonefile = Nothing } } -- Send a removal message. message <- H.liftEffect $ DNSManager.serialize @@ -429,115 +439,15 @@ handleAction = case _ of $ DNSManager.MkAskGeneratedZoneFile { domain: state._domain } H.raise $ MessageToSend message - CAA_tag v -> do + RRUpdate value_to_update -> do state <- H.get - let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v - new_value = case new_tag of - CAA.Issue -> "letsencrypt.org" - CAA.ContactEmail -> "contact@example.com" - CAA.ContactPhone -> "0203040506" - _ -> "" - new_caa = (fromMaybe default_caa state._rr_form._rr.caa) { tag = new_tag, value = new_value } - H.modify_ _ { _rr_form { _rr { caa = Just new_caa } } } - - SRV_Protocol v -> H.modify_ _ { _rr_form { _rr { protocol = RR.srv_protocols A.!! v } } } - - SPF_Mechanism_q v -> H.modify_ _ { _rr_form { tmp { spf { mechanism_q = maybe "pass" id $ qualifier_types A.!! v }}} - SPF_Mechanism_t v -> H.modify_ _ { _rr_form { tmp { spf { mechanism_t = maybe "a" id $ mechanism_types A.!! v }}} - SPF_Mechanism_v v -> H.modify_ _ { _rr_form { tmp { spf { mechanism_v = v }}} - SPF_Modifier_t v -> H.modify_ _ { _rr_form { tmp { spf { modifier_t = maybe "redirect" id $ modifier_types A.!! v }}} - SPF_Modifier_v v -> H.modify_ _ { _rr_form { tmp { spf { modifier_v = v }}} - SPF_Qualifier v -> H.modify_ _ { _rr_form { _rr { q = qualifiers A.!! v } } - SPF_remove_mechanism i -> - H.modify_ \s -> s { _rr_form { _rr { mechanisms = case s._rr_form._rr.mechanisms of - Just ms -> Just (remove_id i $ attach_id 0 ms) - Nothing -> Nothing - } } } - SPF_remove_modifier i -> - H.modify_ \s -> s { _rr_form { _rr { modifiers = case s._rr_form._rr.modifiers of - Just ms -> Just (remove_id i $ attach_id 0 ms) - Nothing -> Nothing - } } } - - SPF_Mechanism_Add -> do - state <- H.get - let m = state._rr_form._rr.mechanisms - m_q = state._rr_form.tmp.spf.mechanism_q - m_t = state._rr_form.tmp.spf.mechanism_t - m_v = state._rr_form.tmp.spf.mechanism_v - new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (to_mechanism m_q m_t m_v) - new_value = case new_list_of_mechanisms of - [] -> Nothing - v -> Just v - H.modify_ _ { _rr_form { _rr { mechanisms = new_value }}} - handleAction $ ResetTemporaryValues - - SPF_Modifier_Add -> do - state <- H.get - let m = state._rr_form._rr.modifiers - m_t = state._rr_form.tmp.spf.modifier_t - m_v = state._rr_form.tmp.spf.modifier_v - new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (to_modifier m_t m_v) - new_value = case new_list_of_modifiers of - [] -> Nothing - v -> Just v - H.modify_ _ { _rr_form._rr { modifiers = new_value }} - handleAction $ ResetTemporaryValues - - DMARC_mail v -> H.modify_ _ { dmarc_mail = v } - DMARC_mail_limit v -> H.modify_ _ { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } - DMARC_ri v -> H.modify_ _ { dmarc { ri = fromString v } } - DMARC_rua_Add -> do - state <- H.get - case Email.email state.dmarc_mail of - Left errors -> H.modify_ _ { _dmarc_mail_errors = errors } - Right _ -> do - let current_ruas = fromMaybe [] state.dmarc.rua - dmarc_mail = state.dmarc_mail - dmarc_mail_limit = state.dmarc_mail_limit - new_list = current_ruas <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ] - H.modify_ _ { dmarc { rua = Just new_list }} - handleAction $ ResetTemporaryValues - - DMARC_ruf_Add -> do - state <- H.get - case Email.email state.dmarc_mail of - Left errors -> H.modify_ _ { _dmarc_mail_errors = errors } - Right _ -> do - let current_rufs = fromMaybe [] state.dmarc.ruf - dmarc_mail = state.dmarc_mail - dmarc_mail_limit = state.dmarc_mail_limit - new_list = current_rufs <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ] - H.modify_ _ { dmarc { ruf = Just new_list } } - handleAction $ ResetTemporaryValues - - DMARC_remove_rua i -> do - state <- H.get - let current_ruas = fromMaybe [] state.dmarc.rua - new_value = case (remove_id i $ attach_id 0 current_ruas) of - [] -> Nothing - v -> Just v - H.modify_ \s -> s { dmarc { rua = new_value } } - - DMARC_remove_ruf i -> do - state <- H.get - let current_rufs = fromMaybe [] state.dmarc.ruf - new_value = case (remove_id i $ attach_id 0 current_rufs) of - [] -> Nothing - v -> Just v - H.modify_ \s -> s { dmarc { ruf = new_value } } - - DMARC_policy v -> H.modify_ _ { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } - DMARC_sp_policy v -> H.modify_ _ { dmarc { sp = DMARC.policies A.!! (v - 1) } } - DMARC_adkim v -> H.modify_ _ { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } } - DMARC_aspf v -> H.modify_ _ { dmarc { aspf = DMARC.consistency_policies A.!! (v - 1) } } - DMARC_pct v -> H.modify_ _ { dmarc { pct = Just $ fromMaybe 100 (fromString v) } } - DMARC_fo v -> H.modify_ _ { dmarc { fo = DMARC.report_occasions A.!! (v - 1) } } - - DKIM_hash_algo v -> H.modify_ _ { dkim { h = DKIM.hash_algos A.!! v } } - DKIM_sign_algo v -> H.modify_ _ { dkim { k = DKIM.sign_algos A.!! v } } - DKIM_pubkey v -> H.modify_ _ { dkim { p = v } } - DKIM_note v -> H.modify_ _ { dkim { n = Just v } } + H.modify_ _ { _rr_form = update_form state._rr_form value_to_update } + case value_to_update of + SPF_Mechanism_Add -> handleAction $ ResetTemporaryValues + SPF_Modifier_Add -> handleAction $ ResetTemporaryValues + DMARC_rua_Add -> handleAction $ ResetTemporaryValues + DMARC_ruf_Add -> handleAction $ ResetTemporaryValues + _ -> pure unit where -- In case the `name` part of the resource record is empty replace it with the domain name. @@ -563,7 +473,7 @@ handleQuery = case _ of state <- H.get H.modify_ _ { _resources = A.filter (\rr -> rr.rrid /= response.rrid) state._resources } (DNSManager.MkGeneratedZoneFile response) -> do - H.modify_ _ { _zonefile = Just response.zonefile } + H.modify_ _ { _rr_form { _zonefile = Just response.zonefile } } (DNSManager.MkZone response) -> do add_entries response.zone.resources diff --git a/src/App/Templates/Modal.purs b/src/App/Templates/Modal.purs index b3f09b7..2e114fd 100644 --- a/src/App/Templates/Modal.purs +++ b/src/App/Templates/Modal.purs @@ -35,8 +35,8 @@ import App.Type.ResourceRecord as RR import App.DisplayErrors (error_to_paragraph, show_error_email) -type ActionCancelModal = forall i. i -modal_rr_delete :: forall w i. Int -> (Int -> i) -> ActionCancelModal -> HH.HTML w i +type ActionCancelModal i = i +modal_rr_delete :: forall w i. Int -> (Int -> i) -> ActionCancelModal i -> HH.HTML w i modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting a resource record" [warning_message] [modal_delete_button, Web.cancel_button action_cancel_modal] where @@ -50,16 +50,16 @@ modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String) zip_nullable txt raw = A.zip txt ([""] <> raw) -type Domain = String -type ActionUpdateForm = forall i. (Field.Field -> i) -type ActionNewToken = forall i. (RRId -> i) -type ActionUpdateRR = forall i. (RRUpdateValue -> i) -type ActionValidateNewRR = forall i. (AcceptedRRTypes -> i) -type ActionValidateLocalRR = forall i. i +type Domain = String +type ActionUpdateForm i = (Field.Field -> i) +type ActionNewToken i = (RRId -> i) +type ActionUpdateRR i = (RRUpdateValue -> i) +type ActionValidateNewRR i = (AcceptedRRTypes -> i) +type ActionValidateLocalRR i = i current_rr_modal :: forall w i. Domain -> RRForm -> RRModal - -> ActionUpdateForm -> ActionNewToken - -> ActionUpdateRR -> ActionValidateNewRR -> ActionValidateLocalRR -> ActionCancelModal + -> ActionUpdateForm i -> ActionNewToken i + -> ActionUpdateRR i -> ActionValidateNewRR i -> ActionValidateLocalRR i -> ActionCancelModal i -> HH.HTML w i current_rr_modal selected_domain form rr_modal action_update_form action_new_token diff --git a/src/App/Type/RRForm.purs b/src/App/Type/RRForm.purs index b1ba039..59beab2 100644 --- a/src/App/Type/RRForm.purs +++ b/src/App/Type/RRForm.purs @@ -4,6 +4,7 @@ module App.Type.RRForm where import Prelude +import Utils import App.Type.AcceptedRRTypes (AcceptedRRTypes(..)) import App.Type.ResourceRecord import App.Type.DKIM as DKIM @@ -14,6 +15,9 @@ import App.Type.CAA as CAA import App.Validation.Email as Email import App.Validation.DNS as Validation import App.Type.RRId +import Data.Array as A +import Data.Either +import Data.Int (fromString) -- | TMP: temporary stored values regarding specific records such as SPF, -- | DKIM and DMARC. @@ -88,15 +92,13 @@ mkEmptyRRForm = } , dkim: DKIM.emptyDKIMRR , dmarc: DMARC.emptyDMARCRR - , dmarc_mail: "" + , dmarc_mail: "" , dmarc_mail_limit: Nothing } } data RRUpdateValue - -- | Ask a (new) token for a RR. - = NewToken RRId - | CAA_tag Int + = CAA_tag Int | SRV_Protocol Int | SPF_Mechanism_q Int | SPF_Mechanism_t Int @@ -147,3 +149,99 @@ data RRUpdateValue | DKIM_sign_algo Int | DKIM_pubkey String | DKIM_note String + +update_form :: RRForm -> RRUpdateValue -> RRForm +update_form form new_field_value = + case new_field_value of + CAA_tag v -> + let new_tag = fromMaybe CAA.Issue $ CAA.tags A.!! v + new_value = case new_tag of + CAA.Issue -> "letsencrypt.org" + CAA.ContactEmail -> "contact@example.com" + CAA.ContactPhone -> "0203040506" + _ -> "" + new_caa = (fromMaybe default_caa form._rr.caa) { tag = new_tag, value = new_value } + in form { _rr { caa = Just new_caa } } + + SRV_Protocol v -> form { _rr { protocol = RR.srv_protocols A.!! v } } + SPF_Mechanism_q v -> form { tmp { spf { mechanism_q = maybe "pass" id $ qualifier_types A.!! v }}} + SPF_Mechanism_t v -> form { tmp { spf { mechanism_t = maybe "a" id $ mechanism_types A.!! v }}} + SPF_Mechanism_v v -> form { tmp { spf { mechanism_v = v }}} + SPF_Modifier_t v -> form { tmp { spf { modifier_t = maybe "redirect" id $ modifier_types A.!! v }}} + SPF_Modifier_v v -> form { tmp { spf { modifier_v = v }}} + SPF_Qualifier v -> form { _rr { q = qualifiers A.!! v }} + SPF_remove_mechanism i -> + form { _rr { mechanisms = case form._rr.mechanisms of + Just ms -> Just (remove_id i $ attach_id 0 ms) + Nothing -> Nothing + } } + SPF_remove_modifier i -> + form { _rr { modifiers = case form._rr.modifiers of + Just ms -> Just (remove_id i $ attach_id 0 ms) + Nothing -> Nothing + } } + + SPF_Mechanism_Add -> + let m = form._rr.mechanisms + m_q = form.tmp.spf.mechanism_q + m_t = form.tmp.spf.mechanism_t + m_v = form.tmp.spf.mechanism_v + new_list_of_mechanisms = maybe [] id m <> maybe [] (\x -> [x]) (to_mechanism m_q m_t m_v) + new_value = case new_list_of_mechanisms of + [] -> Nothing + v -> Just v + in form { _rr { mechanisms = new_value }} + + SPF_Modifier_Add -> + let m = form._rr.modifiers + m_t = form.tmp.spf.modifier_t + m_v = form.tmp.spf.modifier_v + new_list_of_modifiers = maybe [] id m <> maybe [] (\x -> [x]) (to_modifier m_t m_v) + new_value = case new_list_of_modifiers of + [] -> Nothing + v -> Just v + in form { _rr { modifiers = new_value }} + + DMARC_mail v -> form { tmp { dmarc_mail = v } } + DMARC_mail_limit v -> form { tmp { dmarc_mail_limit = Just $ fromMaybe 0 $ fromString v } } + DMARC_ri v -> form { tmp { dmarc { ri = fromString v } } } + DMARC_rua_Add -> + case Email.email form.tmp.dmarc_mail of + Left errors -> form { _dmarc_mail_errors = errors } + Right _ -> + let current_ruas = fromMaybe [] form.tmp.dmarc.rua + new_list = current_ruas <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ] + in form { tmp { dmarc { rua = Just new_list }}} + + DMARC_ruf_Add -> + case Email.email form.tmp.dmarc_mail of + Left errors -> form { _dmarc_mail_errors = errors } + Right _ -> + let current_rufs = fromMaybe [] form.tmp.dmarc.ruf + new_list = current_rufs <> [ {mail: form.tmp.dmarc_mail, limit: form.tmp.dmarc_mail_limit} ] + in form { tmp { dmarc { ruf = Just new_list }}} + + DMARC_remove_rua i -> + let current_ruas = fromMaybe [] form.tmp.dmarc.rua + new_value = case (remove_id i $ attach_id 0 current_ruas) of + [] -> Nothing + v -> Just v + in form { tmp { dmarc { rua = new_value } } } + + DMARC_remove_ruf i -> + let current_rufs = fromMaybe [] form.tmp.dmarc.ruf + new_value = case (remove_id i $ attach_id 0 current_rufs) of + [] -> Nothing + v -> Just v + in form { tmp { dmarc { ruf = new_value } } } + + DMARC_policy v -> form { tmp { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } } + DMARC_sp_policy v -> form { tmp { dmarc { sp = DMARC.policies A.!! (v - 1) } } } + DMARC_adkim v -> form { tmp { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } } } + DMARC_aspf v -> form { tmp { dmarc { aspf = DMARC.consistency_policies A.!! (v - 1) } } } + DMARC_pct v -> form { tmp { dmarc { pct = Just $ fromMaybe 100 (fromString v) } } } + DMARC_fo v -> form { tmp { dmarc { fo = DMARC.report_occasions A.!! (v - 1) } } } + DKIM_hash_algo v -> form { tmp { dkim { h = DKIM.hash_algos A.!! v } } } + DKIM_sign_algo v -> form { tmp { dkim { k = DKIM.sign_algos A.!! v } } } + DKIM_pubkey v -> form { tmp { dkim { p = v } } } + DKIM_note v -> form { tmp { dkim { n = Just v } } }