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.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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user