WIP: modals. CANNOT COMPILE ATM.
parent
1f4191acba
commit
e343523142
|
@ -124,15 +124,16 @@ data Update_Local_Form
|
||||||
|
|
||||||
-- | Steps to create a new RR:
|
-- | Steps to create a new RR:
|
||||||
-- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
|
-- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
|
||||||
-- | 2. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_newRR`.
|
-- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR.
|
||||||
|
-- | 3. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_currentRR`.
|
||||||
-- | In case it works, automatically call `AddRR` then `CancelModal`.
|
-- | In case it works, automatically call `AddRR` then `CancelModal`.
|
||||||
-- | 3. `AddRR AcceptedRRTypes ResourceRecord`: send a message to `dnsmanagerd`.
|
-- | 4. `AddRR AcceptedRRTypes ResourceRecord`: send a message to `dnsmanagerd`.
|
||||||
-- |
|
-- |
|
||||||
-- | Steps to update an entry:
|
-- | Steps to update an entry:
|
||||||
-- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update.
|
-- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update.
|
||||||
-- | 2. `UpdateCurrentRR RRId Field`: modify the currently displayed RR.
|
-- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR.
|
||||||
-- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the RR.
|
-- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the RR.
|
||||||
-- | 4. `UpdateRR ResourceRecord`: save the _validated_ RR.
|
-- | 4. `SaveRR ResourceRecord`: save the _validated_ RR by sending a message to `dnsmanagerd`.
|
||||||
-- |
|
-- |
|
||||||
-- | TODO:
|
-- | TODO:
|
||||||
-- | In both cases, once the add (or update) is performed, the resource should be added (updated) in `_resources`.
|
-- | In both cases, once the add (or update) is performed, the resource should be added (updated) in `_resources`.
|
||||||
|
@ -163,18 +164,15 @@ data Action
|
||||||
| ValidateLocal RRId AcceptedRRTypes
|
| ValidateLocal RRId AcceptedRRTypes
|
||||||
|
|
||||||
-- | Save the changes done in an already existing resource record.
|
-- | Save the changes done in an already existing resource record.
|
||||||
| UpdateRR ResourceRecord
|
| SaveRR ResourceRecord
|
||||||
|
|
||||||
-- | Update new entry form (in the `rr_modal` modal).
|
-- | Update new entry form (in the `rr_modal` modal).
|
||||||
| UpdateCurrentlyDisplayedRRForm Field
|
| UpdateCurrentRR Field
|
||||||
|
|
||||||
-- TODO: Update an already existing resource record (update _resources).
|
-- | TODO: OLD: Update an already active entry.
|
||||||
| UpdateCurrentRR RRId Field
|
|
||||||
|
|
||||||
-- | Update an already active entry.
|
|
||||||
| UpdateLocalRR RRId Update_Local_Form
|
| UpdateLocalRR RRId Update_Local_Form
|
||||||
|
|
||||||
-- TODO: Update an already existing resource record (update _resources).
|
-- TODO: OLD: Update an already existing resource record (update _resources).
|
||||||
| SaveSRR RRId
|
| SaveSRR RRId
|
||||||
| SaveMXRR RRId
|
| SaveMXRR RRId
|
||||||
| SaveSRVRR RRId
|
| SaveSRVRR RRId
|
||||||
|
@ -185,13 +183,39 @@ data Action
|
||||||
|
|
||||||
-- |
|
-- |
|
||||||
|
|
||||||
|
data RRModal
|
||||||
|
= NoModal
|
||||||
|
| NewRRModal AcceptedRRTypes
|
||||||
|
| UpdateRRModal
|
||||||
|
| RemoveRRModal RRId
|
||||||
|
|
||||||
|
show_accepted_type :: AcceptedRRTypes -> String
|
||||||
|
show_accepted_type = case _ of
|
||||||
|
A -> "A"
|
||||||
|
AAAA -> "AAAA"
|
||||||
|
TXT -> "TXT"
|
||||||
|
CNAME -> "CNAME"
|
||||||
|
NS -> "NS"
|
||||||
|
MX -> "MX"
|
||||||
|
SRV -> "SRV"
|
||||||
|
|
||||||
|
string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
|
||||||
|
string_to_acceptedtype str = case str of
|
||||||
|
"A" -> Just A
|
||||||
|
"AAAA" -> Just AAAA
|
||||||
|
"TXT" -> Just TXT
|
||||||
|
"CNAME" -> Just CNAME
|
||||||
|
"NS" -> Just NS
|
||||||
|
"MX" -> Just MX
|
||||||
|
"SRV" -> Just SRV
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
type State =
|
type State =
|
||||||
{ _domain :: RecordName
|
{ _domain :: RecordName
|
||||||
, wsUp :: Boolean
|
, wsUp :: Boolean
|
||||||
, deletion_modal :: Maybe Int
|
|
||||||
|
|
||||||
-- A modal to present a form for adding a new RR.
|
-- A modal to present a form for adding a new RR.
|
||||||
, rr_modal :: Maybe AcceptedRRTypes
|
, rr_modal :: RRModal
|
||||||
|
|
||||||
-- TODO: get all the resources in a single entry.
|
-- TODO: get all the resources in a single entry.
|
||||||
-- Better that way: simpler code.
|
-- Better that way: simpler code.
|
||||||
|
@ -206,8 +230,8 @@ type State =
|
||||||
, _errors :: Hash.HashMap RRId Validation.Errors
|
, _errors :: Hash.HashMap RRId Validation.Errors
|
||||||
|
|
||||||
-- Unique RR form.
|
-- Unique RR form.
|
||||||
, _newRR :: (SRVRR ()) -- SRVRR contains all relevant information for every RR.
|
, _currentRR :: (SRVRR ()) -- SRVRR contains all relevant information for every RR.
|
||||||
, _newRR_errors :: Array Validation.ValidationError
|
, _currentRR_errors :: Array Validation.ValidationError
|
||||||
|
|
||||||
-- potential future entries
|
-- potential future entries
|
||||||
, _newSRR :: (SimpleRR ())
|
, _newSRR :: (SimpleRR ())
|
||||||
|
@ -238,8 +262,7 @@ default_domain = "netlib.re"
|
||||||
initialState :: Input -> State
|
initialState :: Input -> State
|
||||||
initialState domain =
|
initialState domain =
|
||||||
{ wsUp: true
|
{ wsUp: true
|
||||||
, deletion_modal: Nothing
|
, rr_modal: NoModal
|
||||||
, rr_modal: Nothing
|
|
||||||
|
|
||||||
, _domain: domain
|
, _domain: domain
|
||||||
|
|
||||||
|
@ -253,9 +276,9 @@ initialState domain =
|
||||||
, _errors: Hash.empty
|
, _errors: Hash.empty
|
||||||
|
|
||||||
-- This is the state for the new RR modal.
|
-- This is the state for the new RR modal.
|
||||||
, _newRR: defaultResourceSRV
|
, _currentRR: defaultResourceSRV
|
||||||
-- List of errors within the form in new RR modal.
|
-- List of errors within the form in new RR modal.
|
||||||
, _newRR_errors: []
|
, _currentRR_errors: []
|
||||||
|
|
||||||
, _newSRR: defaultResourceA
|
, _newSRR: defaultResourceA
|
||||||
, _newMXRR: defaultResourceMX
|
, _newMXRR: defaultResourceMX
|
||||||
|
@ -270,20 +293,22 @@ type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)
|
||||||
render :: forall m. State -> H.ComponentHTML Action () m
|
render :: forall m. State -> H.ComponentHTML Action () m
|
||||||
render state
|
render state
|
||||||
= Bulma.section_small
|
= Bulma.section_small
|
||||||
[ case state.wsUp, state.deletion_modal, state.rr_modal of
|
[ case state.wsUp, state.rr_modal of
|
||||||
false, _, _ -> Bulma.p "You are disconnected."
|
false, _ -> Bulma.p "You are disconnected."
|
||||||
true, Just rr_id, _ -> modal_rr_delete rr_id
|
true, RemoveRRModal rr_id -> modal_rr_delete rr_id
|
||||||
true, Nothing, Just t -> modal_add_new_rr t
|
true, NewRRModal t -> modal_add_new_rr t
|
||||||
true, Nothing, Nothing -> HH.div_ [ Bulma.h1 state._domain
|
true, UpdateRRModal -> modal_add_new_rr -- render_current_rr_modal rr_id
|
||||||
, Bulma.hr
|
true, NoModal -> HH.div_
|
||||||
, render_resources state._local_errors $ sorted state._resources
|
[ Bulma.h1 state._domain
|
||||||
, Bulma.hr
|
, Bulma.hr
|
||||||
, render_soa state._soa
|
, render_resources state._local_errors $ sorted state._resources
|
||||||
, render_records state._errors $ sorted state._srr
|
, Bulma.hr
|
||||||
, render_mx_records state._errors $ sorted state._mxrr
|
, render_soa state._soa
|
||||||
, render_srv_records state._errors $ sorted state._srvrr
|
, render_records state._errors $ sorted state._srr
|
||||||
, render_new_records state
|
, render_mx_records state._errors $ sorted state._mxrr
|
||||||
]
|
, render_srv_records state._errors $ sorted state._srvrr
|
||||||
|
, render_new_records state
|
||||||
|
]
|
||||||
]
|
]
|
||||||
where
|
where
|
||||||
sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l))
|
sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l))
|
||||||
|
@ -311,38 +336,49 @@ render state
|
||||||
, HH.text "."
|
, HH.text "."
|
||||||
]
|
]
|
||||||
|
|
||||||
|
-- TODO: this seems overly complicated.
|
||||||
|
-- Verification if the RR exists has been already done.
|
||||||
|
render_current_rr_modal :: forall w. RRId -> HH.HTML w Action
|
||||||
|
render_current_rr_modal rr_id = do
|
||||||
|
case first (\rr -> rr.rrid == rr_id) state._resources of
|
||||||
|
Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")"
|
||||||
|
Just entry -> do
|
||||||
|
case string_to_acceptedtype entry.rrtype of
|
||||||
|
Nothing -> H.raise $ Log $ SimpleLog $ "RR " <> show rr_id <> ": cannot determine the type"
|
||||||
|
Just type_ -> modal_add_new_rr type_
|
||||||
|
|
||||||
modal_add_new_rr :: forall w. AcceptedRRTypes -> HH.HTML w Action
|
modal_add_new_rr :: forall w. AcceptedRRTypes -> HH.HTML w Action
|
||||||
modal_add_new_rr t = case t of
|
modal_add_new_rr t = case t of
|
||||||
A -> template "A" (content_simple "A") (foot_content A)
|
A -> template (content_simple "A") (foot_content t)
|
||||||
AAAA -> template "AAAA" (content_simple "AAAA") (foot_content AAAA)
|
AAAA -> template (content_simple "AAAA") (foot_content t)
|
||||||
TXT -> template "TXT" (content_simple "TXT") (foot_content TXT)
|
TXT -> template (content_simple "TXT") (foot_content t)
|
||||||
CNAME -> template "CNAME" (content_simple "CNAME") (foot_content CNAME)
|
CNAME -> template (content_simple "CNAME") (foot_content t)
|
||||||
NS -> template "NS" (content_simple "NS") (foot_content NS)
|
NS -> template (content_simple "NS") (foot_content t)
|
||||||
MX -> template "MX" content_mx (foot_content MX)
|
MX -> template content_mx (foot_content t)
|
||||||
SRV -> template "SRV" content_srv (foot_content SRV)
|
SRV -> template content_srv (foot_content t)
|
||||||
where
|
where
|
||||||
-- DRY
|
-- DRY
|
||||||
updateForm x = UpdateCurrentlyDisplayedRRForm <<< x
|
updateForm x = UpdateCurrentRR <<< x
|
||||||
render_errors = if A.length state._newRR_errors > 0
|
render_errors = if A.length state._currentRR_errors > 0
|
||||||
then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors
|
then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._currentRR_errors
|
||||||
else HH.div_ [ ]
|
else HH.div_ [ ]
|
||||||
content_simple :: String -> Array (HH.HTML w Action)
|
content_simple :: String -> Array (HH.HTML w Action)
|
||||||
content_simple t_ =
|
content_simple t_ =
|
||||||
[ render_errors
|
[ render_errors
|
||||||
, Bulma.box_input ("domain" <> t_) "Name" "www" -- id, title, placeholder
|
, Bulma.box_input ("domain" <> t_) "Name" "www" -- id, title, placeholder
|
||||||
(updateForm Field_Domain) -- action
|
(updateForm Field_Domain) -- action
|
||||||
state._newRR.name -- value
|
state._currentRR.name -- value
|
||||||
state._newRR.valid -- validity (TODO)
|
state._currentRR.valid -- validity (TODO)
|
||||||
should_be_disabled -- condition
|
should_be_disabled -- condition
|
||||||
, Bulma.box_input ("ttl" <> t_) "TTL" "600"
|
, Bulma.box_input ("ttl" <> t_) "TTL" "600"
|
||||||
(updateForm Field_TTL)
|
(updateForm Field_TTL)
|
||||||
state._newRR.ttl
|
state._currentRR.ttl
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("target" <> t_) "Target" "198.51.100.5"
|
, Bulma.box_input ("target" <> t_) "Target" "198.51.100.5"
|
||||||
(updateForm Field_Target)
|
(updateForm Field_Target)
|
||||||
state._newRR.target
|
state._currentRR.target
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
]
|
]
|
||||||
content_mx :: Array (HH.HTML w Action)
|
content_mx :: Array (HH.HTML w Action)
|
||||||
|
@ -350,23 +386,23 @@ render state
|
||||||
[ render_errors
|
[ render_errors
|
||||||
, Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder
|
, Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder
|
||||||
(updateForm Field_Domain) -- action
|
(updateForm Field_Domain) -- action
|
||||||
state._newRR.name -- value
|
state._currentRR.name -- value
|
||||||
state._newRR.valid -- validity (TODO)
|
state._currentRR.valid -- validity (TODO)
|
||||||
should_be_disabled -- condition
|
should_be_disabled -- condition
|
||||||
, Bulma.box_input ("ttlMX") "TTL" "600"
|
, Bulma.box_input ("ttlMX") "TTL" "600"
|
||||||
(updateForm Field_TTL)
|
(updateForm Field_TTL)
|
||||||
state._newRR.ttl
|
state._currentRR.ttl
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("targetMX") "Target" "www"
|
, Bulma.box_input ("targetMX") "Target" "www"
|
||||||
(updateForm Field_Target)
|
(updateForm Field_Target)
|
||||||
state._newRR.target
|
state._currentRR.target
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("priorityMX") "Priority" "10"
|
, Bulma.box_input ("priorityMX") "Priority" "10"
|
||||||
(updateForm Field_Priority)
|
(updateForm Field_Priority)
|
||||||
state._newRR.priority
|
state._currentRR.priority
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
]
|
]
|
||||||
content_srv :: Array (HH.HTML w Action)
|
content_srv :: Array (HH.HTML w Action)
|
||||||
|
@ -374,48 +410,52 @@ render state
|
||||||
[ render_errors
|
[ render_errors
|
||||||
, Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder
|
, Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder
|
||||||
(updateForm Field_Domain) -- action
|
(updateForm Field_Domain) -- action
|
||||||
state._newRR.name -- value
|
state._currentRR.name -- value
|
||||||
state._newRR.valid -- validity (TODO)
|
state._currentRR.valid -- validity (TODO)
|
||||||
should_be_disabled -- condition
|
should_be_disabled -- condition
|
||||||
, Bulma.box_input ("ttlSRV") "TTL" "600"
|
, Bulma.box_input ("ttlSRV") "TTL" "600"
|
||||||
(updateForm Field_TTL)
|
(updateForm Field_TTL)
|
||||||
state._newRR.ttl
|
state._currentRR.ttl
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("targetSRV") "Target" "www"
|
, Bulma.box_input ("targetSRV") "Target" "www"
|
||||||
(updateForm Field_Target)
|
(updateForm Field_Target)
|
||||||
state._newRR.target
|
state._currentRR.target
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("prioritySRV") "Priority" "10"
|
, Bulma.box_input ("prioritySRV") "Priority" "10"
|
||||||
(updateForm Field_Priority)
|
(updateForm Field_Priority)
|
||||||
state._newRR.priority
|
state._currentRR.priority
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("portSRV") "Port" "5061"
|
, Bulma.box_input ("portSRV") "Port" "5061"
|
||||||
(updateForm Field_Port)
|
(updateForm Field_Port)
|
||||||
state._newRR.port
|
state._currentRR.port
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("weightSRV") "Weight" "100"
|
, Bulma.box_input ("weightSRV") "Weight" "100"
|
||||||
(updateForm Field_Weight)
|
(updateForm Field_Weight)
|
||||||
state._newRR.weight
|
state._currentRR.weight
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
, Bulma.box_input ("protocolSRV") "Protocol" "tcp"
|
, Bulma.box_input ("protocolSRV") "Protocol" "tcp"
|
||||||
(updateForm Field_Protocol)
|
(updateForm Field_Protocol)
|
||||||
state._newRR.protocol
|
state._currentRR.protocol
|
||||||
state._newRR.valid
|
state._currentRR.valid
|
||||||
should_be_disabled
|
should_be_disabled
|
||||||
]
|
]
|
||||||
|
|
||||||
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
|
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
|
||||||
foot_content x = [ Bulma.btn_add (ValidateRR x)
|
foot_content x = [ Bulma.btn_add (ValidateRR x)
|
||||||
(TellSomethingWentWrong state._newRR.rrid "cannot add")
|
(TellSomethingWentWrong state._currentRR.rrid "cannot add")
|
||||||
state._newRR.valid ]
|
state._currentRR.valid ]
|
||||||
template t_ content foot = Bulma.modal
|
template content foot = Bulma.modal
|
||||||
[ Bulma.modal_background
|
[ Bulma.modal_background
|
||||||
, Bulma.modal_card [Bulma.modal_header $ "New " <> t_ <> " resource record"
|
, Bulma.modal_card [Bulma.modal_header $ case state.rr_modal of
|
||||||
|
NoModal -> "Error: no modal should be displayed"
|
||||||
|
NewRRModal t_ -> "New " <> show_accepted_type t_ <> " resource record"
|
||||||
|
UpdateRRModal -> "Update RR " <> show state._currentRR.rrid <> " resource record"
|
||||||
|
RemoveRRModal rr_id -> "Error: should display removal modal instead (for RR " <> show rr_id <> ")"
|
||||||
, Bulma.modal_body content ]
|
, Bulma.modal_body content ]
|
||||||
, Bulma.modal_foot (foot <> [Bulma.modal_cancel_button CancelModal])
|
, Bulma.modal_foot (foot <> [Bulma.modal_cancel_button CancelModal])
|
||||||
]
|
]
|
||||||
|
@ -425,19 +465,19 @@ handleAction = case _ of
|
||||||
-- | Cancel the current modal being presented.
|
-- | Cancel the current modal being presented.
|
||||||
-- | Works for both "new RR", "update RR" and "remove RR" modals.
|
-- | Works for both "new RR", "update RR" and "remove RR" modals.
|
||||||
CancelModal -> do
|
CancelModal -> do
|
||||||
H.modify_ _ { deletion_modal = Nothing, rr_modal = Nothing }
|
H.modify_ _ { rr_modal = NoModal }
|
||||||
H.modify_ _ { _newRR_errors = [] }
|
H.modify_ _ { _currentRR_errors = [] }
|
||||||
|
|
||||||
-- | Create the RR modal.
|
-- | Create the RR modal.
|
||||||
DeleteRRModal rr_id -> do
|
DeleteRRModal rr_id -> do
|
||||||
H.modify_ _ { deletion_modal = Just rr_id }
|
H.modify_ _ { rr_modal = RemoveRRModal rr_id }
|
||||||
|
|
||||||
-- | Create modal (a form) for a resource record to update.
|
-- | Create modal (a form) for a resource record to update.
|
||||||
CreateUpdateRRModal rr_id -> do
|
CreateUpdateRRModal rr_id -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
case first (\rr -> rr.rrid == rr_id) state._resources of
|
case first (\rr -> rr.rrid == rr_id) state._resources of
|
||||||
Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")"
|
Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")"
|
||||||
Just rr -> H.modify_ _ { _newRR = rr }
|
Just rr -> H.modify_ _ { _currentRR = rr }
|
||||||
|
|
||||||
-- | Each time a "new RR" button is clicked, the form resets.
|
-- | Each time a "new RR" button is clicked, the form resets.
|
||||||
CreateNewRRModal t -> do
|
CreateNewRRModal t -> do
|
||||||
|
@ -472,13 +512,13 @@ handleAction = case _ of
|
||||||
, target: "www"
|
, target: "www"
|
||||||
, port: "5061", weight: "100", priority: "10", protocol: "tcp"}
|
, port: "5061", weight: "100", priority: "10", protocol: "tcp"}
|
||||||
case t of
|
case t of
|
||||||
A -> H.modify_ _ { _newRR = defaultA }
|
A -> H.modify_ _ { _currentRR = defaultA }
|
||||||
AAAA -> H.modify_ _ { _newRR = defaultAAAA }
|
AAAA -> H.modify_ _ { _currentRR = defaultAAAA }
|
||||||
TXT -> H.modify_ _ { _newRR = defaultTXT }
|
TXT -> H.modify_ _ { _currentRR = defaultTXT }
|
||||||
CNAME -> H.modify_ _ { _newRR = defaultCNAME }
|
CNAME -> H.modify_ _ { _currentRR = defaultCNAME }
|
||||||
NS -> H.modify_ _ { _newRR = defaultNS }
|
NS -> H.modify_ _ { _currentRR = defaultNS }
|
||||||
MX -> H.modify_ _ { _newRR = defaultMX }
|
MX -> H.modify_ _ { _currentRR = defaultMX }
|
||||||
SRV -> H.modify_ _ { _newRR = defaultSRV }
|
SRV -> H.modify_ _ { _currentRR = defaultSRV }
|
||||||
|
|
||||||
-- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
|
-- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
|
||||||
Initialize -> do
|
Initialize -> do
|
||||||
|
@ -487,49 +527,17 @@ handleAction = case _ of
|
||||||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain }
|
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain }
|
||||||
H.raise $ MessageToSend message
|
H.raise $ MessageToSend message
|
||||||
|
|
||||||
-- Update for the new RR form in the new RR modal.
|
|
||||||
UpdateCurrentlyDisplayedRRForm rr_update -> case rr_update of
|
|
||||||
Field_Domain val -> do
|
|
||||||
-- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val)
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _newRR = state._newRR { name = val } }
|
|
||||||
Field_Target val -> do
|
|
||||||
-- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val)
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _newRR = state._newRR { target = val } }
|
|
||||||
-- TODO: FIXME: test all inputs
|
|
||||||
Field_TTL val -> do
|
|
||||||
-- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _newRR = state._newRR {ttl = val, valid = isInteger val}}
|
|
||||||
Field_Priority val -> do
|
|
||||||
-- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _newRR = state._newRR { priority = val } }
|
|
||||||
Field_Protocol val -> do
|
|
||||||
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val)
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _newRR = state._newRR { protocol = val } }
|
|
||||||
Field_Weight val -> do
|
|
||||||
-- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _newRR = state._newRR { weight = val } }
|
|
||||||
Field_Port val -> do
|
|
||||||
-- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
|
|
||||||
state <- H.get
|
|
||||||
H.modify_ _ { _newRR = state._newRR { port = val } }
|
|
||||||
|
|
||||||
-- | Perform validation. In case the record is valid, it is added to the zone then the modal is closed.
|
-- | Perform validation. In case the record is valid, it is added to the zone then the modal is closed.
|
||||||
-- | Else, the different errors are added to the state.
|
-- | Else, the different errors are added to the state.
|
||||||
ValidateRR t -> do
|
ValidateRR t -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
case Validation.validation state._newRR t of
|
case Validation.validation state._currentRR t of
|
||||||
Left actual_errors -> do
|
Left actual_errors -> do
|
||||||
-- H.raise $ Log $ SimpleLog $ "Cannot add this " <> show t <> " RR, some errors occured in the record:"
|
-- H.raise $ Log $ SimpleLog $ "Cannot add this " <> show t <> " RR, some errors occured in the record:"
|
||||||
-- loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> show_error v) actual_errors
|
-- loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> show_error v) actual_errors
|
||||||
H.modify_ _ { _newRR_errors = actual_errors }
|
H.modify_ _ { _currentRR_errors = actual_errors }
|
||||||
Right newrr -> do
|
Right newrr -> do
|
||||||
H.modify_ _ { _newRR_errors = [] }
|
H.modify_ _ { _currentRR_errors = [] }
|
||||||
handleAction $ AddRR t newrr
|
handleAction $ AddRR t newrr
|
||||||
handleAction CancelModal
|
handleAction CancelModal
|
||||||
|
|
||||||
|
@ -543,17 +551,24 @@ handleAction = case _ of
|
||||||
$ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
|
$ DNSManager.MkAddRR { domain: state._domain, rr: newrr }
|
||||||
H.raise $ MessageToSend message
|
H.raise $ MessageToSend message
|
||||||
|
|
||||||
UpdateCurrentRR rr_id field -> do
|
-- | Update the currently displayed RR form (new or update RR).
|
||||||
|
UpdateCurrentRR field -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.raise $ Log $ SimpleLog $ "Let's try to update entry number " <> show rr_id
|
let newRR = update_field state._currentRR field
|
||||||
let replaceRR rr1 rr2 | rr1.rrid == rr2.rrid = rr1
|
H.modify_ _ { _currentRR = newRR }
|
||||||
| otherwise = rr2
|
|
||||||
maybeentry = first (\rr -> rr.rrid == rr_id) state._resources
|
-- TODO: this code can be used to replace the old RR with the updated one, once received by `dnsmanagerd`.
|
||||||
case maybeentry of
|
-- Update_Current_RR rr_id field -> do
|
||||||
Nothing -> H.raise $ Log $ SimpleLog ("Local Update Failed (RR " <> show rr_id <> ")")
|
-- state <- H.get
|
||||||
Just entry -> do
|
-- H.raise $ Log $ SimpleLog $ "Let's try to update entry number " <> show rr_id
|
||||||
let new_entry = update_field entry field
|
-- let replaceRR rr1 rr2 | rr1.rrid == rr2.rrid = rr1
|
||||||
H.modify_ _ { _resources = (map (replaceRR entry) state._resources) }
|
-- | otherwise = rr2
|
||||||
|
-- maybeentry = first (\rr -> rr.rrid == rr_id) state._resources
|
||||||
|
-- case maybeentry of
|
||||||
|
-- Nothing -> H.raise $ Log $ SimpleLog ("Local Update Failed (RR " <> show rr_id <> ")")
|
||||||
|
-- Just entry -> do
|
||||||
|
-- let new_entry = update_field entry field
|
||||||
|
-- H.modify_ _ { _resources = (map (replaceRR entry) state._resources) }
|
||||||
|
|
||||||
UpdateLocalRR rr_id form -> case form of
|
UpdateLocalRR rr_id form -> case form of
|
||||||
Update_Local_Form_SRR rr_update -> case rr_update of
|
Update_Local_Form_SRR rr_update -> case rr_update of
|
||||||
|
@ -637,9 +652,9 @@ handleAction = case _ of
|
||||||
Right rr -> do
|
Right rr -> do
|
||||||
let new_error_hash = Hash.delete local_rr.rrid state._local_errors
|
let new_error_hash = Hash.delete local_rr.rrid state._local_errors
|
||||||
H.modify_ _ { _local_errors = new_error_hash }
|
H.modify_ _ { _local_errors = new_error_hash }
|
||||||
handleAction $ UpdateRR rr
|
handleAction $ SaveRR rr
|
||||||
|
|
||||||
UpdateRR rr -> do
|
SaveRR rr -> do
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.raise $ Log $ SimpleLog $ "Updating RR " <> show rr.rrid
|
H.raise $ Log $ SimpleLog $ "Updating RR " <> show rr.rrid
|
||||||
message <- H.liftEffect
|
message <- H.liftEffect
|
||||||
|
@ -671,7 +686,7 @@ handleAction = case _ of
|
||||||
$ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id }
|
$ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id }
|
||||||
H.raise $ MessageToSend message
|
H.raise $ MessageToSend message
|
||||||
-- Modal doesn't need to be active anymore.
|
-- Modal doesn't need to be active anymore.
|
||||||
H.modify_ _ { deletion_modal = Nothing }
|
handleAction CancelModal
|
||||||
|
|
||||||
-- TODO: change the state to indicate problems?
|
-- TODO: change the state to indicate problems?
|
||||||
TellSomethingWentWrong rr_id val -> do
|
TellSomethingWentWrong rr_id val -> do
|
||||||
|
|
Loading…
Reference in New Issue