Add new entries!

This commit is contained in:
Philippe Pittoli 2023-07-11 04:18:43 +02:00
parent 0680c9f1ab
commit cf8380fff4
2 changed files with 67 additions and 47 deletions

View File

@ -187,6 +187,13 @@ type RRAdded = { domain :: String, rr :: ResourceRecord.ResourceRecord }
codecRRAdded ∷ CA.JsonCodec RRAdded codecRRAdded ∷ CA.JsonCodec RRAdded
codecRRAdded = CA.object "RRAdded" (CAR.record { domain: CA.string, rr: ResourceRecord.codec }) 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 -} {- 50 -}
type UnknownUser = { } type UnknownUser = { }
@ -234,6 +241,7 @@ data AnswerMessage
| MkDomainAdded DomainAdded -- 17 | MkDomainAdded DomainAdded -- 17
| MkRRDeleted RRDeleted -- 18 | MkRRDeleted RRDeleted -- 18
| MkRRAdded RRAdded -- 19 | MkRRAdded RRAdded -- 19
| MkInvalidRR InvalidRR -- 20
| MkUnknownUser UnknownUser -- 50 | MkUnknownUser UnknownUser -- 50
| MkNoOwnership NoOwnership -- 51 | MkNoOwnership NoOwnership -- 51
@ -282,6 +290,7 @@ decode number string
17 -> error_management codecDomainAdded MkDomainAdded 17 -> error_management codecDomainAdded MkDomainAdded
18 -> error_management codecRRDeleted MkRRDeleted 18 -> error_management codecRRDeleted MkRRDeleted
19 -> error_management codecRRAdded MkRRAdded 19 -> error_management codecRRAdded MkRRAdded
20 -> error_management codecInvalidRR MkInvalidRR
50 -> error_management codecUnknownUser MkUnknownUser 50 -> error_management codecUnknownUser MkUnknownUser
51 -> error_management codecNoOwnership MkNoOwnership 51 -> error_management codecNoOwnership MkNoOwnership
_ -> Left UnknownNumber _ -> Left UnknownNumber

View File

@ -298,10 +298,13 @@ handleAction = case _ of
-- This action only is possible if inputs are correct. -- This action only is possible if inputs are correct.
AddSRR -> do AddSRR -> do
H.raise $ Log $ SimpleLog ("Add simple entry")
state <- H.get state <- H.get
H.raise $ Log $ SimpleLog ("Add simple entry: " <> show state._current_entry) let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry
-- H.put $ add_new_entry state 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 AddMX -> do
state <- H.get state <- H.get
let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx
@ -312,8 +315,12 @@ handleAction = case _ of
H.raise $ MessageToSend message H.raise $ MessageToSend message
AddSRV -> do AddSRV -> do
state <- H.get state <- H.get
let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv
H.raise $ Log $ SimpleLog ("Add new SRV: " <> show 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 UpdateLocalSRRForm rr_id rr_update -> case rr_update of
Update_SRR_Type val -> do Update_SRR_Type val -> do
@ -401,37 +408,6 @@ handleAction = case _ of
-- H.raise $ Log $ SimpleLog (show rr) -- H.raise $ Log $ SimpleLog (show rr)
H.raise $ Log $ SimpleLog (" => " <> val) 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 :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of handleQuery = case _ of
@ -505,16 +481,17 @@ handleQuery = case _ of
} }
(DNSManager.MkZone response) -> do (DNSManager.MkZone response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] Got the zone!" H.raise $ Log $ SimpleLog $ "[🎉] Zone received!"
H.raise $ Log $ SimpleLog $ "DEBUG: the zone has domain: " <> response.zone.domain
H.raise $ Log $ SimpleLog $ "DEBUG: zone: " <> show_zone response.zone
add_entries response.zone.resources add_entries response.zone.resources
(DNSManager.MkInvalidRR response) -> do
H.raise $ Log $ SimpleLog $ "[😈] Invalid resource record: " <> A.intercalate ", " response.errors
(DNSManager.MkSuccess _) -> do (DNSManager.MkSuccess _) -> do
H.raise $ Log $ SimpleLog $ "[🎉] Success!" H.raise $ Log $ SimpleLog $ "[🎉] Success!"
-- WTH?! -- WTH?!
_ -> do _ -> 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) pure (Just a)
ConnectionIsDown a -> do ConnectionIsDown a -> do
@ -526,14 +503,6 @@ handleQuery = case _ of
pure (Just a) pure (Just a)
where 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 [] = H.raise $ Log $ SimpleLog "Done adding entries"
add_entries arr = do add_entries arr = do
state <- H.get state <- H.get
@ -884,6 +853,27 @@ fromResourceRecordToLocalRepresentationSRVRR new_rr = do
} }
_, _, _ -> Nothing _, _, _ -> 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 :: MXRR () -> ResourceRecord
fromLocalMXRRRepresentationToResourceRecord form fromLocalMXRRRepresentationToResourceRecord form
= { rrtype: form.t = { rrtype: form.t
@ -905,6 +895,27 @@ fromLocalMXRRRepresentationToResourceRecord form
, minttl: Nothing , 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 -> Int
getNewID state = (_ + 1) getNewID state = (_ + 1)
$ Foldable.foldl max 0 [ maxIDrr $ Foldable.foldl max 0 [ maxIDrr