Add new entries!
This commit is contained in:
parent
0680c9f1ab
commit
cf8380fff4
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user