From c0ed930bea314bf447d118e563e417597408e662 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 12 Jul 2023 20:38:50 +0200 Subject: [PATCH] Rewrite RecordBase type (in RR.purs) to match ResourceRecord. --- src/App/RR.purs | 35 ++-- src/App/ZoneInterface.purs | 340 +++++++++++++++++-------------------- src/Bulma.purs | 26 +-- 3 files changed, 191 insertions(+), 210 deletions(-) diff --git a/src/App/RR.purs b/src/App/RR.purs index 9210e9b..541ae2c 100644 --- a/src/App/RR.purs +++ b/src/App/RR.purs @@ -6,8 +6,8 @@ type InputParameter } type RecordType = String -type RecordValue = String -type RecordDomain = String +type RecordTarget = String +type RecordName = String -- These should be integers, but I use these values in user inputs. type TTL = String @@ -22,24 +22,25 @@ type Modified = Boolean type Valid = Boolean type RecordBase l - = { t :: RecordType - , id :: RRId + = { rrtype :: RecordType + , rrid :: RRId , modified :: Boolean , valid :: Boolean , ttl :: TTL - , domain :: RecordDomain - , value :: RecordValue | l + , name :: RecordName + , target :: RecordTarget + , readonly :: Boolean + | l } -- CNAME A AAAA NS TXT type SimpleRR l = RecordBase (|l) type MXRR l = RecordBase ( priority :: Priority | l) -type SRVRR l = RecordBase ( priority :: Priority - , protocol :: Protocol - , weight :: Weight - , port :: Port - | l) +type SRVRR l = MXRR ( protocol :: Protocol + , weight :: Weight + , port :: Port + | l) type SOARR l = RecordBase ( mname :: String @@ -53,18 +54,18 @@ type SOARR l defaultResourceA :: SimpleRR () defaultResourceA - = { id: 0, t: "A", modified: false, valid: true - , ttl: "200", domain: "www", value: "192.168.10.2" } + = { rrid: 0, rrtype: "A", modified: false, valid: true, readonly: false + , ttl: "200", name : "www", target: "192.168.10.2" } defaultResourceMX :: MXRR () defaultResourceMX - = { id: 0, t: "MX", modified: false, valid: true - , ttl: "500", priority: "10", domain: "mail", value: "www" } + = { rrid: 0, rrtype: "MX", modified: false, valid: true, readonly: false + , ttl: "500", priority: "10", name : "mail", target: "www" } defaultResourceSRV :: SRVRR () -- RRId Modified Valid Priority Protocol Weight Port TTL Domain Value defaultResourceSRV - = { id: 0, t: "SRV", modified: false, valid: true + = { rrid: 0, rrtype: "SRV", modified: false, valid: true, readonly: false , priority: "10", protocol: "_tcp", weight: "100" , port: "80", ttl: "200" - , domain: "_sip._tcp.example.com.", value: "sip.example.com." } + , name : "_sip._tcp.example.com.", target: "sip.example.com." } diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index d1b334f..cea677b 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -37,7 +37,7 @@ import Halogen.HTML.Properties as HP import Bulma as Bulma import CSSClasses as C -import App.RR (MXRR, Port, Priority, Protocol, RRId, RecordDomain, RecordValue, SOARR, SRVRR, SimpleRR, TTL, Weight +import App.RR (MXRR, Port, Priority, Protocol, RRId, RecordName, RecordTarget, SOARR, SRVRR, SimpleRR, TTL, Weight , defaultResourceA, defaultResourceMX, defaultResourceSRV) import App.ResourceRecord (ResourceRecord) @@ -84,20 +84,20 @@ data Add_RR data Update_SRR_Form = Update_SRR_Type Int - | Update_SRR_Domain RecordDomain + | Update_SRR_Domain RecordName | Update_SRR_TTL TTL - | Update_SRR_Value RecordValue + | Update_SRR_Target RecordTarget data Update_MX_Form - = Update_MX_Domain RecordDomain + = Update_MX_Domain RecordName | Update_MX_TTL TTL - | Update_MX_Value RecordValue + | Update_MX_Target RecordTarget | Update_MX_Priority Priority data Update_SRV_Form - = Update_SRV_Domain RecordDomain + = Update_SRV_Domain RecordName | Update_SRV_TTL TTL - | Update_SRV_Value RecordValue + | Update_SRV_Target RecordTarget | Update_SRV_Priority Priority | Update_SRV_Protocol Protocol | Update_SRV_Weight Weight @@ -139,7 +139,7 @@ data Action -- | type State = - { _current_domain :: RecordDomain + { _current_domain :: RecordName , _soa :: Maybe (SOARR ()) , _srr :: Array (SimpleRR ()) , _mxrr :: Array (MXRR ()) @@ -184,6 +184,8 @@ initialState domain = , _current_entry_srv: defaultResourceSRV } +type SortableRecord l = Record (rrtype :: String, rrid :: Int | l) + render :: forall m. State -> H.ComponentHTML Action () m render state = Bulma.section_small @@ -193,17 +195,18 @@ render state true, Nothing -> HH.div_ [ Bulma.h1 state._current_domain , Bulma.hr , render_soa state._soa - , render_records sorted - , render_mx_records state._mxrr - , render_srv_records state._srvrr + , render_records $ sorted state._srr + , render_mx_records $ sorted state._mxrr + , render_srv_records $ sorted state._srvrr , render_new_records state ] ] where - sorted = Foldable.foldl (<>) [] - $ map (A.sortBy (comparing (_.id))) + sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l)) + sorted array = Foldable.foldl (<>) [] + $ map (A.sortBy (comparing (_.rrid))) $ map NonEmpty.toArray - $ A.groupAllBy (comparing (_.t)) state._srr + $ A.groupAllBy (comparing (_.rrtype)) array modal_rr_delete :: forall w. Int -> HH.HTML w Action modal_rr_delete rr_id = @@ -257,31 +260,31 @@ handleAction = case _ of state <- H.get H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords A.!! val) } Update_SRR_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val) - H.modify_ _ { _current_entry { domain = val } } + -- H.raise $ Log $ SimpleLog ("Update new entry name: " <> val) + H.modify_ _ { _current_entry { name = val } } Update_SRR_TTL val -> do -- H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val) H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } } - Update_SRR_Value val -> do - -- H.raise $ Log $ SimpleLog ("Update new entry value: " <> val) - H.modify_ _ { _current_entry { value = val } } + Update_SRR_Target val -> do + -- H.raise $ Log $ SimpleLog ("Update new entry target: " <> val) + H.modify_ _ { _current_entry { target = val } } Update_New_Form_MXRR rr_update -> case rr_update of -- TODO: FIXME: test all inputs Update_MX_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val) + -- H.raise $ Log $ SimpleLog ("Update new MX entry name: " <> val) state <- H.get - H.modify_ _ { _current_entry_mx = state._current_entry_mx { domain = val } } + H.modify_ _ { _current_entry_mx = state._current_entry_mx { name = val } } -- TODO: FIXME: test all inputs Update_MX_TTL val -> do -- H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val) state <- H.get H.modify_ _ { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} } -- TODO: FIXME: test all inputs - Update_MX_Value val -> do - -- H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val) + Update_MX_Target val -> do + -- H.raise $ Log $ SimpleLog ("Update new MX entry target: " <> val) state <- H.get - H.modify_ _ { _current_entry_mx = state._current_entry_mx { value = val } } + H.modify_ _ { _current_entry_mx = state._current_entry_mx { target = val } } Update_MX_Priority val -> do -- H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val) state <- H.get @@ -289,13 +292,13 @@ handleAction = case _ of Update_New_Form_SRVRR rr_update -> case rr_update of Update_SRV_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val) + -- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val) state <- H.get - H.modify_ _ { _current_entry_srv = state._current_entry_srv { domain = val } } - Update_SRV_Value val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val) + H.modify_ _ { _current_entry_srv = state._current_entry_srv { name = val } } + Update_SRV_Target val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val) state <- H.get - H.modify_ _ { _current_entry_srv = state._current_entry_srv { value = val } } + H.modify_ _ { _current_entry_srv = state._current_entry_srv { target = val } } -- TODO: FIXME: test all inputs Update_SRV_TTL val -> do -- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val) @@ -323,7 +326,7 @@ handleAction = case _ of Add_SRR -> do state <- H.get let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry - H.raise $ Log $ SimpleLog ("Add new simple RR: " <> show state._current_entry) + -- H.raise $ Log $ SimpleLog $ "Add new simple RR: " <> show state._current_entry.rrtype message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } @@ -332,7 +335,7 @@ handleAction = case _ of Add_MXRR -> do state <- H.get let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx - H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx) + -- H.raise $ Log $ SimpleLog "Add new MX" message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } @@ -340,14 +343,12 @@ handleAction = case _ of Add_SRVRR -> do state <- H.get - case fromLocalToRR state._current_entry_srv of - Left errmsg -> H.raise $ Log $ SimpleLog $ "Add new SRV failed: " <> errmsg - Right newrr -> do - H.raise $ Log $ SimpleLog $ "Add new SRV: " <> show state._current_entry_srv - message <- H.liftEffect - $ DNSManager.serialize - $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } - H.raise $ MessageToSend message + let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv + -- H.raise $ Log $ SimpleLog "Add new SRV" + message <- H.liftEffect + $ DNSManager.serialize + $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } + H.raise $ MessageToSend message UpdateLocalForm rr_id form -> case form of Update_Local_Form_SRR rr_update -> case rr_update of @@ -357,22 +358,22 @@ handleAction = case _ of -- state <- H.get -- H.modify_ _ { _srr = changeType state._current_entry (baseRecords A.!! val) } Update_SRR_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " domain: " <> val) + -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " name: " <> val) state <- H.get H.modify_ _ { _srr = (update_domain rr_id val state._srr) } Update_SRR_TTL val -> do -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " TTL: " <> val) state <- H.get H.modify_ _ { _srr = (update_ttl rr_id val state._srr) } - Update_SRR_Value val -> do - -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " value: " <> val) + Update_SRR_Target val -> do + -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " target: " <> val) state <- H.get - H.modify_ _ { _srr = (update_value rr_id val state._srr) } + H.modify_ _ { _srr = (update_target rr_id val state._srr) } Update_Local_Form_MXRR rr_update -> case rr_update of -- TODO: FIXME: test all inputs Update_MX_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " domain: " <> val) + -- H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " name: " <> val) state <- H.get H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) } -- TODO: FIXME: test all inputs @@ -381,10 +382,10 @@ handleAction = case _ of state <- H.get H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) } -- TODO: FIXME: test all inputs - Update_MX_Value val -> do - -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry value: " <> val) + Update_MX_Target val -> do + -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry target: " <> val) state <- H.get - H.modify_ _ { _mxrr = (update_value rr_id val state._mxrr) } + H.modify_ _ { _mxrr = (update_target rr_id val state._mxrr) } Update_MX_Priority val -> do -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val) state <- H.get @@ -392,13 +393,13 @@ handleAction = case _ of Update_Local_Form_SRVRR rr_update -> case rr_update of Update_SRV_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry domain: " <> val) + -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry name: " <> val) state <- H.get H.modify_ _ { _srvrr = (update_domain rr_id val state._srvrr) } - Update_SRV_Value val -> do - -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry value: " <> val) + Update_SRV_Target val -> do + -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry target: " <> val) state <- H.get - H.modify_ _ { _srvrr = (update_value rr_id val state._srvrr) } + H.modify_ _ { _srvrr = (update_target rr_id val state._srvrr) } -- TODO: FIXME: test all inputs Update_SRV_TTL val -> do -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry ttl: " <> val) @@ -423,9 +424,9 @@ handleAction = case _ of SyncSRR local_rr_id -> do state <- H.get - let maybe_local_rr = first (\rr -> rr.id == local_rr_id) state._srr + let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srr case maybe_local_rr of - Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find simple RR id: " <> show local_rr_id + Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find simple RR rrid: " <> show local_rr_id Just local_rr -> do let rr = fromLocalSimpleRRRepresentationToResourceRecord local_rr H.raise $ Log $ SimpleLog $ "Sync a simple RR: " <> show local_rr_id @@ -436,9 +437,9 @@ handleAction = case _ of SyncMXRR local_rr_id -> do state <- H.get - let maybe_local_rr = first (\rr -> rr.id == local_rr_id) state._mxrr + let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._mxrr case maybe_local_rr of - Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find MX RR id: " <> show local_rr_id + Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find MX RR rrid: " <> show local_rr_id Just local_rr -> do let rr = fromLocalMXRRRepresentationToResourceRecord local_rr H.raise $ Log $ SimpleLog $ "Sync a MX RR: " <> show local_rr_id @@ -449,9 +450,9 @@ handleAction = case _ of SyncSRVRR local_rr_id -> do state <- H.get - let maybe_local_rr = first (\rr -> rr.id == local_rr_id) state._srvrr + let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srvrr case maybe_local_rr of - Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find SRV RR id: " <> show local_rr_id + Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find SRV RR rrid: " <> show local_rr_id Just local_rr -> do let rr = fromLocalSRVRRepresentationToResourceRecord local_rr H.raise $ Log $ SimpleLog $ "Sync a SRV RR: " <> show local_rr_id @@ -462,7 +463,7 @@ handleAction = case _ of RemoveRR rr_id -> do { _current_domain } <- H.get - H.raise $ Log $ SimpleLog $ "Ask to remove rr (id: " <> show rr_id <> ")" + H.raise $ Log $ SimpleLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")" message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id } @@ -522,7 +523,7 @@ handleQuery = case _ of (DNSManager.MkRRReadOnly response) -> do H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! " <> "domain: " <> response.domain - <> "resource id: " <> show response.rr.rrid + <> "resource rrid: " <> show response.rr.rrid (DNSManager.MkRRUpdated response) -> do H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!" @@ -531,13 +532,7 @@ handleQuery = case _ of (DNSManager.MkRRAdded response) -> do state <- H.get let new_rr = response.rr - -- H.raise $ Log $ SimpleLog $ "Resource Record added: " <> response.domain - -- <> " rrid: " <> show new_rr.rrid - -- <> " rrtype: " <> new_rr.rrtype - -- <> " name: " <> new_rr.name - -- <> " ttl: " <> show new_rr.ttl - -- <> " target: " <> new_rr.target - -- <> " readonly: " <> show new_rr.readonly + H.raise $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> new_rr.rrtype case add_entry state new_rr of Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message Right new_state -> H.put new_state @@ -548,11 +543,11 @@ handleQuery = case _ of (DNSManager.MkDomainDeleted response) -> do H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!" (DNSManager.MkRRDeleted response) -> do - H.raise $ Log $ SimpleLog $ "[🎉] RR (id: '" <> show response.rrid <> "') has been deleted!" + H.raise $ Log $ SimpleLog $ "[🎉] RR (rrid: '" <> show response.rrid <> "') has been deleted!" state <- H.get - H.modify_ _ { _srr = A.filter (\rr -> rr.id /= response.rrid) state._srr - , _mxrr = A.filter (\rr -> rr.id /= response.rrid) state._mxrr - , _srvrr = A.filter (\rr -> rr.id /= response.rrid) state._srvrr + H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr + , _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr + , _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr } (DNSManager.MkZone response) -> do @@ -581,9 +576,9 @@ handleQuery = case _ of -- replace_entry :: RRId replace_entry new_rr = do state <- H.get - H.modify_ _ { _srr = A.filter (\rr -> rr.id /= new_rr.rrid) state._srr - , _mxrr = A.filter (\rr -> rr.id /= new_rr.rrid) state._mxrr - , _srvrr = A.filter (\rr -> rr.id /= new_rr.rrid) state._srvrr + H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srr + , _mxrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._mxrr + , _srvrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srvrr } new_state <- H.get @@ -623,18 +618,18 @@ render_soa (Just soa) = Bulma.columns [] [ left_block, right_block ] where left_block = Bulma.column class_title_size [ Bulma.zone_rr_title "Start Of Authority (SOA)" ] right_block = Bulma.column_ [ Bulma.p "ALL AVAILABLE DATA" - , Bulma.p $ "rrtype: " <> soa.t - , Bulma.p $ "rrid: " <> show soa.id - , Bulma.p $ "name: " <> soa.domain - , Bulma.p $ "ttl: " <> soa.ttl - , Bulma.p $ "target: " <> soa.value - , Bulma.p $ "mname: " <> soa.mname - , Bulma.p $ "rname: " <> soa.rname - , Bulma.p $ "serial: " <> soa.serial - , Bulma.p $ "refresh: " <> soa.refresh - , Bulma.p $ "retry: " <> soa.retry - , Bulma.p $ "expire: " <> soa.expire - , Bulma.p $ "minttl: " <> soa.minttl + , Bulma.p $ "rrtype: " <> soa.rrtype + , Bulma.p $ "rrid: " <> show soa.rrid + , Bulma.p $ "name: " <> soa.name + , Bulma.p $ "ttl: " <> soa.ttl + , Bulma.p $ "target: " <> soa.target + , Bulma.p $ "mname: " <> soa.mname + , Bulma.p $ "rname: " <> soa.rname + , Bulma.p $ "serial: " <> soa.serial + , Bulma.p $ "refresh: " <> soa.refresh + , Bulma.p $ "retry: " <> soa.retry + , Bulma.p $ "expire: " <> soa.expire + , Bulma.p $ "minttl: " <> soa.minttl ] render_records :: forall (w :: Type). Array (SimpleRR ()) -> HH.HTML w Action @@ -659,15 +654,14 @@ render_records records table_content = HH.tbody_ $ map row records row rr = HH.tr_ $ - [ Bulma.txt_name rr.t - , HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_Domain) rr.domain rr.valid ] - , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_TTL ) rr.ttl rr.valid ] - , HH.td_ [ Bulma.input_value ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_Value) rr.value rr.valid ] - , HH.td_ [ Bulma.btn_change (SyncSRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] - , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ] + [ Bulma.txt_name rr.rrtype + , HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRR <<< Update_SRR_Domain) rr.name rr.valid ] + , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRR <<< Update_SRR_TTL ) rr.ttl rr.valid ] + , HH.td_ [ Bulma.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRR <<< Update_SRR_Target) rr.target rr.valid ] + , HH.td_ [ Bulma.btn_change (SyncSRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ] + , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ] ] - render_mx_records :: forall (w :: Type) (l :: Row Type) . Array (MXRR l) -> HH.HTML w Action render_mx_records [] @@ -684,15 +678,14 @@ render_mx_records records table_content = HH.tbody_ $ map row records row rr = HH.tr_ $ - [ HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_Domain) rr.domain rr.valid ] - , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid ] - , HH.td_ [ Bulma.input_priority ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid ] - , HH.td_ [ Bulma.input_value ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_Value) rr.value rr.valid ] - , HH.td_ [ Bulma.btn_change (SyncMXRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] - , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ] + [ HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_Domain) rr.name rr.valid ] + , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid ] + , HH.td_ [ Bulma.input_priority ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid ] + , HH.td_ [ Bulma.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_Target) rr.target rr.valid ] + , HH.td_ [ Bulma.btn_change (SyncMXRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ] + , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ] ] - render_srv_records :: forall (w :: Type) (l :: Row Type) . Array (SRVRR l) -> HH.HTML w Action render_srv_records [] @@ -708,18 +701,17 @@ render_srv_records records table_content = HH.tbody_ $ map row records row rr = HH.tr_ $ - [ HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Domain ) rr.domain rr.valid ] - , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_TTL ) rr.ttl rr.valid ] - , HH.td_ [ Bulma.input_priority ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Priority) rr.priority rr.valid ] - , HH.td_ [ Bulma.input_protocol ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Protocol) rr.protocol rr.valid ] - , HH.td_ [ Bulma.input_weight ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Weight ) rr.weight rr.valid ] - , HH.td_ [ Bulma.input_port ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Port ) rr.port rr.valid ] - , HH.td_ [ Bulma.input_value ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Value ) rr.value rr.valid ] - , HH.td_ [ Bulma.btn_change (SyncSRVRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] - , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ] + [ HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Domain ) rr.name rr.valid ] + , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_TTL ) rr.ttl rr.valid ] + , HH.td_ [ Bulma.input_priority ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Priority) rr.priority rr.valid ] + , HH.td_ [ Bulma.input_protocol ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Protocol) rr.protocol rr.valid ] + , HH.td_ [ Bulma.input_weight ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Weight ) rr.weight rr.valid ] + , HH.td_ [ Bulma.input_port ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Port ) rr.port rr.valid ] + , HH.td_ [ Bulma.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Target ) rr.target rr.valid ] + , HH.td_ [ Bulma.btn_change (SyncSRVRR rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") rr.modified rr.valid ] + , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ] ] - baseRecords :: Array String baseRecords = [ "NS", "A", "AAAA", "CNAME", "TXT" ] @@ -734,9 +726,9 @@ render_new_records state [ render_new_record_column_simple state._current_entry , render_new_record_colunm_mx state._current_entry_mx , render_new_record_colunm_srv state._current_entry_srv - -- , render_current_value state._current_entry - -- , render_mx_current_value state._current_entry_mx - -- , render_srv_current_value state._current_entry_srv + -- , render_current_target state._current_entry + -- , render_mx_current_target state._current_entry_mx + -- , render_srv_current_target state._current_entry_srv ] ] @@ -746,10 +738,10 @@ render_new_record_column_simple rr = Bulma.column_ $ [ Bulma.box [ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT" , type_selection - , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Domain) rr.domain rr.valid + , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Domain) rr.name rr.valid , Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_TTL) rr.ttl rr.valid - , Bulma.box_input_value (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Value) rr.value rr.valid - , Bulma.btn_add (AddRR Add_SRR) (TellSomethingWentWrong rr.id "cannot add") rr.valid + , Bulma.box_input_target (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Target) rr.target rr.valid + , Bulma.btn_add (AddRR Add_SRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid ] ] where @@ -760,19 +752,18 @@ render_new_record_column_simple rr type_option n = HH.option [ HP.value n - , HP.selected (n == rr.t) + , HP.selected (n == rr.rrtype) ] [ HH.text n ] - render_new_record_colunm_mx :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action render_new_record_colunm_mx rr = Bulma.column_ $ [ Bulma.box [ Bulma.zone_rr_title "MX" - , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Domain) rr.domain rr.valid + , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Domain) rr.name rr.valid , Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid , Bulma.box_input_priority (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid - , Bulma.box_input_value (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Value) rr.value rr.valid - , Bulma.btn_add (AddRR Add_MXRR) (TellSomethingWentWrong rr.id "cannot add") rr.valid + , Bulma.box_input_target (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Target) rr.target rr.valid + , Bulma.btn_add (AddRR Add_MXRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid ] ] @@ -780,14 +771,14 @@ render_new_record_colunm_srv :: forall (w :: Type). (SRVRR ()) -> HH.HTML w Acti render_new_record_colunm_srv rr = Bulma.column_ $ [ Bulma.box [ Bulma.zone_rr_title "SRV" - , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Domain) rr.domain rr.valid + , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Domain) rr.name rr.valid , Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_TTL) rr.ttl rr.valid , Bulma.box_input_priority (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Priority) rr.priority rr.valid , Bulma.box_input_protocol (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Protocol) rr.protocol rr.valid , Bulma.box_input_weight (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Weight) rr.weight rr.valid , Bulma.box_input_port (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Port) rr.port rr.valid - , Bulma.box_input_value (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Value) rr.value rr.valid - , Bulma.btn_add (AddRR Add_SRVRR) (TellSomethingWentWrong rr.id "cannot add") rr.valid + , Bulma.box_input_target (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Target) rr.target rr.valid + , Bulma.btn_add (AddRR Add_SRVRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid ] ] @@ -818,22 +809,16 @@ new_soa state = case _ of changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l) changeType rr Nothing = rr -changeType rr (Just s) = rr { t = s } +changeType rr (Just s) = rr { rrtype = s } -update_domain :: forall (l :: Row Type). - Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) -update_domain rr_id val - = update (\rr -> rr { modified = true, domain = val }) rr_id +update_domain :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) +update_domain rr_id val = update (\rr -> rr { modified = true, name = val }) rr_id -update_value :: forall (l :: Row Type). - Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) -update_value rr_id val - = update (\rr -> rr { modified = true, value = val }) rr_id +update_target :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) +update_target rr_id val = update (\rr -> rr { modified = true, target = val }) rr_id -update_ttl :: forall (l :: Row Type). - Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) -update_ttl rr_id val - = update (\rr -> rr { modified = true, ttl = val, valid = isInteger val }) rr_id +update_ttl :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) +update_ttl rr_id val = update (\rr -> rr { modified = true, ttl = val, valid = isInteger val }) rr_id update_priority :: forall (l :: Row Type). Int -> Priority -> Array (MXRR l) -> Array (MXRR l) update_priority rr_id val = update (\rr -> rr { modified = true, priority = val}) rr_id @@ -858,39 +843,32 @@ update :: forall (l :: Row Type). update f rr_id records = map doSmth records where doSmth rr - | rr_id == rr.id = f rr + | rr_id == rr.rrid = f rr | otherwise = rr -fromLocalToRR :: forall (l :: Row Type). SRVRR (|l) -> Either String ResourceRecord -fromLocalToRR new_rr = do - case new_rr.t, (A.elem new_rr.t baseRecords) of - _, true -> Right $ fromLocalSimpleRRRepresentationToResourceRecord new_rr - "MX", _ -> Right $ fromLocalMXRRRepresentationToResourceRecord new_rr - "SRV", _ -> Right $ fromLocalSRVRRepresentationToResourceRecord new_rr - -- "SOA" resource record shouldn't be useful in this context. - _, _ -> Left $ "TODO: cannot convert RR type '" <> new_rr.t <> "' to ResourceRecord representation." - fromResourceRecordToLocalRepresentationSimpleRR :: ResourceRecord -> Maybe (SimpleRR ()) fromResourceRecordToLocalRepresentationSimpleRR new_rr = - Just { t: new_rr.rrtype - , id: new_rr.rrid + Just { rrtype: new_rr.rrtype + , rrid: new_rr.rrid , modified: false , valid: true + , readonly: new_rr.readonly , ttl: show new_rr.ttl - , domain: new_rr.name - , value: new_rr.target + , name: new_rr.name + , target: new_rr.target } fromResourceRecordToLocalRepresentationMXRR :: ResourceRecord -> Maybe (MXRR ()) fromResourceRecordToLocalRepresentationMXRR new_rr = do priority <- new_rr.priority - Just { t: new_rr.rrtype - , id: new_rr.rrid + Just { rrtype: new_rr.rrtype + , rrid: new_rr.rrid , modified: false , valid: true + , readonly: new_rr.readonly , ttl: show new_rr.ttl - , domain: new_rr.name - , value: new_rr.target + , name: new_rr.name + , target: new_rr.target , priority: show priority } -- TODO: would be nice to have a simpler implementation, something like this: @@ -904,13 +882,14 @@ fromResourceRecordToLocalRepresentationSRVRR new_rr = do weight <- new_rr.weight priority <- new_rr.priority protocol <- new_rr.protocol - Just { t: new_rr.rrtype - , id: new_rr.rrid + Just { rrtype: new_rr.rrtype + , rrid: new_rr.rrid , modified: false , valid: true + , readonly: new_rr.readonly , ttl: show new_rr.ttl - , domain: new_rr.name - , value: new_rr.target + , name: new_rr.name + , target: new_rr.target , priority: show priority , port: show port , weight: show weight @@ -926,13 +905,14 @@ fromResourceRecordToLocalRepresentationSOARR new_rr = do retry <- new_rr.retry -- :: Maybe Int expire <- new_rr.expire -- :: Maybe Int minttl <- new_rr.minttl -- :: Maybe Int - Just { t: new_rr.rrtype - , id: new_rr.rrid + Just { rrtype: new_rr.rrtype + , rrid: new_rr.rrid , modified: false , valid: true + , readonly: new_rr.readonly , ttl: show new_rr.ttl - , domain: new_rr.name - , value: new_rr.target + , name: new_rr.name + , target: new_rr.target , mname: mname -- :: RR (Maybe String) Local (String) , rname: rname -- :: RR (Maybe String) Local (String) , serial: show serial -- :: RR (Maybe Int) Local (String) @@ -944,12 +924,12 @@ fromResourceRecordToLocalRepresentationSOARR new_rr = do fromLocalSimpleRRRepresentationToResourceRecord :: forall l. SimpleRR (|l) -> ResourceRecord fromLocalSimpleRRRepresentationToResourceRecord form - = { rrtype: form.t - , rrid: form.id - , name: form.domain + = { rrtype: form.rrtype + , rrid: form.rrid + , name: form.name , ttl: fromMaybe 3600 $ fromString form.ttl - , target: form.value - , readonly: false + , target: form.target + , readonly: form.readonly , priority: Nothing , port: Nothing , protocol: Nothing @@ -965,12 +945,12 @@ fromLocalSimpleRRRepresentationToResourceRecord form fromLocalMXRRRepresentationToResourceRecord :: forall l. MXRR (|l) -> ResourceRecord fromLocalMXRRRepresentationToResourceRecord form - = { rrtype: form.t - , rrid: form.id - , name: form.domain + = { rrtype: form.rrtype + , rrid: form.rrid + , name: form.name , ttl: fromMaybe 3600 $ fromString form.ttl - , target: form.value - , readonly: false + , target: form.target + , readonly: form.readonly , priority: Just $ fromMaybe 10 $ fromString form.priority , port: Nothing , protocol: Nothing @@ -986,12 +966,12 @@ fromLocalMXRRRepresentationToResourceRecord form fromLocalSRVRRepresentationToResourceRecord :: forall l. SRVRR (|l) -> ResourceRecord fromLocalSRVRRepresentationToResourceRecord form - = { rrtype: form.t - , rrid: form.id - , name: form.domain + = { rrtype: form.rrtype + , rrid: form.rrid + , name: form.name , ttl: fromMaybe 3600 $ fromString form.ttl - , target: form.value - , readonly: false + , target: form.target + , readonly: form.readonly , priority: Just $ fromMaybe 10 $ fromString form.priority , port: Just $ fromMaybe 10 $ fromString form.port , protocol: Just form.protocol @@ -1016,6 +996,6 @@ getNewID state = (_ + 1) ] where - maxIDrr = Foldable.foldl max 0 $ map _.id state._srr - maxIDmxrr = Foldable.foldl max 0 $ map _.id state._mxrr - maxIDsrvrr = Foldable.foldl max 0 $ map _.id state._srvrr + maxIDrr = Foldable.foldl max 0 $ map _.rrid state._srr + maxIDmxrr = Foldable.foldl max 0 $ map _.rrid state._mxrr + maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr diff --git a/src/Bulma.purs b/src/Bulma.purs index 613fa4e..561f091 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -63,30 +63,30 @@ btn_classes false = C.button <> C.is_small <> C.is_danger simple_table_header :: forall w i. HH.HTML w i simple_table_header = HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ] - , HH.th_ [ HH.text "Domain" ] + , HH.th_ [ HH.text "Name" ] , HH.th_ [ HH.text "TTL" ] - , HH.th_ [ HH.text "Value" ] + , HH.th_ [ HH.text "Target" ] ] ] mx_table_header :: forall w i. HH.HTML w i mx_table_header - = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain" ] + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ] , HH.th_ [ HH.text "TTL" ] , HH.th_ [ HH.text "Priority" ] - , HH.th_ [ HH.text "Value" ] + , HH.th_ [ HH.text "Target" ] ] ] srv_table_header :: forall w i. HH.HTML w i srv_table_header - = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain" ] + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ] , HH.th_ [ HH.text "TTL" ] , HH.th_ [ HH.text "Priority" ] , HH.th_ [ HH.text "Protocol" ] , HH.th_ [ HH.text "Weight" ] , HH.th_ [ HH.text "Port" ] - , HH.th_ [ HH.text "Value" ] + , HH.th_ [ HH.text "Target" ] ] ] @@ -200,19 +200,19 @@ box_input_protocol action value validity = HH.label [ ] , HH.div [HP.classes C.control ] [ input_protocol action value validity ] ] -input_value :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_value action value validity +input_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i +input_target action value validity = HH.input [ HE.onValueInput action , HP.value value - , HP.placeholder "value" + , HP.placeholder "target" , HP.classes $ input_classes validity ] -box_input_value :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_value action value validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Value" ] - , HH.div [HP.classes C.control ] [ input_value action value validity ] +box_input_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i +box_input_target action value validity = HH.label [ ] + [ HH.label [HP.classes C.label ] [ HH.text "Target" ] + , HH.div [HP.classes C.control ] [ input_target action value validity ] ]