karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Rewrite RecordBase type (in RR.purs) to match ResourceRecord.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-12 20:38:50 +02:00
parent 7c5574e3d4
commit c0ed930bea
3 changed files with 191 additions and 210 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
src/App/RR.purs
View File

@ -6,8 +6,8 @@ type InputParameter
} }
type RecordType = String type RecordType = String
type RecordValue = String type RecordTarget = String
type RecordDomain = String type RecordName = String
-- These should be integers, but I use these values in user inputs. -- These should be integers, but I use these values in user inputs.
type TTL = String type TTL = String
@ -22,24 +22,25 @@ type Modified = Boolean
type Valid = Boolean type Valid = Boolean
type RecordBase l type RecordBase l
= { t :: RecordType = { rrtype :: RecordType
, id :: RRId , rrid :: RRId
, modified :: Boolean , modified :: Boolean
, valid :: Boolean , valid :: Boolean
, ttl :: TTL , ttl :: TTL
, domain :: RecordDomain , name :: RecordName
, value :: RecordValue | l , target :: RecordTarget
, readonly :: Boolean
| l
} }
-- CNAME A AAAA NS TXT -- CNAME A AAAA NS TXT
type SimpleRR l = RecordBase (|l) type SimpleRR l = RecordBase (|l)
type MXRR l = RecordBase ( priority :: Priority | l) type MXRR l = RecordBase ( priority :: Priority | l)
type SRVRR l = RecordBase ( priority :: Priority type SRVRR l = MXRR ( protocol :: Protocol
, protocol :: Protocol , weight :: Weight
, weight :: Weight , port :: Port
, port :: Port | l)
| l)
type SOARR l type SOARR l
= RecordBase ( mname :: String = RecordBase ( mname :: String
@ -53,18 +54,18 @@ type SOARR l
defaultResourceA :: SimpleRR () defaultResourceA :: SimpleRR ()
defaultResourceA defaultResourceA
= { id: 0, t: "A", modified: false, valid: true = { rrid: 0, rrtype: "A", modified: false, valid: true, readonly: false
, ttl: "200", domain: "www", value: "192.168.10.2" } , ttl: "200", name : "www", target: "192.168.10.2" }
defaultResourceMX :: MXRR () defaultResourceMX :: MXRR ()
defaultResourceMX defaultResourceMX
= { id: 0, t: "MX", modified: false, valid: true = { rrid: 0, rrtype: "MX", modified: false, valid: true, readonly: false
, ttl: "500", priority: "10", domain: "mail", value: "www" } , ttl: "500", priority: "10", name : "mail", target: "www" }
defaultResourceSRV :: SRVRR () defaultResourceSRV :: SRVRR ()
-- RRId Modified Valid Priority Protocol Weight Port TTL Domain Value -- RRId Modified Valid Priority Protocol Weight Port TTL Domain Value
defaultResourceSRV 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" , priority: "10", protocol: "_tcp", weight: "100"
, port: "80", ttl: "200" , port: "80", ttl: "200"
, domain: "_sip._tcp.example.com.", value: "sip.example.com." } , name : "_sip._tcp.example.com.", target: "sip.example.com." }

340
src/App/ZoneInterface.purs
View File

@ -37,7 +37,7 @@ import Halogen.HTML.Properties as HP
import Bulma as Bulma import Bulma as Bulma
import CSSClasses as C 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) , defaultResourceA, defaultResourceMX, defaultResourceSRV)
import App.ResourceRecord (ResourceRecord) import App.ResourceRecord (ResourceRecord)
@ -84,20 +84,20 @@ data Add_RR
data Update_SRR_Form data Update_SRR_Form
= Update_SRR_Type Int = Update_SRR_Type Int
| Update_SRR_Domain RecordDomain | Update_SRR_Domain RecordName
| Update_SRR_TTL TTL | Update_SRR_TTL TTL
| Update_SRR_Value RecordValue | Update_SRR_Target RecordTarget
data Update_MX_Form data Update_MX_Form
= Update_MX_Domain RecordDomain = Update_MX_Domain RecordName
| Update_MX_TTL TTL | Update_MX_TTL TTL
| Update_MX_Value RecordValue | Update_MX_Target RecordTarget
| Update_MX_Priority Priority | Update_MX_Priority Priority
data Update_SRV_Form data Update_SRV_Form
= Update_SRV_Domain RecordDomain = Update_SRV_Domain RecordName
| Update_SRV_TTL TTL | Update_SRV_TTL TTL
| Update_SRV_Value RecordValue | Update_SRV_Target RecordTarget
| Update_SRV_Priority Priority | Update_SRV_Priority Priority
| Update_SRV_Protocol Protocol | Update_SRV_Protocol Protocol
| Update_SRV_Weight Weight | Update_SRV_Weight Weight
@ -139,7 +139,7 @@ data Action
-- | -- |
type State = type State =
{ _current_domain :: RecordDomain { _current_domain :: RecordName
, _soa :: Maybe (SOARR ()) , _soa :: Maybe (SOARR ())
, _srr :: Array (SimpleRR ()) , _srr :: Array (SimpleRR ())
, _mxrr :: Array (MXRR ()) , _mxrr :: Array (MXRR ())
@ -184,6 +184,8 @@ initialState domain =
, _current_entry_srv: defaultResourceSRV , _current_entry_srv: defaultResourceSRV
} }
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
@ -193,17 +195,18 @@ render state
true, Nothing -> HH.div_ [ Bulma.h1 state._current_domain true, Nothing -> HH.div_ [ Bulma.h1 state._current_domain
, Bulma.hr , Bulma.hr
, render_soa state._soa , render_soa state._soa
, render_records sorted , render_records $ sorted state._srr
, render_mx_records state._mxrr , render_mx_records $ sorted state._mxrr
, render_srv_records state._srvrr , render_srv_records $ sorted state._srvrr
, render_new_records state , render_new_records state
] ]
] ]
where where
sorted = Foldable.foldl (<>) [] sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l))
$ map (A.sortBy (comparing (_.id))) sorted array = Foldable.foldl (<>) []
$ map (A.sortBy (comparing (_.rrid)))
$ map NonEmpty.toArray $ 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 :: forall w. Int -> HH.HTML w Action
modal_rr_delete rr_id = modal_rr_delete rr_id =
@ -257,31 +260,31 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords A.!! val) } H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords A.!! val) }
Update_SRR_Domain val -> do Update_SRR_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val) -- H.raise $ Log $ SimpleLog ("Update new entry name: " <> val)
H.modify_ _ { _current_entry { domain = val } } H.modify_ _ { _current_entry { name = val } }
Update_SRR_TTL val -> do Update_SRR_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val) -- H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } } H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } }
Update_SRR_Value val -> do Update_SRR_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update new entry value: " <> val) -- H.raise $ Log $ SimpleLog ("Update new entry target: " <> val)
H.modify_ _ { _current_entry { value = val } } H.modify_ _ { _current_entry { target = val } }
Update_New_Form_MXRR rr_update -> case rr_update of Update_New_Form_MXRR rr_update -> case rr_update of
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_MX_Domain val -> do 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 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 -- TODO: FIXME: test all inputs
Update_MX_TTL val -> do Update_MX_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val) -- H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} } H.modify_ _ { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_MX_Value val -> do Update_MX_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val) -- H.raise $ Log $ SimpleLog ("Update new MX entry target: " <> val)
state <- H.get 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 Update_MX_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val) -- H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val)
state <- H.get state <- H.get
@ -289,13 +292,13 @@ handleAction = case _ of
Update_New_Form_SRVRR rr_update -> case rr_update of Update_New_Form_SRVRR rr_update -> case rr_update of
Update_SRV_Domain val -> do 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 state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { domain = val } } H.modify_ _ { _current_entry_srv = state._current_entry_srv { name = val } }
Update_SRV_Value val -> do Update_SRV_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val)
state <- H.get 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 -- TODO: FIXME: test all inputs
Update_SRV_TTL val -> do Update_SRV_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
@ -323,7 +326,7 @@ handleAction = case _ of
Add_SRR -> do Add_SRR -> do
state <- H.get state <- H.get
let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry 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 message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
@ -332,7 +335,7 @@ handleAction = case _ of
Add_MXRR -> do Add_MXRR -> do
state <- H.get state <- H.get
let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx 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 message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
@ -340,14 +343,12 @@ handleAction = case _ of
Add_SRVRR -> do Add_SRVRR -> do
state <- H.get state <- H.get
case fromLocalToRR state._current_entry_srv of let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv
Left errmsg -> H.raise $ Log $ SimpleLog $ "Add new SRV failed: " <> errmsg -- H.raise $ Log $ SimpleLog "Add new SRV"
Right newrr -> do message <- H.liftEffect
H.raise $ Log $ SimpleLog $ "Add new SRV: " <> show state._current_entry_srv $ DNSManager.serialize
message <- H.liftEffect $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
$ DNSManager.serialize H.raise $ MessageToSend message
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
H.raise $ MessageToSend message
UpdateLocalForm rr_id form -> case form of UpdateLocalForm 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
@ -357,22 +358,22 @@ handleAction = case _ of
-- state <- H.get -- state <- H.get
-- H.modify_ _ { _srr = changeType state._current_entry (baseRecords A.!! val) } -- H.modify_ _ { _srr = changeType state._current_entry (baseRecords A.!! val) }
Update_SRR_Domain val -> do 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 state <- H.get
H.modify_ _ { _srr = (update_domain rr_id val state._srr) } H.modify_ _ { _srr = (update_domain rr_id val state._srr) }
Update_SRR_TTL val -> do Update_SRR_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " TTL: " <> val) -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " TTL: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _srr = (update_ttl rr_id val state._srr) } H.modify_ _ { _srr = (update_ttl rr_id val state._srr) }
Update_SRR_Value val -> do Update_SRR_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " value: " <> val) -- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " target: " <> val)
state <- H.get 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 Update_Local_Form_MXRR rr_update -> case rr_update of
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_MX_Domain val -> do 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 state <- H.get
H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) } H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
@ -381,10 +382,10 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) } H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_MX_Value val -> do Update_MX_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry value: " <> val) -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry target: " <> val)
state <- H.get 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 Update_MX_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val) -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val)
state <- H.get state <- H.get
@ -392,13 +393,13 @@ handleAction = case _ of
Update_Local_Form_SRVRR rr_update -> case rr_update of Update_Local_Form_SRVRR rr_update -> case rr_update of
Update_SRV_Domain val -> do 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 state <- H.get
H.modify_ _ { _srvrr = (update_domain rr_id val state._srvrr) } H.modify_ _ { _srvrr = (update_domain rr_id val state._srvrr) }
Update_SRV_Value val -> do Update_SRV_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry value: " <> val) -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry target: " <> val)
state <- H.get 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 -- TODO: FIXME: test all inputs
Update_SRV_TTL val -> do Update_SRV_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry ttl: " <> val) -- 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 SyncSRR local_rr_id -> do
state <- H.get 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 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 Just local_rr -> do
let rr = fromLocalSimpleRRRepresentationToResourceRecord local_rr let rr = fromLocalSimpleRRRepresentationToResourceRecord local_rr
H.raise $ Log $ SimpleLog $ "Sync a simple RR: " <> show local_rr_id H.raise $ Log $ SimpleLog $ "Sync a simple RR: " <> show local_rr_id
@ -436,9 +437,9 @@ handleAction = case _ of
SyncMXRR local_rr_id -> do SyncMXRR local_rr_id -> do
state <- H.get 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 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 Just local_rr -> do
let rr = fromLocalMXRRRepresentationToResourceRecord local_rr let rr = fromLocalMXRRRepresentationToResourceRecord local_rr
H.raise $ Log $ SimpleLog $ "Sync a MX RR: " <> show local_rr_id H.raise $ Log $ SimpleLog $ "Sync a MX RR: " <> show local_rr_id
@ -449,9 +450,9 @@ handleAction = case _ of
SyncSRVRR local_rr_id -> do SyncSRVRR local_rr_id -> do
state <- H.get 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 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 Just local_rr -> do
let rr = fromLocalSRVRRepresentationToResourceRecord local_rr let rr = fromLocalSRVRRepresentationToResourceRecord local_rr
H.raise $ Log $ SimpleLog $ "Sync a SRV RR: " <> show local_rr_id H.raise $ Log $ SimpleLog $ "Sync a SRV RR: " <> show local_rr_id
@ -462,7 +463,7 @@ handleAction = case _ of
RemoveRR rr_id -> do RemoveRR rr_id -> do
{ _current_domain } <- H.get { _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 message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id } $ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id }
@ -522,7 +523,7 @@ handleQuery = case _ of
(DNSManager.MkRRReadOnly response) -> do (DNSManager.MkRRReadOnly response) -> do
H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! " H.raise $ Log $ SimpleLog $ "[😈] Trying to modify a read-only resource! "
<> "domain: " <> response.domain <> "domain: " <> response.domain
<> "resource id: " <> show response.rr.rrid <> "resource rrid: " <> show response.rr.rrid
(DNSManager.MkRRUpdated response) -> do (DNSManager.MkRRUpdated response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!" H.raise $ Log $ SimpleLog $ "[🎉] Resource updated!"
@ -531,13 +532,7 @@ handleQuery = case _ of
(DNSManager.MkRRAdded response) -> do (DNSManager.MkRRAdded response) -> do
state <- H.get state <- H.get
let new_rr = response.rr let new_rr = response.rr
-- H.raise $ Log $ SimpleLog $ "Resource Record added: " <> response.domain H.raise $ Log $ SimpleLog $ "[🎉] Resource Record added: " <> new_rr.rrtype
-- <> " 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
case add_entry state new_rr of case add_entry state new_rr of
Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message Left error_message -> H.raise $ Log $ SimpleLog $ "Error while adding new entry: " <> error_message
Right new_state -> H.put new_state Right new_state -> H.put new_state
@ -548,11 +543,11 @@ handleQuery = case _ of
(DNSManager.MkDomainDeleted response) -> do (DNSManager.MkDomainDeleted response) -> do
H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!" H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
(DNSManager.MkRRDeleted response) -> do (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 state <- H.get
H.modify_ _ { _srr = A.filter (\rr -> rr.id /= response.rrid) state._srr H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.id /= response.rrid) state._mxrr , _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.id /= response.rrid) state._srvrr , _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr
} }
(DNSManager.MkZone response) -> do (DNSManager.MkZone response) -> do
@ -581,9 +576,9 @@ handleQuery = case _ of
-- replace_entry :: RRId -- replace_entry :: RRId
replace_entry new_rr = do replace_entry new_rr = do
state <- H.get state <- H.get
H.modify_ _ { _srr = A.filter (\rr -> rr.id /= new_rr.rrid) state._srr H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.id /= new_rr.rrid) state._mxrr , _mxrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.id /= new_rr.rrid) state._srvrr , _srvrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srvrr
} }
new_state <- H.get 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 where left_block = Bulma.column class_title_size
[ Bulma.zone_rr_title "Start Of Authority (SOA)" ] [ Bulma.zone_rr_title "Start Of Authority (SOA)" ]
right_block = Bulma.column_ [ Bulma.p "ALL AVAILABLE DATA" right_block = Bulma.column_ [ Bulma.p "ALL AVAILABLE DATA"
, Bulma.p $ "rrtype: " <> soa.t , Bulma.p $ "rrtype: " <> soa.rrtype
, Bulma.p $ "rrid: " <> show soa.id , Bulma.p $ "rrid: " <> show soa.rrid
, Bulma.p $ "name: " <> soa.domain , Bulma.p $ "name: " <> soa.name
, Bulma.p $ "ttl: " <> soa.ttl , Bulma.p $ "ttl: " <> soa.ttl
, Bulma.p $ "target: " <> soa.value , Bulma.p $ "target: " <> soa.target
, Bulma.p $ "mname: " <> soa.mname , Bulma.p $ "mname: " <> soa.mname
, Bulma.p $ "rname: " <> soa.rname , Bulma.p $ "rname: " <> soa.rname
, Bulma.p $ "serial: " <> soa.serial , Bulma.p $ "serial: " <> soa.serial
, Bulma.p $ "refresh: " <> soa.refresh , Bulma.p $ "refresh: " <> soa.refresh
, Bulma.p $ "retry: " <> soa.retry , Bulma.p $ "retry: " <> soa.retry
, Bulma.p $ "expire: " <> soa.expire , Bulma.p $ "expire: " <> soa.expire
, Bulma.p $ "minttl: " <> soa.minttl , Bulma.p $ "minttl: " <> soa.minttl
] ]
render_records :: forall (w :: Type). Array (SimpleRR ()) -> HH.HTML w Action 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 table_content = HH.tbody_ $ map row records
row rr = HH.tr_ $ row rr = HH.tr_ $
[ Bulma.txt_name rr.t [ Bulma.txt_name rr.rrtype
, HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_Domain) rr.domain rr.valid ] , 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.id) <<< Update_Local_Form_SRR <<< Update_SRR_TTL ) rr.ttl 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_value ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_Value) rr.value 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.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified 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.id) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
] ]
render_mx_records :: forall (w :: Type) (l :: Row Type) render_mx_records :: forall (w :: Type) (l :: Row Type)
. Array (MXRR l) -> HH.HTML w Action . Array (MXRR l) -> HH.HTML w Action
render_mx_records [] render_mx_records []
@ -684,15 +678,14 @@ render_mx_records records
table_content = HH.tbody_ $ map row records table_content = HH.tbody_ $ map row records
row rr = HH.tr_ $ 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_domain ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_Domain) rr.name 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_ttl ((UpdateLocalForm rr.rrid) <<< 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_priority ((UpdateLocalForm rr.rrid) <<< 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.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_MXRR <<< Update_MX_Target) rr.target rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncMXRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified 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.id) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
] ]
render_srv_records :: forall (w :: Type) (l :: Row Type) render_srv_records :: forall (w :: Type) (l :: Row Type)
. Array (SRVRR l) -> HH.HTML w Action . Array (SRVRR l) -> HH.HTML w Action
render_srv_records [] render_srv_records []
@ -708,18 +701,17 @@ render_srv_records records
table_content = HH.tbody_ $ map row records table_content = HH.tbody_ $ map row records
row rr = HH.tr_ $ 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_domain ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Domain ) rr.name 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_ttl ((UpdateLocalForm rr.rrid) <<< 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_priority ((UpdateLocalForm rr.rrid) <<< 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_protocol ((UpdateLocalForm rr.rrid) <<< 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_weight ((UpdateLocalForm rr.rrid) <<< 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_port ((UpdateLocalForm rr.rrid) <<< 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.input_target ((UpdateLocalForm rr.rrid) <<< Update_Local_Form_SRVRR <<< Update_SRV_Target ) rr.target rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncSRVRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified 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.id) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
] ]
baseRecords :: Array String baseRecords :: Array String
baseRecords = [ "NS", "A", "AAAA", "CNAME", "TXT" ] 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_column_simple state._current_entry
, render_new_record_colunm_mx state._current_entry_mx , render_new_record_colunm_mx state._current_entry_mx
, render_new_record_colunm_srv state._current_entry_srv , render_new_record_colunm_srv state._current_entry_srv
-- , render_current_value state._current_entry -- , render_current_target state._current_entry
-- , render_mx_current_value state._current_entry_mx -- , render_mx_current_target state._current_entry_mx
-- , render_srv_current_value state._current_entry_srv -- , render_srv_current_target state._current_entry_srv
] ]
] ]
@ -746,10 +738,10 @@ render_new_record_column_simple rr
= Bulma.column_ $ [ Bulma.box = Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT" [ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT"
, type_selection , 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_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.box_input_target (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Target) rr.target rr.valid
, Bulma.btn_add (AddRR Add_SRR) (TellSomethingWentWrong rr.id "cannot add") rr.valid , Bulma.btn_add (AddRR Add_SRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid
] ]
] ]
where where
@ -760,19 +752,18 @@ render_new_record_column_simple rr
type_option n type_option n
= HH.option = HH.option
[ HP.value n [ HP.value n
, HP.selected (n == rr.t) , HP.selected (n == rr.rrtype)
] [ HH.text n ] ] [ HH.text n ]
render_new_record_colunm_mx :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action render_new_record_colunm_mx :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action
render_new_record_colunm_mx rr render_new_record_colunm_mx rr
= Bulma.column_ $ [ Bulma.box = Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "MX" [ 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_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_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.box_input_target (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Target) rr.target rr.valid
, Bulma.btn_add (AddRR Add_MXRR) (TellSomethingWentWrong rr.id "cannot add") 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 render_new_record_colunm_srv rr
= Bulma.column_ $ [ Bulma.box = Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "SRV" [ 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_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_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_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_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_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.box_input_target (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Target) rr.target rr.valid
, Bulma.btn_add (AddRR Add_SRVRR) (TellSomethingWentWrong rr.id "cannot add") 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 :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l)
changeType rr Nothing = rr changeType rr Nothing = rr
changeType rr (Just s) = rr { t = s } changeType rr (Just s) = rr { rrtype = s }
update_domain :: forall (l :: Row Type). update_domain :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) update_domain rr_id val = update (\rr -> rr { modified = true, name = val }) rr_id
update_domain rr_id val
= update (\rr -> rr { modified = true, domain = val }) rr_id
update_value :: forall (l :: Row Type). update_target :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) update_target rr_id val = update (\rr -> rr { modified = true, target = val }) rr_id
update_value rr_id val
= update (\rr -> rr { modified = true, value = val }) rr_id
update_ttl :: forall (l :: Row Type). update_ttl :: forall (l :: Row Type). Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
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 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 :: 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 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 update f rr_id records = map doSmth records
where where
doSmth rr doSmth rr
| rr_id == rr.id = f rr | rr_id == rr.rrid = f rr
| otherwise = 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 :: ResourceRecord -> Maybe (SimpleRR ())
fromResourceRecordToLocalRepresentationSimpleRR new_rr = fromResourceRecordToLocalRepresentationSimpleRR new_rr =
Just { t: new_rr.rrtype Just { rrtype: new_rr.rrtype
, id: new_rr.rrid , rrid: new_rr.rrid
, modified: false , modified: false
, valid: true , valid: true
, readonly: new_rr.readonly
, ttl: show new_rr.ttl , ttl: show new_rr.ttl
, domain: new_rr.name , name: new_rr.name
, value: new_rr.target , target: new_rr.target
} }
fromResourceRecordToLocalRepresentationMXRR :: ResourceRecord -> Maybe (MXRR ()) fromResourceRecordToLocalRepresentationMXRR :: ResourceRecord -> Maybe (MXRR ())
fromResourceRecordToLocalRepresentationMXRR new_rr = do fromResourceRecordToLocalRepresentationMXRR new_rr = do
priority <- new_rr.priority priority <- new_rr.priority
Just { t: new_rr.rrtype Just { rrtype: new_rr.rrtype
, id: new_rr.rrid , rrid: new_rr.rrid
, modified: false , modified: false
, valid: true , valid: true
, readonly: new_rr.readonly
, ttl: show new_rr.ttl , ttl: show new_rr.ttl
, domain: new_rr.name , name: new_rr.name
, value: new_rr.target , target: new_rr.target
, priority: show priority , priority: show priority
} }
-- TODO: would be nice to have a simpler implementation, something like this: -- TODO: would be nice to have a simpler implementation, something like this:
@ -904,13 +882,14 @@ fromResourceRecordToLocalRepresentationSRVRR new_rr = do
weight <- new_rr.weight weight <- new_rr.weight
priority <- new_rr.priority priority <- new_rr.priority
protocol <- new_rr.protocol protocol <- new_rr.protocol
Just { t: new_rr.rrtype Just { rrtype: new_rr.rrtype
, id: new_rr.rrid , rrid: new_rr.rrid
, modified: false , modified: false
, valid: true , valid: true
, readonly: new_rr.readonly
, ttl: show new_rr.ttl , ttl: show new_rr.ttl
, domain: new_rr.name , name: new_rr.name
, value: new_rr.target , target: new_rr.target
, priority: show priority , priority: show priority
, port: show port , port: show port
, weight: show weight , weight: show weight
@ -926,13 +905,14 @@ fromResourceRecordToLocalRepresentationSOARR new_rr = do
retry <- new_rr.retry -- :: Maybe Int retry <- new_rr.retry -- :: Maybe Int
expire <- new_rr.expire -- :: Maybe Int expire <- new_rr.expire -- :: Maybe Int
minttl <- new_rr.minttl -- :: Maybe Int minttl <- new_rr.minttl -- :: Maybe Int
Just { t: new_rr.rrtype Just { rrtype: new_rr.rrtype
, id: new_rr.rrid , rrid: new_rr.rrid
, modified: false , modified: false
, valid: true , valid: true
, readonly: new_rr.readonly
, ttl: show new_rr.ttl , ttl: show new_rr.ttl
, domain: new_rr.name , name: new_rr.name
, value: new_rr.target , target: new_rr.target
, mname: mname -- :: RR (Maybe String) Local (String) , mname: mname -- :: RR (Maybe String) Local (String)
, rname: rname -- :: RR (Maybe String) Local (String) , rname: rname -- :: RR (Maybe String) Local (String)
, serial: show serial -- :: RR (Maybe Int) 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 :: forall l. SimpleRR (|l) -> ResourceRecord
fromLocalSimpleRRRepresentationToResourceRecord form fromLocalSimpleRRRepresentationToResourceRecord form
= { rrtype: form.t = { rrtype: form.rrtype
, rrid: form.id , rrid: form.rrid
, name: form.domain , name: form.name
, ttl: fromMaybe 3600 $ fromString form.ttl , ttl: fromMaybe 3600 $ fromString form.ttl
, target: form.value , target: form.target
, readonly: false , readonly: form.readonly
, priority: Nothing , priority: Nothing
, port: Nothing , port: Nothing
, protocol: Nothing , protocol: Nothing
@ -965,12 +945,12 @@ fromLocalSimpleRRRepresentationToResourceRecord form
fromLocalMXRRRepresentationToResourceRecord :: forall l. MXRR (|l) -> ResourceRecord fromLocalMXRRRepresentationToResourceRecord :: forall l. MXRR (|l) -> ResourceRecord
fromLocalMXRRRepresentationToResourceRecord form fromLocalMXRRRepresentationToResourceRecord form
= { rrtype: form.t = { rrtype: form.rrtype
, rrid: form.id , rrid: form.rrid
, name: form.domain , name: form.name
, ttl: fromMaybe 3600 $ fromString form.ttl , ttl: fromMaybe 3600 $ fromString form.ttl
, target: form.value , target: form.target
, readonly: false , readonly: form.readonly
, priority: Just $ fromMaybe 10 $ fromString form.priority , priority: Just $ fromMaybe 10 $ fromString form.priority
, port: Nothing , port: Nothing
, protocol: Nothing , protocol: Nothing
@ -986,12 +966,12 @@ fromLocalMXRRRepresentationToResourceRecord form
fromLocalSRVRRepresentationToResourceRecord :: forall l. SRVRR (|l) -> ResourceRecord fromLocalSRVRRepresentationToResourceRecord :: forall l. SRVRR (|l) -> ResourceRecord
fromLocalSRVRRepresentationToResourceRecord form fromLocalSRVRRepresentationToResourceRecord form
= { rrtype: form.t = { rrtype: form.rrtype
, rrid: form.id , rrid: form.rrid
, name: form.domain , name: form.name
, ttl: fromMaybe 3600 $ fromString form.ttl , ttl: fromMaybe 3600 $ fromString form.ttl
, target: form.value , target: form.target
, readonly: false , readonly: form.readonly
, priority: Just $ fromMaybe 10 $ fromString form.priority , priority: Just $ fromMaybe 10 $ fromString form.priority
, port: Just $ fromMaybe 10 $ fromString form.port , port: Just $ fromMaybe 10 $ fromString form.port
, protocol: Just form.protocol , protocol: Just form.protocol
@ -1016,6 +996,6 @@ getNewID state = (_ + 1)
] ]
where where
maxIDrr = Foldable.foldl max 0 $ map _.id state._srr maxIDrr = Foldable.foldl max 0 $ map _.rrid state._srr
maxIDmxrr = Foldable.foldl max 0 $ map _.id state._mxrr maxIDmxrr = Foldable.foldl max 0 $ map _.rrid state._mxrr
maxIDsrvrr = Foldable.foldl max 0 $ map _.id state._srvrr maxIDsrvrr = Foldable.foldl max 0 $ map _.rrid state._srvrr

26
src/Bulma.purs
View File

@ -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 :: forall w i. HH.HTML w i
simple_table_header simple_table_header
= HH.thead_ [ HH.tr_ [ HH.th [ HP.style "width: 50px;" ] [ HH.text "Type" ] = 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 "TTL" ]
, HH.th_ [ HH.text "Value" ] , HH.th_ [ HH.text "Target" ]
] ]
] ]
mx_table_header :: forall w i. HH.HTML w i mx_table_header :: forall w i. HH.HTML w i
mx_table_header 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 "TTL" ]
, HH.th_ [ HH.text "Priority" ] , 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 :: forall w i. HH.HTML w i
srv_table_header 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 "TTL" ]
, HH.th_ [ HH.text "Priority" ] , HH.th_ [ HH.text "Priority" ]
, HH.th_ [ HH.text "Protocol" ] , HH.th_ [ HH.text "Protocol" ]
, HH.th_ [ HH.text "Weight" ] , HH.th_ [ HH.text "Weight" ]
, HH.th_ [ HH.text "Port" ] , 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 ] , 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_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
input_value action value validity input_target action value validity
= HH.input = HH.input
[ HE.onValueInput action [ HE.onValueInput action
, HP.value value , HP.value value
, HP.placeholder "value" , HP.placeholder "target"
, HP.classes $ input_classes validity , HP.classes $ input_classes validity
] ]
box_input_value :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i box_input_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
box_input_value action value validity = HH.label [ ] box_input_target action value validity = HH.label [ ]
[ HH.label [HP.classes C.label ] [ HH.text "Value" ] [ HH.label [HP.classes C.label ] [ HH.text "Target" ]
, HH.div [HP.classes C.control ] [ input_value action value validity ] , HH.div [HP.classes C.control ] [ input_target action value validity ]
] ]