From cf8380fff44043d80eb4092a6670044acae97f86 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Tue, 11 Jul 2023 04:18:43 +0200 Subject: [PATCH] Add new entries! --- src/App/Messages/DNSManagerDaemon.purs | 9 +++ src/App/ZoneInterface.purs | 105 ++++++++++++++----------- 2 files changed, 67 insertions(+), 47 deletions(-) diff --git a/src/App/Messages/DNSManagerDaemon.purs b/src/App/Messages/DNSManagerDaemon.purs index 8130299..361c965 100644 --- a/src/App/Messages/DNSManagerDaemon.purs +++ b/src/App/Messages/DNSManagerDaemon.purs @@ -187,6 +187,13 @@ type RRAdded = { domain :: String, rr :: ResourceRecord.ResourceRecord } codecRRAdded ∷ CA.JsonCodec RRAdded codecRRAdded = CA.object "RRAdded" (CAR.record { domain: CA.string, rr: ResourceRecord.codec }) +{- 20 -} +-- For now, Error is just an alias on String. +-- type InvalidZone = { errors : Array(Storage::Zone::Error) } +type InvalidRR = { errors :: Array String } +codecInvalidRR ∷ CA.JsonCodec InvalidRR +codecInvalidRR = CA.object "InvalidRR" (CAR.record { errors: CA.array CA.string }) + {- 50 -} type UnknownUser = { } @@ -234,6 +241,7 @@ data AnswerMessage | MkDomainAdded DomainAdded -- 17 | MkRRDeleted RRDeleted -- 18 | MkRRAdded RRAdded -- 19 + | MkInvalidRR InvalidRR -- 20 | MkUnknownUser UnknownUser -- 50 | MkNoOwnership NoOwnership -- 51 @@ -282,6 +290,7 @@ decode number string 17 -> error_management codecDomainAdded MkDomainAdded 18 -> error_management codecRRDeleted MkRRDeleted 19 -> error_management codecRRAdded MkRRAdded + 20 -> error_management codecInvalidRR MkInvalidRR 50 -> error_management codecUnknownUser MkUnknownUser 51 -> error_management codecNoOwnership MkNoOwnership _ -> Left UnknownNumber diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index ee1a96b..2a8eb66 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -298,10 +298,13 @@ handleAction = case _ of -- This action only is possible if inputs are correct. AddSRR -> do - H.raise $ Log $ SimpleLog ("Add simple entry") state <- H.get - H.raise $ Log $ SimpleLog ("Add simple entry: " <> show state._current_entry) - -- H.put $ add_new_entry state state._current_entry + let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry + H.raise $ Log $ SimpleLog ("Add new simple RR: " <> show state._current_entry) + message <- H.liftEffect + $ DNSManager.serialize + $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } + H.raise $ MessageToSend message AddMX -> do state <- H.get let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx @@ -312,8 +315,12 @@ handleAction = case _ of H.raise $ MessageToSend message AddSRV -> do state <- H.get + let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv) - -- H.put $ add_new_srv state state._current_entry_srv + message <- H.liftEffect + $ DNSManager.serialize + $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } + H.raise $ MessageToSend message UpdateLocalSRRForm rr_id rr_update -> case rr_update of Update_SRR_Type val -> do @@ -401,37 +408,6 @@ handleAction = case _ of -- H.raise $ Log $ SimpleLog (show rr) H.raise $ Log $ SimpleLog (" => " <> val) --- HandleNewDomainInput adduserinp -> do --- case adduserinp of --- INP_newdomain v -> H.modify_ _ { newDomainForm { new_domain = v } } --- UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } } --- --- EnterDomain domain -> do --- H.raise $ Log $ SimpleLog $ "[???] trying to enter domain: " <> domain --- --- RemoveRR domain -> do --- message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain } --- H.raise $ MessageToSend message --- H.raise $ Log $ SimpleLog $ "[😇] Removing domain: " <> domain --- H.modify_ _ { active_modal = Nothing } --- --- NewDomainAttempt ev -> do --- H.liftEffect $ Event.preventDefault ev --- --- { newDomainForm } <- H.get --- let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain --- --- case new_domain of --- "" -> --- H.raise $ Log $ UnableToSend "You didn't enter the new domain!" --- _ -> do --- message <- H.liftEffect --- $ DNSManager.serialize --- $ DNSManager.MkNewDomain { domain: new_domain } --- H.raise $ MessageToSend message --- H.raise $ Log $ SimpleLog $ "[😇] Trying to add a new domain (" <> new_domain <> ")" --- handleAction $ HandleNewDomainInput $ INP_newdomain "" - handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of @@ -505,16 +481,17 @@ handleQuery = case _ of } (DNSManager.MkZone response) -> do - H.raise $ Log $ SimpleLog $ "[🎉] Got the zone!" - H.raise $ Log $ SimpleLog $ "DEBUG: the zone has domain: " <> response.zone.domain - H.raise $ Log $ SimpleLog $ "DEBUG: zone: " <> show_zone response.zone + H.raise $ Log $ SimpleLog $ "[🎉] Zone received!" add_entries response.zone.resources + (DNSManager.MkInvalidRR response) -> do + H.raise $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors + (DNSManager.MkSuccess _) -> do H.raise $ Log $ SimpleLog $ "[🎉] Success!" -- WTH?! _ -> do - H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message." + H.raise $ Log $ SimpleLog $ "[😈] Failed! dnsmanager daemon didn't send a valid message." pure (Just a) ConnectionIsDown a -> do @@ -526,14 +503,6 @@ handleQuery = case _ of pure (Just a) where - show_zone zone - = "domain: " <> zone.domain <> " | " <> resource_list zone.resources - where - resource_list [] = "" - resource_list arr = case A.uncons arr of - Just { head: x, tail: xs } -> "(" <> x.rrtype <> ": " <> show x.rrid <> ") " <> resource_list xs - Nothing -> "" - add_entries [] = H.raise $ Log $ SimpleLog "Done adding entries" add_entries arr = do state <- H.get @@ -884,6 +853,27 @@ fromResourceRecordToLocalRepresentationSRVRR new_rr = do } _, _, _ -> Nothing +fromLocalSimpleRRRepresentationToResourceRecord :: SimpleRR () -> ResourceRecord +fromLocalSimpleRRRepresentationToResourceRecord form + = { rrtype: form.t + , rrid: form.id + , name: form.domain + , ttl: fromMaybe 3600 $ fromString form.ttl + , target: form.value + , readonly: false + , priority: Nothing + , port: Nothing + , protocol: Nothing + , weight: Nothing + , mname: Nothing + , rname: Nothing + , serial: Nothing + , refresh: Nothing + , retry: Nothing + , expire: Nothing + , minttl: Nothing + } + fromLocalMXRRRepresentationToResourceRecord :: MXRR () -> ResourceRecord fromLocalMXRRRepresentationToResourceRecord form = { rrtype: form.t @@ -905,6 +895,27 @@ fromLocalMXRRRepresentationToResourceRecord form , minttl: Nothing } +fromLocalSRVRRepresentationToResourceRecord :: SRVRR () -> ResourceRecord +fromLocalSRVRRepresentationToResourceRecord form + = { rrtype: form.t + , rrid: form.id + , name: form.domain + , ttl: fromMaybe 3600 $ fromString form.ttl + , target: form.value + , readonly: false + , priority: Just $ fromMaybe 10 $ fromString form.priority + , port: Just $ fromMaybe 10 $ fromString form.port + , protocol: Just "" -- TODO: 'protocol' seems to have been forgotten. + , weight: Just $ fromMaybe 10 $ fromString form.weight + , mname: Nothing + , rname: Nothing + , serial: Nothing + , refresh: Nothing + , retry: Nothing + , expire: Nothing + , minttl: Nothing + } + getNewID :: State -> Int getNewID state = (_ + 1) $ Foldable.foldl max 0 [ maxIDrr