WIP: code clean-up. loopE to loop over Halogen evenful functions.

This commit is contained in:
Philippe Pittoli 2024-01-22 21:22:30 +01:00
parent 272237a5a1
commit 68a06928ca
2 changed files with 179 additions and 130 deletions

View File

@ -21,3 +21,24 @@ nav_bar domain
]
]
-- type_selection: create a "select" input.
-- Get the changes with "onSelectedIndexChange" which provides an index (from `baseRecords`)
type_selection :: HH.HTML w Action
type_selection = HH.div [HP.classes $ C.select <> C.is_normal]
[ HH.select
[ HE.onSelectedIndexChange (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Type) ]
$ map type_option baseRecords
]
type_option n
= HH.option
[ HP.value n
, HP.selected (n == rr.rrtype)
] [ HH.text n ]
-- Get the element from the index
H.modify_ _ { _newSRR = changeType state._newSRR (baseRecords A.!! val) }
changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l)
changeType rr Nothing = rr
changeType rr (Just s) = rr { rrtype = s }

View File

@ -17,11 +17,14 @@
module App.ZoneInterface where
import Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show, ($), (+), (/=), (<<<), (<>), (==))
import Prelude (Unit, unit, void
, bind, pure
, comparing, discard, map, max, otherwise, show
, ($), (+), (/=), (<<<), (<>), (==))
import Data.HashMap as Hash
import Data.Array as A
import Data.Tuple (Tuple(..))
import Data.Tuple (Tuple(..), snd)
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..))
@ -32,6 +35,7 @@ import Data.String.Regex as Regex
import Data.String.Regex.Flags as RegexFlags
import Data.String.Regex.Unsafe as RegexUnsafe
import Effect.Aff.Class (class MonadAff)
-- import Effect (foreachE)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
@ -93,33 +97,7 @@ type Input = String
-- | - remove a resource record
-- | - handle user inputs
data Add_RR
= Add_SRR
| Add_MXRR
| Add_SRVRR
-- NEW
| Add_A
| Add_AAAA
| Add_TXT
| Add_CNAME
| Add_NS
| Add_MX
| Add_SRV
data Update_SRR_Form
= Update_SRR_Type Int
| Update_SRR_Domain RecordName
| Update_SRR_TTL TTL
| Update_SRR_Target RecordTarget
data Update_MX_Form
= Update_MX_Domain RecordName
| Update_MX_TTL TTL
| Update_MX_Target RecordTarget
| Update_MX_Priority Priority
-- TODO: rename this.
data Update_MODAL_Form
= Update_MODAL_Domain RecordName
| Update_MODAL_TTL TTL
@ -129,6 +107,21 @@ data Update_MODAL_Form
| Update_MODAL_Weight Weight
| Update_MODAL_Port Port
-- TODO: remove this.
data Update_SRR_Form
= Update_SRR_Type Int
| Update_SRR_Domain RecordName
| Update_SRR_TTL TTL
| Update_SRR_Target RecordTarget
-- TODO: remove this.
data Update_MX_Form
= Update_MX_Domain RecordName
| Update_MX_TTL TTL
| Update_MX_Target RecordTarget
| Update_MX_Priority Priority
-- TODO: remove this.
data Update_SRV_Form
= Update_SRV_Domain RecordName
| Update_SRV_TTL TTL
@ -138,11 +131,11 @@ data Update_SRV_Form
| Update_SRV_Weight Weight
| Update_SRV_Port Port
-- TODO: remove this.
data Update_New_Form
= Update_New_Form_SRR Update_SRR_Form
| Update_New_Form_MXRR Update_MX_Form
| Update_New_Form_SRVRR Update_SRV_Form
| Update_New_MODAL_Form_RR Update_MODAL_Form
data Update_Local_Form
= Update_Local_Form_SRR Update_SRR_Form
@ -157,11 +150,14 @@ data Action
| Initialize
-- Add new entries.
| AddRR Add_RR
| AddRR AcceptedRRTypes
-- Update new entry forms.
| UpdateNewForm Update_New_Form
-- Update new entry form (in the `active_new_rr_modal` modal).
| UpdateNewRRForm Update_MODAL_Form
-- Update an already active entry.
| UpdateLocalForm RRId Update_Local_Form
@ -289,99 +285,101 @@ render state
]
modal_add_new_rr :: forall w. AcceptedRRTypes -> State -> HH.HTML w Action
modal_add_new_rr t { _newRR: rr } = case t of
A -> template "A" (content_simple "A") (foot_content Add_A)
AAAA -> template "AAAA" (content_simple "AAAA") (foot_content Add_AAAA)
TXT -> template "TXT" (content_simple "TXT") (foot_content Add_TXT)
CNAME -> template "CNAME" (content_simple "CNAME") (foot_content Add_CNAME)
NS -> template "NS" (content_simple "NS") (foot_content Add_NS)
MX -> template "MX" content_mx (foot_content Add_MX)
SRV -> template "SRV" content_srv (foot_content Add_SRV)
modal_add_new_rr t state = case t of
A -> template "A" (content_simple "A") (foot_content A)
AAAA -> template "AAAA" (content_simple "AAAA") (foot_content AAAA)
TXT -> template "TXT" (content_simple "TXT") (foot_content TXT)
CNAME -> template "CNAME" (content_simple "CNAME") (foot_content CNAME)
NS -> template "NS" (content_simple "NS") (foot_content NS)
MX -> template "MX" content_mx (foot_content MX)
SRV -> template "SRV" content_srv (foot_content SRV)
where
-- DRY
updateForm x = UpdateNewForm <<< Update_New_MODAL_Form_RR <<< x
updateForm x = UpdateNewRRForm <<< x
content_simple :: String -> Array (HH.HTML w Action)
content_simple t =
[ Bulma.box_input ("domain" <> t) "Name" "www" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action
rr.name -- value
rr.valid -- validity (TODO)
state._newRR.name -- value
state._newRR.valid -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input ("ttl" <> t) "TTL" "600"
(updateForm Update_MODAL_TTL)
rr.ttl
rr.valid
state._newRR.ttl
state._newRR.valid
should_be_disabled
, Bulma.box_input ("target" <> t) "Target" "198.51.100.5"
(updateForm Update_MODAL_Target)
rr.target
rr.valid
state._newRR.target
state._newRR.valid
should_be_disabled
]
content_mx :: Array (HH.HTML w Action)
content_mx =
[ Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action
rr.name -- value
rr.valid -- validity (TODO)
state._newRR.name -- value
state._newRR.valid -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input ("ttlMX") "TTL" "600"
(updateForm Update_MODAL_TTL)
rr.ttl
rr.valid
state._newRR.ttl
state._newRR.valid
should_be_disabled
, Bulma.box_input ("targetMX") "Target" "www"
(updateForm Update_MODAL_Target)
rr.target
rr.valid
state._newRR.target
state._newRR.valid
should_be_disabled
, Bulma.box_input ("priorityMX") "Priority" "10"
(updateForm Update_MODAL_Priority)
rr.priority
rr.valid
state._newRR.priority
state._newRR.valid
should_be_disabled
]
content_srv :: Array (HH.HTML w Action)
content_srv =
[ Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action
rr.name -- value
rr.valid -- validity (TODO)
state._newRR.name -- value
state._newRR.valid -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input ("ttlSRV") "TTL" "600"
(updateForm Update_MODAL_TTL)
rr.ttl
rr.valid
state._newRR.ttl
state._newRR.valid
should_be_disabled
, Bulma.box_input ("targetSRV") "Target" "www"
(updateForm Update_MODAL_Target)
rr.target
rr.valid
state._newRR.target
state._newRR.valid
should_be_disabled
, Bulma.box_input ("prioritySRV") "Priority" "10"
(updateForm Update_MODAL_Priority)
rr.priority
rr.valid
state._newRR.priority
state._newRR.valid
should_be_disabled
, Bulma.box_input ("portSRV") "Port" "5061"
(updateForm Update_MODAL_Port)
rr.port
rr.valid
state._newRR.port
state._newRR.valid
should_be_disabled
, Bulma.box_input ("weightSRV") "Weight" "100"
(updateForm Update_MODAL_Weight)
rr.weight
rr.valid
state._newRR.weight
state._newRR.valid
should_be_disabled
, Bulma.box_input ("protocolSRV") "Protocol" "tcp"
(updateForm Update_MODAL_Protocol)
rr.protocol
rr.valid
state._newRR.protocol
state._newRR.valid
should_be_disabled
]
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
foot_content x = [Bulma.btn_add (AddRR x) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid]
foot_content x = [ Bulma.btn_add (AddRR x)
(TellSomethingWentWrong state._newRR.rrid "cannot add")
state._newRR.valid ]
template t content foot = Bulma.modal
[ Bulma.modal_background
, Bulma.modal_card [Bulma.modal_header $ "New " <> t <> " resource record"
@ -391,13 +389,16 @@ render state
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
-- Works for both modals.
-- | Cancel the current modal being presented.
-- | Works for both "remove RR" and "new RR" modals.
CancelModal -> do
H.modify_ _ { active_modal = Nothing, active_new_rr_modal = Nothing }
-- | Create the RR modal.
DeleteRRModal rr_id -> do
H.modify_ _ { active_modal = Just rr_id }
-- | Each time a "new RR" button is clicked, the form resets.
NewRRModal t -> do
state <- H.get
H.modify_ _ { active_new_rr_modal = Just t }
@ -438,45 +439,46 @@ handleAction = case _ of
MX -> H.modify_ _ { _newRR = defaultMX }
SRV -> H.modify_ _ { _newRR = defaultSRV }
-- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
Initialize -> do
{ _domain } <- H.get
H.raise $ Log $ SimpleLog $ "Asking the server for the zone" <> _domain
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain }
H.raise $ MessageToSend message
UpdateNewForm form -> case form of
-- Update for the new RR form in the new RR modal.
Update_New_MODAL_Form_RR rr_update -> case rr_update of
Update_MODAL_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { name = val } }
Update_MODAL_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
Update_MODAL_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}}
Update_MODAL_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { priority = val } }
Update_MODAL_Protocol val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { protocol = val } }
Update_MODAL_Weight val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { weight = val } }
Update_MODAL_Port val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { port = val } }
-- Update for the new RR form in the new RR modal.
UpdateNewRRForm rr_update -> case rr_update of
Update_MODAL_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { name = val } }
Update_MODAL_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
Update_MODAL_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}}
Update_MODAL_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { priority = val } }
Update_MODAL_Protocol val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { protocol = val } }
Update_MODAL_Weight val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { weight = val } }
Update_MODAL_Port val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
state <- H.get
H.modify_ _ { _newRR = state._newRR { port = val } }
UpdateNewForm form -> case form of
Update_New_Form_SRR rr_update -> case rr_update of
Update_SRR_Type val -> do
-- let new_type = fromMaybe "unknown" (baseRecords A.!! val)
@ -547,33 +549,33 @@ handleAction = case _ of
-- This action only is possible if inputs are correct.
AddRR form -> case form of
Add_A -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a A RR blah blah blah"
Add_AAAA -> do
A -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a A RR!"
state <- H.get
try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple"
AAAA -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a AAAA RR blah blah blah"
Add_TXT -> do
state <- H.get
try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple"
TXT -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a TXT RR blah blah blah"
Add_CNAME -> do
state <- H.get
try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple"
CNAME -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a CNAME RR blah blah blah"
Add_NS -> do
state <- H.get
try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple"
NS -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a NS RR blah blah blah"
Add_MX -> do
state <- H.get
try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple"
MX -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a MX RR blah blah blah"
Add_SRV -> do
SRV -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a SRV RR blah blah blah"
---- TODO
--state <- H.get
--try_add_new_entry state._domain (Validation.validateA state._newRR) "simple"
Add_SRR -> do
state <- H.get
try_add_new_entry state._domain (Validation.validateSRR state._newSRR) "simple"
Add_MXRR -> do
state <- H.get
try_add_new_entry state._domain (Validation.validateMXRR state._newMXRR) "MX"
Add_SRVRR -> do
state <- H.get
try_add_new_entry state._domain (Validation.validateSRVRR state._newSRVRR) "SRV"
@ -682,8 +684,16 @@ handleAction = case _ of
H.raise $ Log $ SimpleLog (" => " <> val)
where
try_add_new_entry
:: String
-> Either Validation.Errors ResourceRecord
-> String
-> H.HalogenM State Action () Output m Unit
try_add_new_entry d v t = case v of
Left _ -> H.raise $ Log $ SimpleLog $ "Cannot add this " <> t <> " RR, some errors occured in the record"
Left actual_errors -> do
H.raise $ Log $ SimpleLog $ "Cannot add this " <> t <> " RR, some errors occured in the record:"
loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> v) $ map snd actual_errors
Right newrr -> do
H.raise $ Log $ SimpleLog $ "Add new " <> t
message <- H.liftEffect
@ -692,7 +702,12 @@ handleAction = case _ of
H.raise $ MessageToSend message
try_update_entry :: forall r
. String -> (AtLeastRRID r -> Either Validation.Errors ResourceRecord) -> Maybe (AtLeastRRID r) -> String -> _
. String
-> (AtLeastRRID r
-> Either Validation.Errors ResourceRecord)
-> Maybe (AtLeastRRID r)
-> String
-> H.HalogenM State Action () Output m Unit
try_update_entry d validation v t = case v of
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find " <> t <> " RR with this rrid"
Just local_rr -> do
@ -976,16 +991,17 @@ render_new_records state
, Bulma.btn_add_new_rr (NewRRModal MX) "MX"
, Bulma.btn_add_new_rr (NewRRModal SRV) "SRV"
] []
, Bulma.columns []
[ render_new_record_column_simple state._newSRR state._errors
, render_new_record_colunm_mx state._newMXRR state._errors
, render_new_record_colunm_srv state._newSRVRR state._errors
-- , render_current_target state._newSRR
-- , render_mx_current_target state._newMXRR
-- , render_srv_current_target state._newSRVRR
]
-- , Bulma.columns []
-- [ render_new_record_column_simple state._newSRR state._errors
-- , render_new_record_colunm_mx state._newMXRR state._errors
-- , render_new_record_colunm_srv state._newSRVRR state._errors
-- -- , render_current_target state._newSRR
-- -- , render_mx_current_target state._newMXRR
-- -- , render_srv_current_target state._newSRVRR
-- ]
]
{-
render_new_record_column_simple :: forall (w :: Type)
. (SimpleRR ()) -> Hash.HashMap RRId Validation.Errors -> HH.HTML w Action
render_new_record_column_simple rr _
@ -1055,6 +1071,7 @@ render_new_record_colunm_srv rr _
]
where
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
-}
-- ACTIONS
@ -1199,6 +1216,17 @@ fromResourceRecordToLocalRepresentationSOARR new_rr = do
first :: forall a. (a -> Boolean) -> Array a -> Maybe a
first condition = A.head <<< (A.filter condition)
loopE :: forall state action input output m a b
. (a -> H.HalogenM state action input output m b)
-> Array a
-> H.HalogenM state action input output m Unit
loopE f a = case (A.head a) of
Nothing -> pure unit
Just x -> do void $ f x
case (A.tail a) of
Nothing -> pure unit
Just xs -> loopE f xs
getNewID :: State -> Int
getNewID state = (_ + 1)
$ Foldable.foldl max 0 [ maxIDrr