Adding a WIP zone interface. Not even showable ATM.
This commit is contained in:
parent
2072347df0
commit
6ccc1846df
@ -14,6 +14,7 @@
|
|||||||
, "effect"
|
, "effect"
|
||||||
, "either"
|
, "either"
|
||||||
, "exceptions"
|
, "exceptions"
|
||||||
|
, "foldable-traversable"
|
||||||
, "foreign"
|
, "foreign"
|
||||||
, "halogen"
|
, "halogen"
|
||||||
, "halogen-subscriptions"
|
, "halogen-subscriptions"
|
||||||
|
|||||||
@ -6,7 +6,7 @@
|
|||||||
-- | - show and select accepted domains (TLDs)
|
-- | - show and select accepted domains (TLDs)
|
||||||
-- | - create new domains
|
-- | - create new domains
|
||||||
-- | - delete a domain
|
-- | - delete a domain
|
||||||
-- | - TODO: ask for confirmation
|
-- | - ask for confirmation
|
||||||
-- | - TODO: switch to the interface to show and modify the content of a Zone
|
-- | - TODO: switch to the interface to show and modify the content of a Zone
|
||||||
|
|
||||||
module App.DomainListInterface where
|
module App.DomainListInterface where
|
||||||
|
|||||||
137
src/App/RR.purs
Normal file
137
src/App/RR.purs
Normal file
@ -0,0 +1,137 @@
|
|||||||
|
module App.RR where
|
||||||
|
|
||||||
|
type InputParameter
|
||||||
|
= { valid :: Boolean
|
||||||
|
, value :: String
|
||||||
|
}
|
||||||
|
|
||||||
|
type RecordType = String
|
||||||
|
type RecordValue = String
|
||||||
|
type RecordDomain = String
|
||||||
|
|
||||||
|
-- These should be integers, but I use these values in user inputs.
|
||||||
|
type TTL = String
|
||||||
|
type Weight = String
|
||||||
|
type Priority = String
|
||||||
|
type Port = String
|
||||||
|
|
||||||
|
type RRId = Int
|
||||||
|
|
||||||
|
type Modified = Boolean
|
||||||
|
type Valid = Boolean
|
||||||
|
|
||||||
|
type RecordBase l
|
||||||
|
= { t :: RecordType
|
||||||
|
, id :: RRId
|
||||||
|
, modified :: Boolean
|
||||||
|
, valid :: Boolean
|
||||||
|
, ttl :: TTL
|
||||||
|
, domain :: RecordDomain
|
||||||
|
, value :: RecordValue | l
|
||||||
|
}
|
||||||
|
|
||||||
|
-- CNAME A AAAA NS TXT
|
||||||
|
type SimpleRR l = RecordBase (|l)
|
||||||
|
|
||||||
|
type MXRR l = RecordBase ( priority :: Priority | l)
|
||||||
|
type SRVRR l = RecordBase ( priority :: Priority
|
||||||
|
, weight :: Weight
|
||||||
|
, port :: Port
|
||||||
|
| l)
|
||||||
|
|
||||||
|
--data Status
|
||||||
|
-- = Synchronized
|
||||||
|
-- | UnSynchronized
|
||||||
|
--
|
||||||
|
--type Reason = String
|
||||||
|
--data Validity
|
||||||
|
-- = Valid
|
||||||
|
-- | Invalid (Maybe Reason)
|
||||||
|
--
|
||||||
|
---- TODO: add smart constructors.
|
||||||
|
--data Domain = Domain String
|
||||||
|
--data RRAValue = RRAValue String
|
||||||
|
--data RRAAAAValue = RRAAAAValue String
|
||||||
|
--data RRCNAMEValue = RRCNAMEValue String
|
||||||
|
--data RRNSValue = RRNSValue String
|
||||||
|
--data RRTXTValue = RRTXTValue String
|
||||||
|
--data RRMXValue = RRMXValue String
|
||||||
|
--data RRSRVValue = RRSRVValue String
|
||||||
|
--data Priority = Priority String
|
||||||
|
--data Weight = Weight String
|
||||||
|
--data Port = Port String
|
||||||
|
--
|
||||||
|
--data RR
|
||||||
|
-- = A RRId Status Validity TTL Domain RRAValue
|
||||||
|
-- | AAAA RRId Status Validity TTL Domain RRAAAAValue
|
||||||
|
-- | CNAME RRId Status Validity TTL Domain RRCNAMEValue
|
||||||
|
-- | NS RRId Status Validity TTL Domain RRNSValue
|
||||||
|
-- | TXT RRId Status Validity TTL Domain RRTXTValue
|
||||||
|
-- | MX RRId Status Validity TTL Domain RRMXValue Priority
|
||||||
|
-- | SRV RRId Status Validity TTL Domain RRSRVValue Priority Weight Port
|
||||||
|
|
||||||
|
mkNS :: RRId -> Modified -> Valid
|
||||||
|
-> TTL -> RecordDomain -> RecordValue -> RecordBase ()
|
||||||
|
mkNS i c ok t d v
|
||||||
|
= { id: i, t: "NS", modified: c, valid: ok
|
||||||
|
, ttl: t, domain: d, value: v }
|
||||||
|
mkA :: RRId -> Modified -> Valid
|
||||||
|
-> TTL -> RecordDomain -> RecordValue -> RecordBase ()
|
||||||
|
mkA i c ok t d v
|
||||||
|
= { id: i, t: "A", modified: c, valid: ok
|
||||||
|
, ttl: t, domain: d, value: v }
|
||||||
|
mkAAAA :: RRId -> Modified -> Valid
|
||||||
|
-> TTL -> RecordDomain -> RecordValue -> RecordBase ()
|
||||||
|
mkAAAA i c ok t d v
|
||||||
|
= { id: i, t: "AAAA", modified: c, valid: ok
|
||||||
|
, ttl: t, domain: d, value: v }
|
||||||
|
mkCNAME :: RRId -> Modified -> Valid
|
||||||
|
-> TTL -> RecordDomain -> RecordValue -> RecordBase ()
|
||||||
|
mkCNAME i c ok t d v
|
||||||
|
= { id: i, t: "CNAME", modified: c, valid: ok
|
||||||
|
, ttl: t, domain: d, value: v }
|
||||||
|
mkTXT :: RRId -> Modified -> Valid
|
||||||
|
-> TTL -> RecordDomain -> RecordValue -> RecordBase ()
|
||||||
|
mkTXT i c ok t d v
|
||||||
|
= { id: i, t: "TXT", modified: c, valid: ok
|
||||||
|
, ttl: t, domain: d, value: v }
|
||||||
|
|
||||||
|
mkMX :: RRId -> Modified -> Valid
|
||||||
|
-> TTL -> RecordDomain -> RecordValue -> Priority -> MXRR ()
|
||||||
|
mkMX i c ok t d v p
|
||||||
|
= { id: i, t: "MX", modified: c, valid: ok
|
||||||
|
, ttl: t, priority: p, domain: d, value: v }
|
||||||
|
|
||||||
|
mkSRV :: RRId -> Modified -> Valid
|
||||||
|
-> Priority -> Weight -> Port
|
||||||
|
-> TTL -> RecordDomain -> RecordValue -> SRVRR ()
|
||||||
|
mkSRV i c ok p w prt t d v
|
||||||
|
= { id: i, t: "SRV", modified: c
|
||||||
|
, valid: ok, priority: p, weight: w, port: prt
|
||||||
|
, ttl: t, domain: d, value: v
|
||||||
|
}
|
||||||
|
|
||||||
|
defaultResourceRecords :: Array (SimpleRR ())
|
||||||
|
defaultResourceRecords
|
||||||
|
= [ mkNS 0 false true "3600" "@" "ns0.truc.fr"
|
||||||
|
, mkA 1 false true "200" "www" "192.168.10.2"
|
||||||
|
, mkAAAA 2 false true "610" "www" "fe80::1"
|
||||||
|
, mkCNAME 3 false true "630" "nom" "autrenom"
|
||||||
|
, mkTXT 4 false true "600" "txtme" "Ceci est un texte."
|
||||||
|
]
|
||||||
|
|
||||||
|
defaultMXResourceRecords :: Array (MXRR ())
|
||||||
|
defaultMXResourceRecords
|
||||||
|
= [ mkMX 5 false true "600" "www" "192.168.10.2" "200"
|
||||||
|
, mkMX 6 false true "3600" "www" "192.168.10.2" "200"
|
||||||
|
]
|
||||||
|
|
||||||
|
defaultResourceA :: SimpleRR ()
|
||||||
|
defaultResourceA = mkA 0 false true "200" "www" "192.168.10.2"
|
||||||
|
|
||||||
|
defaultResourceMX :: MXRR ()
|
||||||
|
defaultResourceMX = mkMX 0 false true "500" "www" "192.168.10.2" "200"
|
||||||
|
|
||||||
|
defaultResourceSRV :: SRVRR ()
|
||||||
|
-- RRId Modified Valid Priority Weight Port TTL Domain Value
|
||||||
|
defaultResourceSRV = mkSRV 0 false true "10" "100" "80" "200" "www" "192.168.10.2"
|
||||||
290
src/App/Style.purs
Normal file
290
src/App/Style.purs
Normal file
@ -0,0 +1,290 @@
|
|||||||
|
module App.Style where
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import Halogen.HTML as HH
|
||||||
|
import Halogen.HTML.Properties as HP
|
||||||
|
import Halogen.HTML.Events as HE
|
||||||
|
|
||||||
|
-- HTML PropName used with HP.prop
|
||||||
|
import Halogen.HTML.Core (PropName(..))
|
||||||
|
-- import Web.Event.Event (type_, Event, EventType(..))
|
||||||
|
import Web.UIEvent.MouseEvent (MouseEvent)
|
||||||
|
|
||||||
|
-- This file is mostly a wrapper around BULMA.
|
||||||
|
|
||||||
|
class_columns :: Array (HH.ClassName)
|
||||||
|
class_columns = [HH.ClassName "columns" ]
|
||||||
|
class_column :: Array (HH.ClassName)
|
||||||
|
class_column = [HH.ClassName "column" ]
|
||||||
|
class_title :: Array (HH.ClassName)
|
||||||
|
class_title = [HH.ClassName "title" ]
|
||||||
|
class_subtitle :: Array (HH.ClassName)
|
||||||
|
class_subtitle = [HH.ClassName "subtitle" ]
|
||||||
|
class_is5 :: Array (HH.ClassName)
|
||||||
|
class_is5 = [HH.ClassName "is-5" ]
|
||||||
|
class_is4 :: Array (HH.ClassName)
|
||||||
|
class_is4 = [HH.ClassName "is-4" ]
|
||||||
|
class_box :: Array (HH.ClassName)
|
||||||
|
class_box = [HH.ClassName "box" ]
|
||||||
|
class_label :: Array (HH.ClassName)
|
||||||
|
class_label = [HH.ClassName "label" ]
|
||||||
|
class_control :: Array (HH.ClassName)
|
||||||
|
class_control = [HH.ClassName "control" ]
|
||||||
|
|
||||||
|
|
||||||
|
columns :: forall (w :: Type) (i :: Type).
|
||||||
|
Array (HH.ClassName) -> Array (HH.HTML w i) -> HH.HTML w i
|
||||||
|
columns classes = HH.div [ HP.classes (class_columns <> classes) ]
|
||||||
|
|
||||||
|
columns_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
|
||||||
|
columns_ = columns []
|
||||||
|
|
||||||
|
column :: forall (w :: Type) (i :: Type).
|
||||||
|
Array (HH.ClassName) -> Array (HH.HTML w i) -> HH.HTML w i
|
||||||
|
column classes = HH.div [ HP.classes (class_column <> classes) ]
|
||||||
|
|
||||||
|
column_ :: forall (w :: Type) (i :: Type). Array (HH.HTML w i) -> HH.HTML w i
|
||||||
|
column_ = column []
|
||||||
|
|
||||||
|
h1 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
|
||||||
|
h1 title = HH.h1 [ HP.classes (class_title) ] [ HH.text title ]
|
||||||
|
|
||||||
|
h3 :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
|
||||||
|
h3 title = HH.h1 [ HP.classes (class_title <> class_is5) ] [ HH.text title ]
|
||||||
|
|
||||||
|
subtitle :: forall (w :: Type) (a :: Type). String -> HH.HTML w a
|
||||||
|
subtitle title = HH.h2 [ HP.classes (class_subtitle <> class_is4) ] [ HH.text title ]
|
||||||
|
|
||||||
|
hdiv :: forall (w :: Type) (a :: Type). Array (HH.HTML w a) -> HH.HTML w a
|
||||||
|
hdiv = HH.div [ HP.classes [HH.ClassName "mt-5"] ]
|
||||||
|
|
||||||
|
offcolumn :: forall (w :: Type) (a :: Type).
|
||||||
|
Int -> Int -> Array (HH.HTML w a) -> HH.HTML w a
|
||||||
|
offcolumn 0 size = HH.div [ HP.classes [HH.ClassName ("mt-"<>show size)] ]
|
||||||
|
offcolumn offset size
|
||||||
|
= column [ HH.ClassName ("is-offset-" <> (show offset) <> " is-" <> (show size)) ]
|
||||||
|
|
||||||
|
input_classes :: forall (r :: Row Type) (i :: Type)
|
||||||
|
. Boolean -> HP.IProp ( class :: String | r ) i
|
||||||
|
input_classes true = HP.classes [ HH.ClassName "input is-small is-info" ]
|
||||||
|
input_classes false = HP.classes [ HH.ClassName "input is-small is-danger" ]
|
||||||
|
|
||||||
|
btn_classes :: forall (r :: Row Type) (i :: Type)
|
||||||
|
. Boolean -> HP.IProp ( class :: String | r ) i
|
||||||
|
btn_classes true = HP.classes [ HH.ClassName "button is-small is-info" ]
|
||||||
|
btn_classes false = HP.classes [ HH.ClassName "button is-small 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 "TTL" ]
|
||||||
|
, HH.th_ [ HH.text "Value" ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
mx_table_header :: forall w i. HH.HTML w i
|
||||||
|
mx_table_header
|
||||||
|
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain" ]
|
||||||
|
, HH.th_ [ HH.text "TTL" ]
|
||||||
|
, HH.th_ [ HH.text "Priority" ]
|
||||||
|
, HH.th_ [ HH.text "Value" ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
srv_table_header :: forall w i. HH.HTML w i
|
||||||
|
srv_table_header
|
||||||
|
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Domain" ]
|
||||||
|
, HH.th_ [ HH.text "TTL" ]
|
||||||
|
, HH.th_ [ HH.text "Priority" ]
|
||||||
|
, HH.th_ [ HH.text "Weight" ]
|
||||||
|
, HH.th_ [ HH.text "Port" ]
|
||||||
|
, HH.th_ [ HH.text "Value" ]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
txt_name :: forall w i. String -> HH.HTML w i
|
||||||
|
txt_name t
|
||||||
|
= HH.td [ rr_name_style ] [ rr_name_text ]
|
||||||
|
where
|
||||||
|
rr_name_style = HP.style "width: 80px;"
|
||||||
|
rr_name_text = HH.text t
|
||||||
|
|
||||||
|
input_email :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_email action "" validity
|
||||||
|
= HH.input [ HE.onValueInput action, HP.placeholder "email", input_classes validity ]
|
||||||
|
input_email action email validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value email
|
||||||
|
, HP.placeholder "email"
|
||||||
|
, input_classes validity
|
||||||
|
]
|
||||||
|
|
||||||
|
box_input_email :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
box_input_email action email validity = HH.label [ ]
|
||||||
|
[ HH.label [HP.classes class_label ] [ HH.text "Email" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_email action email validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
input_password :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_password action "" validity
|
||||||
|
= HH.input [ HE.onValueInput action, HP.placeholder "password", input_classes validity ]
|
||||||
|
input_password action password validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value password
|
||||||
|
, HP.placeholder "password"
|
||||||
|
, input_classes validity
|
||||||
|
]
|
||||||
|
|
||||||
|
box_input_password :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
box_input_password action password validity = HH.label [ ]
|
||||||
|
[ HH.label [HP.classes class_label ] [ HH.text "Password" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_password action password validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO: right types
|
||||||
|
-- input_domain :: forall a w i
|
||||||
|
-- . (String -> a)
|
||||||
|
-- -> String
|
||||||
|
-- -> Boolean
|
||||||
|
-- -> HH.HTML w i
|
||||||
|
input_domain :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_domain action domain validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value domain
|
||||||
|
, HP.placeholder "domain"
|
||||||
|
, input_classes validity
|
||||||
|
]
|
||||||
|
|
||||||
|
box_input_domain :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
box_input_domain action domain validity = HH.label [ ]
|
||||||
|
[ HH.label [HP.classes class_label ] [ HH.text "Domain" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_domain action domain validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
input_ttl :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_ttl action ttl validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value ttl
|
||||||
|
, HP.prop (PropName "size") 6.0
|
||||||
|
, HP.placeholder "ttl"
|
||||||
|
, input_classes validity
|
||||||
|
]
|
||||||
|
|
||||||
|
box_input_ttl :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
box_input_ttl action value validity = HH.label [ ]
|
||||||
|
[ HH.label [HP.classes class_label ] [ HH.text "TTL" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_ttl action value validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
input_priority :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_priority action priority validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value priority
|
||||||
|
, HP.prop (PropName "size") 6.0
|
||||||
|
, HP.placeholder "priority"
|
||||||
|
, input_classes validity
|
||||||
|
]
|
||||||
|
|
||||||
|
box_input_priority :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
box_input_priority action value validity = HH.label [ ]
|
||||||
|
[ HH.label [HP.classes class_label ] [ HH.text "Priority" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_priority action value validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
input_value :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_value action value validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value value
|
||||||
|
, HP.placeholder "value"
|
||||||
|
, 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 class_label ] [ HH.text "Value" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_value action value validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
input_weight :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_weight action weight validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value weight
|
||||||
|
, HP.prop (PropName "size") 6.0
|
||||||
|
, HP.placeholder "weight"
|
||||||
|
, input_classes validity
|
||||||
|
]
|
||||||
|
|
||||||
|
box_input_weight :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
box_input_weight action weight validity = HH.label [ ]
|
||||||
|
[ HH.label [HP.classes class_label ] [ HH.text "Weight" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_weight action weight validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
input_port :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
input_port action port validity
|
||||||
|
= HH.input
|
||||||
|
[ HE.onValueInput action
|
||||||
|
, HP.value port
|
||||||
|
, HP.prop (PropName "size") 6.0
|
||||||
|
, HP.placeholder "port"
|
||||||
|
, input_classes validity
|
||||||
|
]
|
||||||
|
|
||||||
|
box_input_port :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i
|
||||||
|
box_input_port action port validity = HH.label [ ]
|
||||||
|
[ HH.label [HP.classes class_label ] [ HH.text "Port" ]
|
||||||
|
, HH.div [HP.classes class_control ] [ input_port action port validity ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
btn_change :: forall w i. i -> i -> Boolean -> Boolean -> HH.HTML w i
|
||||||
|
btn_change action1 action2 modified validity
|
||||||
|
= HH.button
|
||||||
|
[ HP.disabled (not modified)
|
||||||
|
, btn_change_action validity
|
||||||
|
, btn_classes validity
|
||||||
|
] [ HH.text "fix" ]
|
||||||
|
where
|
||||||
|
|
||||||
|
btn_change_action = case _ of
|
||||||
|
true -> HE.onClick \_ -> action1
|
||||||
|
_ -> HE.onClick \_ -> action2
|
||||||
|
|
||||||
|
|
||||||
|
btn_delete :: forall w i. (MouseEvent -> i) -> HH.HTML w i
|
||||||
|
btn_delete action
|
||||||
|
= HH.button
|
||||||
|
[ HE.onClick action
|
||||||
|
, HP.classes [ HH.ClassName "button is-small is-danger" ]
|
||||||
|
] [ HH.text "X" ]
|
||||||
|
|
||||||
|
|
||||||
|
btn_add :: forall w i. i -> i -> Boolean -> HH.HTML w i
|
||||||
|
btn_add action1 action2 validity
|
||||||
|
= HH.button
|
||||||
|
[ btn_add_action validity
|
||||||
|
, btn_classes validity
|
||||||
|
] [ HH.text "Add" ]
|
||||||
|
where
|
||||||
|
|
||||||
|
btn_add_action = case _ of
|
||||||
|
true -> HE.onClick \_ -> action1
|
||||||
|
_ -> HE.onClick \_ -> action2
|
||||||
|
|
||||||
|
box :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
|
||||||
|
box = HH.div [HP.classes class_box]
|
||||||
847
src/App/ZoneInterface.purs
Normal file
847
src/App/ZoneInterface.purs
Normal file
@ -0,0 +1,847 @@
|
|||||||
|
-- | `App.ZoneInterface` provides an interface to display and modify a DNS zone.
|
||||||
|
-- |
|
||||||
|
-- | This interface allows to:
|
||||||
|
-- | - TODO: display all resource records of a zone
|
||||||
|
-- | - TODO: add new resource records
|
||||||
|
-- | - TODO: remove resource records
|
||||||
|
-- | - TODO: ask for confirmation on deletion
|
||||||
|
|
||||||
|
module App.ZoneInterface where
|
||||||
|
|
||||||
|
|
||||||
|
import Prelude
|
||||||
|
|
||||||
|
import CSSClasses as CSSClasses
|
||||||
|
import Data.Array as A
|
||||||
|
import Data.ArrayBuffer.Types (ArrayBuffer)
|
||||||
|
import Data.Either (Either(..))
|
||||||
|
import Data.Maybe (Maybe(..), maybe)
|
||||||
|
import Data.String.Utils (endsWith)
|
||||||
|
import Effect.Aff.Class (class MonadAff)
|
||||||
|
import Halogen as H
|
||||||
|
import Halogen.HTML as HH
|
||||||
|
import Halogen.HTML.Events as HE
|
||||||
|
import Halogen.HTML.Events as HHE
|
||||||
|
import Halogen.HTML.Properties as HP
|
||||||
|
import Web.Event.Event as Event
|
||||||
|
import Web.Event.Event (Event)
|
||||||
|
import Bulma as Bulma
|
||||||
|
import CSSClasses as C
|
||||||
|
|
||||||
|
import App.Style as S
|
||||||
|
import App.RR
|
||||||
|
|
||||||
|
import App.LogMessage
|
||||||
|
import App.Messages.DNSManagerDaemon as DNSManager
|
||||||
|
|
||||||
|
-- IMPORTED
|
||||||
|
import Data.Array (groupAllBy, sortBy, filter, (!!))
|
||||||
|
import Data.Array.NonEmpty (toArray)
|
||||||
|
import Data.Maybe (Maybe(..), maybe, fromMaybe)
|
||||||
|
|
||||||
|
import Data.String.Regex (Regex, test)
|
||||||
|
import Data.String.Regex.Unsafe (unsafeRegex)
|
||||||
|
import Data.String.Regex.Flags (noFlags)
|
||||||
|
|
||||||
|
import Data.Foldable (foldl)
|
||||||
|
|
||||||
|
import Effect.Class (class MonadEffect)
|
||||||
|
import Halogen as H
|
||||||
|
-- import Halogen.Aff as HA
|
||||||
|
import Halogen.HTML as HH
|
||||||
|
import Halogen.HTML.Properties as HP
|
||||||
|
import Halogen.HTML.Events as HE
|
||||||
|
|
||||||
|
import Halogen.HTML.Properties.ARIA as Aria
|
||||||
|
|
||||||
|
-- HTML PropName used with HP.prop
|
||||||
|
-- import Halogen.HTML.Core (PropName(..))
|
||||||
|
import Halogen.HTML.Core (AttrName(..))
|
||||||
|
|
||||||
|
-- | `App.ZoneInterface` can send messages through websocket interface
|
||||||
|
-- | connected to dnsmanagerd. See `App.WS`.
|
||||||
|
-- |
|
||||||
|
-- | Also, this component can log messages and ask its parent (`App.Container`) to
|
||||||
|
-- | reconnect the websocket to `dnsmanagerd`.
|
||||||
|
|
||||||
|
data Output
|
||||||
|
= MessageToSend ArrayBuffer
|
||||||
|
| Log LogMessage
|
||||||
|
| DNSManagerReconnect
|
||||||
|
|
||||||
|
-- | `App.ZoneInterface` can receive messages from `dnsmanagerd`.
|
||||||
|
-- |
|
||||||
|
-- | The component is also informed when the connection is lost or up again.
|
||||||
|
|
||||||
|
data Query a
|
||||||
|
= MessageReceived ArrayBuffer a
|
||||||
|
| ConnectionIsDown a
|
||||||
|
| ConnectionIsUp a
|
||||||
|
|
||||||
|
type Slot = H.Slot Query Output
|
||||||
|
|
||||||
|
-- | `App.ZoneInterface` has a single input: the domain name.
|
||||||
|
|
||||||
|
type Input = String
|
||||||
|
|
||||||
|
-- | Possible component's actions are:
|
||||||
|
-- | - TODO: update the list of resource records
|
||||||
|
-- | - TODO: add a resource record
|
||||||
|
-- | - TODO: modify a resource record
|
||||||
|
-- | - TODO: remove a resource record
|
||||||
|
-- | - TODO: handle user inputs
|
||||||
|
|
||||||
|
data Action
|
||||||
|
= DeleteRRModal String
|
||||||
|
| CancelModal
|
||||||
|
|
||||||
|
| Initialize
|
||||||
|
| Finalize
|
||||||
|
|
||||||
|
| DoNothing String
|
||||||
|
|
||||||
|
-- New entries.
|
||||||
|
| UpdateNewType Int
|
||||||
|
|
||||||
|
| UpdateNewDomainSimple RecordDomain
|
||||||
|
| UpdateNewDomainMX RecordDomain
|
||||||
|
| UpdateNewDomainSRV RecordDomain
|
||||||
|
|
||||||
|
| UpdateNewTTLSimple TTL
|
||||||
|
| UpdateNewTTLMX TTL
|
||||||
|
| UpdateNewTTLSRV TTL
|
||||||
|
|
||||||
|
| UpdateNewEntryValue RecordValue
|
||||||
|
| UpdateNewMXValue RecordValue
|
||||||
|
| UpdateNewSRVValue RecordValue
|
||||||
|
|
||||||
|
| UpdateNewMXPriority Priority
|
||||||
|
| UpdateNewSRVPriority Priority
|
||||||
|
|
||||||
|
| UpdateNewSRVWeight Weight
|
||||||
|
| UpdateNewSRVPort Port
|
||||||
|
|
||||||
|
| AddSimple
|
||||||
|
| AddMX
|
||||||
|
| AddSRV
|
||||||
|
|
||||||
|
-- Entry already in our zone.
|
||||||
|
| UpdateLocalTTL RRId TTL
|
||||||
|
| UpdateLocalTTLMX RRId TTL
|
||||||
|
| UpdateLocalTTLSRV RRId TTL
|
||||||
|
|
||||||
|
| UpdateLocalValue RRId RecordValue
|
||||||
|
| UpdateLocalValueMX RRId RecordValue
|
||||||
|
| UpdateLocalValueSRV RRId RecordValue
|
||||||
|
|
||||||
|
| UpdateLocalPriorityMX RRId Priority
|
||||||
|
| UpdateLocalPrioritySRV RRId Priority
|
||||||
|
|
||||||
|
| UpdateLocalWeight RRId Weight
|
||||||
|
| UpdateLocalPort RRId Port
|
||||||
|
| UpdateOnServer RRId
|
||||||
|
|
||||||
|
| DeleteSimple RRId
|
||||||
|
| DeleteMX RRId
|
||||||
|
| DeleteSRV RRId
|
||||||
|
|
||||||
|
|
||||||
|
| TellSomethingWentWrong RRId String
|
||||||
|
|
||||||
|
-- |
|
||||||
|
|
||||||
|
type State =
|
||||||
|
{ _current_domain :: RecordDomain
|
||||||
|
, _rr :: Array (SimpleRR ())
|
||||||
|
, _mxrr :: Array (MXRR ())
|
||||||
|
, _srvrr :: Array (SRVRR ())
|
||||||
|
, _current_entry :: (SimpleRR ())
|
||||||
|
, _current_entry_mx :: (MXRR ())
|
||||||
|
, _current_entry_srv :: (SRVRR ())
|
||||||
|
|
||||||
|
, wsUp :: Boolean
|
||||||
|
, active_modal :: Maybe String
|
||||||
|
}
|
||||||
|
|
||||||
|
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||||
|
component =
|
||||||
|
H.mkComponent
|
||||||
|
{ initialState
|
||||||
|
, render
|
||||||
|
, eval: H.mkEval $ H.defaultEval
|
||||||
|
{ initialize = Just Initialize
|
||||||
|
, handleAction = handleAction
|
||||||
|
, handleQuery = handleQuery
|
||||||
|
, finalize = Just Finalize
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
-- | Default available domain: netlib.re.
|
||||||
|
|
||||||
|
default_domain :: String
|
||||||
|
default_domain = "netlib.re"
|
||||||
|
|
||||||
|
initialState :: Input -> State
|
||||||
|
initialState _ =
|
||||||
|
{ wsUp: true
|
||||||
|
, active_modal: Nothing
|
||||||
|
|
||||||
|
, _current_domain: "hello.example.com"
|
||||||
|
, _rr: defaultResourceRecords
|
||||||
|
, _mxrr: defaultMXResourceRecords
|
||||||
|
, _srvrr: []
|
||||||
|
, _current_entry: defaultResourceA
|
||||||
|
, _current_entry_mx: defaultResourceMX
|
||||||
|
, _current_entry_srv: defaultResourceSRV
|
||||||
|
}
|
||||||
|
|
||||||
|
render :: forall m. State -> H.ComponentHTML Action () m
|
||||||
|
render state
|
||||||
|
= Bulma.section_small
|
||||||
|
[ case state.wsUp, state.active_modal of
|
||||||
|
false, _ -> Bulma.p "You are disconnected."
|
||||||
|
true, Just domain -> modal_rr_delete domain
|
||||||
|
true, Nothing -> HH.div_ [ nav_bar state._current_domain
|
||||||
|
, render_records sorted
|
||||||
|
, render_mx_records state._mxrr
|
||||||
|
, render_srv_records state._srvrr
|
||||||
|
, render_new_records state
|
||||||
|
]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
sorted = foldl (<>) []
|
||||||
|
$ map (sortBy (comparing (_.domain)))
|
||||||
|
$ map toArray
|
||||||
|
$ groupAllBy (comparing (_.t)) state._rr
|
||||||
|
|
||||||
|
modal_rr_delete :: forall w. String -> HH.HTML w Action
|
||||||
|
modal_rr_delete domain =
|
||||||
|
modal
|
||||||
|
[ modal_background
|
||||||
|
, modal_card [modal_header, modal_body]
|
||||||
|
, modal_foot [modal_delete_button, modal_cancel_button]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
modal = HH.div [HP.classes (C.modal <> C.is_active)]
|
||||||
|
modal_background = HH.div [HP.classes C.modal_background] []
|
||||||
|
modal_card = HH.div [HP.classes C.modal_card]
|
||||||
|
modal_header = HH.header [HP.classes C.modal_card_head]
|
||||||
|
[ HH.p [HP.classes C.modal_card_title] [HH.text "Deleting a resource record"]
|
||||||
|
]
|
||||||
|
modal_body = HH.section [HP.classes C.modal_card_body] [ warning_message ]
|
||||||
|
modal_foot = HH.div [HP.classes C.modal_card_foot]
|
||||||
|
modal_delete_button
|
||||||
|
= HH.button [ HP.classes (C.button <> C.is_success)
|
||||||
|
-- TODO: , HE.onClick \_ -> RemoveRR domain
|
||||||
|
] [HH.text "Delete the resource record."]
|
||||||
|
modal_cancel_button
|
||||||
|
= HH.button [ HP.classes C.button
|
||||||
|
, HE.onClick \_ -> CancelModal
|
||||||
|
] [HH.text "Cancel"]
|
||||||
|
warning_message
|
||||||
|
= HH.p [] [ HH.text $ "You are about to delete a resource record, this actions is "
|
||||||
|
, HH.strong_ [ HH.text "irreversible" ]
|
||||||
|
, HH.text "."
|
||||||
|
]
|
||||||
|
|
||||||
|
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
|
||||||
|
handleAction = case _ of
|
||||||
|
CancelModal -> do
|
||||||
|
H.modify_ _ { active_modal = Nothing }
|
||||||
|
|
||||||
|
-- IMPORTED
|
||||||
|
Initialize -> do
|
||||||
|
H.raise $ Log $ SimpleLog "Initialized"
|
||||||
|
|
||||||
|
Finalize -> do
|
||||||
|
state <- H.get
|
||||||
|
H.raise $ Log $ SimpleLog "Finalized!"
|
||||||
|
|
||||||
|
DoNothing _ -> do
|
||||||
|
H.raise $ Log $ SimpleLog "This action does nothing (at least for now)"
|
||||||
|
|
||||||
|
UpdateNewType val -> do
|
||||||
|
let new_type = fromMaybe "unknown" (baseRecords !! val)
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry = changeType state._current_entry (baseRecords !! val) }
|
||||||
|
-- TODO: FIXME: test all inputs
|
||||||
|
|
||||||
|
UpdateNewTTLSimple val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry = state._current_entry { ttl = val, valid = isInteger val } }
|
||||||
|
-- TODO: FIXME: test all inputs
|
||||||
|
UpdateNewTTLMX val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
|
||||||
|
UpdateNewTTLSRV val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}}
|
||||||
|
|
||||||
|
UpdateNewDomainSimple val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry = state._current_entry { domain = val } }
|
||||||
|
-- TODO: FIXME: test all inputs
|
||||||
|
UpdateNewDomainMX val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_mx = state._current_entry_mx { domain = val } }
|
||||||
|
UpdateNewDomainSRV val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_srv = state._current_entry_srv { domain = val } }
|
||||||
|
|
||||||
|
UpdateNewEntryValue val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new entry value: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry = state._current_entry { value = val } }
|
||||||
|
-- TODO: FIXME: test all inputs
|
||||||
|
UpdateNewMXValue val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_mx = state._current_entry_mx { value = val } }
|
||||||
|
UpdateNewSRVValue val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_srv = state._current_entry_srv { value = val } }
|
||||||
|
|
||||||
|
UpdateNewMXPriority val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_mx = state._current_entry_mx { priority = val } }
|
||||||
|
UpdateNewSRVPriority val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_srv = state._current_entry_srv { priority = val } }
|
||||||
|
|
||||||
|
UpdateNewSRVWeight val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_srv = state._current_entry_srv { weight = val } }
|
||||||
|
|
||||||
|
UpdateNewSRVPort val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _current_entry_srv = state._current_entry_srv { port = val } }
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- This action only is possible if inputs are correct.
|
||||||
|
AddSimple -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Add simple entry")
|
||||||
|
state <- H.get
|
||||||
|
H.raise $ Log $ SimpleLog ("Add simple entry: " <> show state._current_entry)
|
||||||
|
H.put $ add_new_entry state state._current_entry
|
||||||
|
AddMX -> do
|
||||||
|
state <- H.get
|
||||||
|
H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx)
|
||||||
|
H.put $ add_new_mx state state._current_entry_mx
|
||||||
|
AddSRV -> do
|
||||||
|
state <- H.get
|
||||||
|
H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv)
|
||||||
|
H.put $ add_new_srv state state._current_entry_srv
|
||||||
|
|
||||||
|
|
||||||
|
UpdateLocalValue rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " value: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _rr = (update_value rrid val state._rr) }
|
||||||
|
UpdateLocalValueMX rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update MX RR " <> show rrid <> " value: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _mxrr = (update_value rrid val state._mxrr) }
|
||||||
|
UpdateLocalValueSRV rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update SRV RR " <> show rrid <> " value: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _srvrr = (update_value rrid val state._srvrr) }
|
||||||
|
|
||||||
|
UpdateLocalTTL rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " TTL: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _rr = (update_ttl rrid val state._rr) }
|
||||||
|
UpdateLocalTTLMX rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update MX RR " <> show rrid <> " TTL: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _mxrr = (update_ttl rrid val state._mxrr) }
|
||||||
|
UpdateLocalTTLSRV rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update SRV RR " <> show rrid <> " TTL: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _srvrr = (update_ttl rrid val state._srvrr) }
|
||||||
|
|
||||||
|
UpdateLocalPriorityMX rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update MX RR " <> show rrid <> " priority: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _mxrr = (update_priority rrid val state._mxrr) }
|
||||||
|
UpdateLocalPrioritySRV rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update SRV RR " <> show rrid <> " priority: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _srvrr = (update_priority rrid val state._srvrr) }
|
||||||
|
|
||||||
|
UpdateLocalWeight rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " weight: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _srvrr = (update_weight rrid val state._srvrr) }
|
||||||
|
|
||||||
|
UpdateLocalPort rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " port: " <> val)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _srvrr = (update_port rrid val state._srvrr) }
|
||||||
|
|
||||||
|
|
||||||
|
DeleteSimple rrid -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Delete SimpleRR: " <> show rrid)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _rr = filter (\rr -> rr.id /= rrid) state._rr }
|
||||||
|
H.raise $ Log $ SimpleLog ("TODO: remove from server")
|
||||||
|
DeleteMX rrid -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Delete MX: " <> show rrid)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _mxrr = filter (\rr -> rr.id /= rrid) state._mxrr }
|
||||||
|
H.raise $ Log $ SimpleLog ("TODO: remove from server")
|
||||||
|
DeleteSRV rrid -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Delete SRV: " <> show rrid)
|
||||||
|
state <- H.get
|
||||||
|
H.put $ state { _srvrr = filter (\rr -> rr.id /= rrid) state._srvrr }
|
||||||
|
H.raise $ Log $ SimpleLog ("TODO: remove from server")
|
||||||
|
|
||||||
|
|
||||||
|
-- TODO: network operations
|
||||||
|
UpdateOnServer rrid -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("TODO: UpdateOnServer: " <> show rrid)
|
||||||
|
|
||||||
|
-- TODO: change the state to indicate problems?
|
||||||
|
TellSomethingWentWrong rrid val -> do
|
||||||
|
H.raise $ Log $ SimpleLog ("Sorry, your record " <> show rrid <> " has problems: ")
|
||||||
|
-- H.raise $ Log $ SimpleLog (show rr)
|
||||||
|
H.raise $ Log $ SimpleLog (" => " <> val)
|
||||||
|
|
||||||
|
DeleteRRModal domain -> do
|
||||||
|
H.modify_ _ { active_modal = Just domain }
|
||||||
|
|
||||||
|
-- HandleNewDomainInput adduserinp -> do
|
||||||
|
-- case adduserinp of
|
||||||
|
-- INP_newdomain v -> H.modify_ _ { newDomainForm { new_domain = v } }
|
||||||
|
-- UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
|
||||||
|
--
|
||||||
|
-- EnterDomain domain -> do
|
||||||
|
-- H.raise $ Log $ SimpleLog $ "[???] trying to enter domain: " <> domain
|
||||||
|
--
|
||||||
|
-- RemoveRR domain -> do
|
||||||
|
-- message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
|
||||||
|
-- H.raise $ MessageToSend message
|
||||||
|
-- H.raise $ Log $ SimpleLog $ "[😇] Removing domain: " <> domain
|
||||||
|
-- H.modify_ _ { active_modal = Nothing }
|
||||||
|
--
|
||||||
|
-- NewDomainAttempt ev -> do
|
||||||
|
-- H.liftEffect $ Event.preventDefault ev
|
||||||
|
--
|
||||||
|
-- { newDomainForm } <- H.get
|
||||||
|
-- let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain
|
||||||
|
--
|
||||||
|
-- case new_domain of
|
||||||
|
-- "" ->
|
||||||
|
-- H.raise $ Log $ UnableToSend "You didn't enter the new domain!"
|
||||||
|
-- _ -> do
|
||||||
|
-- message <- H.liftEffect
|
||||||
|
-- $ DNSManager.serialize
|
||||||
|
-- $ DNSManager.MkNewDomain { domain: new_domain }
|
||||||
|
-- H.raise $ MessageToSend message
|
||||||
|
-- H.raise $ Log $ SimpleLog $ "[😇] Trying to add a new domain (" <> new_domain <> ")"
|
||||||
|
-- handleAction $ HandleNewDomainInput $ INP_newdomain ""
|
||||||
|
|
||||||
|
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
||||||
|
handleQuery = case _ of
|
||||||
|
|
||||||
|
MessageReceived message a -> do
|
||||||
|
receivedMessage <- H.liftEffect $ DNSManager.deserialize message
|
||||||
|
case receivedMessage of
|
||||||
|
-- Cases where we didn't understand the message.
|
||||||
|
Left _ -> do
|
||||||
|
pure Nothing
|
||||||
|
|
||||||
|
-- Cases where we understood the message.
|
||||||
|
Right received_msg -> do
|
||||||
|
case received_msg of
|
||||||
|
-- The authentication failed.
|
||||||
|
(DNSManager.MkError errmsg) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[😈] Failed, reason is: " <> errmsg.reason
|
||||||
|
(DNSManager.MkErrorUserNotLogged _) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[😈] Failed! The user isn't connected!"
|
||||||
|
H.raise $ Log $ SimpleLog $ "[🤖] Trying to authenticate to fix the problem..."
|
||||||
|
H.raise $ DNSManagerReconnect
|
||||||
|
(DNSManager.MkErrorInvalidToken _) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] Failed connection! Invalid token!"
|
||||||
|
(DNSManager.MkDomainAlreadyExists _) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain already exists."
|
||||||
|
(DNSManager.MkUnacceptableDomain _) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)."
|
||||||
|
|
||||||
|
(DNSManager.MkAcceptedDomains response) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!"
|
||||||
|
-- handleAction $ UpdateAcceptedDomains response.domains
|
||||||
|
|
||||||
|
(DNSManager.MkLogged response) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
|
||||||
|
-- handleAction $ UpdateAcceptedDomains response.accepted_domains
|
||||||
|
-- handleAction $ UpdateMyDomains response.my_domains
|
||||||
|
|
||||||
|
(DNSManager.MkDomainAdded response) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] Domain added: " <> response.domain
|
||||||
|
-- handleAction $ UpdateMyDomains (my_domains <> [response.domain])
|
||||||
|
|
||||||
|
(DNSManager.MkInvalidDomainName _) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[😈] Failed! The domain is not valid!"
|
||||||
|
|
||||||
|
(DNSManager.MkDomainDeleted response) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[TODO] The domain '" <> response.domain <> "' has been deleted!"
|
||||||
|
-- handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
|
||||||
|
|
||||||
|
(DNSManager.MkSuccess _) -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[🎉] Success!"
|
||||||
|
-- WTH?!
|
||||||
|
_ -> do
|
||||||
|
H.raise $ Log $ SimpleLog $ "[😈] Failed! Authentication server didn't send a valid message."
|
||||||
|
pure (Just a)
|
||||||
|
|
||||||
|
ConnectionIsDown a -> do
|
||||||
|
H.modify_ _ { wsUp = false }
|
||||||
|
pure (Just a)
|
||||||
|
|
||||||
|
ConnectionIsUp a -> do
|
||||||
|
H.modify_ _ { wsUp = true }
|
||||||
|
pure (Just a)
|
||||||
|
|
||||||
|
-- Rendering
|
||||||
|
class_title_size :: Array (HH.ClassName)
|
||||||
|
class_title_size = [HH.ClassName "is-4"]
|
||||||
|
|
||||||
|
render_records :: forall (w :: Type). Array (SimpleRR ()) -> HH.HTML w Action
|
||||||
|
render_records []
|
||||||
|
= S.columns [] [ left_block, right_block ]
|
||||||
|
where left_block = S.column class_title_size
|
||||||
|
[ S.h1 "NS, A, AAAA, CNAME"
|
||||||
|
, S.subtitle "and TXT records" ]
|
||||||
|
right_block = S.column_ [ S.subtitle "No records for now" ]
|
||||||
|
|
||||||
|
render_records records
|
||||||
|
= S.columns [] [ S.column class_title_size [S.h1 title_txt, S.subtitle subtitle_txt ]
|
||||||
|
, S.column_ [ table_rr ]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
title_txt = "NS, A, AAAA, CNAME"
|
||||||
|
subtitle_txt = "and TXT records"
|
||||||
|
-- subtitle_txt = "Each line is a resource record from your DNS zone."
|
||||||
|
-- <> " You can edit them, then click on the \"fix\" button to synchronize with the server."
|
||||||
|
table_rr = HH.table [] [ S.simple_table_header, table_content ]
|
||||||
|
table_content = HH.tbody_ $ map row records
|
||||||
|
|
||||||
|
row rr = HH.tr_ $
|
||||||
|
[ S.txt_name rr.t
|
||||||
|
, HH.td_ [ S.input_domain DoNothing rr.domain rr.valid ]
|
||||||
|
, HH.td_ [ S.input_ttl (UpdateLocalTTL rr.id) rr.ttl rr.valid ]
|
||||||
|
, HH.td_ [ S.input_value (UpdateLocalValue rr.id) rr.value rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_change (UpdateOnServer rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_delete (\_ -> DeleteSimple rr.id) ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
render_mx_records :: forall (w :: Type) (l :: Row Type)
|
||||||
|
. Array (MXRR l) -> HH.HTML w Action
|
||||||
|
render_mx_records []
|
||||||
|
= S.columns [] [ left_block, right_block ]
|
||||||
|
where left_block = S.column class_title_size [ S.h1 "MX records" ]
|
||||||
|
right_block = S.column_ [ S.subtitle "No records for now" ]
|
||||||
|
render_mx_records records
|
||||||
|
= S.columns [] [ S.column class_title_size [ S.h1 title_txt ]
|
||||||
|
, S.column_ [ table_rr ]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
title_txt = "MX records"
|
||||||
|
table_rr = HH.table [] [ S.mx_table_header, table_content ]
|
||||||
|
table_content = HH.tbody_ $ map row records
|
||||||
|
|
||||||
|
row rr = HH.tr_ $
|
||||||
|
[ HH.td_ [ S.input_domain DoNothing rr.domain rr.valid ]
|
||||||
|
, HH.td_ [ S.input_ttl (UpdateLocalTTLMX rr.id) rr.ttl rr.valid ]
|
||||||
|
, HH.td_ [ S.input_value (UpdateLocalValueMX rr.id) rr.value rr.valid ]
|
||||||
|
, HH.td_ [ S.input_priority (UpdateLocalPriorityMX rr.id) rr.priority rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_change (UpdateOnServer rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_delete (\_ -> DeleteMX rr.id) ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
render_srv_records :: forall (w :: Type) (l :: Row Type)
|
||||||
|
. Array (SRVRR l) -> HH.HTML w Action
|
||||||
|
render_srv_records []
|
||||||
|
= S.columns [] [ left_block, right_block ]
|
||||||
|
where left_block = S.column class_title_size [ S.h1 "SRV records" ]
|
||||||
|
right_block = S.column_ [ S.subtitle "No records for now" ]
|
||||||
|
render_srv_records records
|
||||||
|
= S.columns [] [ S.column class_title_size [ S.h1 title_txt]
|
||||||
|
, S.column_ [ table_rr ] ]
|
||||||
|
where
|
||||||
|
title_txt = "SRV records"
|
||||||
|
table_rr = HH.table [] [ S.srv_table_header, table_content ]
|
||||||
|
table_content = HH.tbody_ $ map row records
|
||||||
|
|
||||||
|
row rr = HH.tr_ $
|
||||||
|
[ HH.td_ [ S.input_domain DoNothing rr.domain rr.valid ]
|
||||||
|
, HH.td_ [ S.input_ttl (UpdateLocalTTLSRV rr.id) rr.ttl rr.valid ]
|
||||||
|
, HH.td_ [ S.input_priority (UpdateLocalPrioritySRV rr.id) rr.priority rr.valid ]
|
||||||
|
, HH.td_ [ S.input_weight (UpdateLocalWeight rr.id) rr.weight rr.valid ]
|
||||||
|
, HH.td_ [ S.input_port (UpdateLocalPort rr.id) rr.port rr.valid ]
|
||||||
|
, HH.td_ [ S.input_value (UpdateLocalValueSRV rr.id) rr.value rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_change (UpdateOnServer rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_delete (\_ -> DeleteSRV rr.id) ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
baseRecords :: Array String
|
||||||
|
baseRecords = [ "NS", "A", "AAAA", "CNAME", "TXT" ]
|
||||||
|
|
||||||
|
render_new_record :: forall (w :: Type). (SimpleRR ()) -> HH.HTML w Action
|
||||||
|
render_new_record rr
|
||||||
|
= S.hdiv [ S.h3 "New record (NS, A, AAAA, CNAME, TXT)", table ]
|
||||||
|
|
||||||
|
where
|
||||||
|
table = HH.table [] [ S.simple_table_header, render_record_builder ]
|
||||||
|
|
||||||
|
-- render_record_builder :: forall w. HH.HTML w Action
|
||||||
|
render_record_builder
|
||||||
|
= HH.tr_
|
||||||
|
[ HH.td_ [ type_selection ]
|
||||||
|
, HH.td_ [ S.input_domain UpdateNewDomainSimple rr.domain rr.valid ]
|
||||||
|
, HH.td_ [ S.input_ttl UpdateNewTTLSimple rr.ttl rr.valid ]
|
||||||
|
, HH.td_ [ S.input_value UpdateNewEntryValue rr.value rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_add AddSimple (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
|
||||||
|
]
|
||||||
|
|
||||||
|
-- type_selection :: forall w i. HH.HTML w i
|
||||||
|
type_selection = HH.select
|
||||||
|
[ HE.onSelectedIndexChange UpdateNewType ]
|
||||||
|
$ map type_option baseRecords
|
||||||
|
type_option n
|
||||||
|
= HH.option
|
||||||
|
[ HP.value n
|
||||||
|
, HP.selected (n == rr.t)
|
||||||
|
] [ HH.text n ]
|
||||||
|
|
||||||
|
|
||||||
|
render_mx_new_record :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action
|
||||||
|
render_mx_new_record rr
|
||||||
|
= S.hdiv [ S.h3 "New MX record", table ]
|
||||||
|
|
||||||
|
where
|
||||||
|
table = HH.table [] [ S.mx_table_header, render_record_builder ]
|
||||||
|
|
||||||
|
-- render_record_builder :: forall w. HH.HTML w Action
|
||||||
|
render_record_builder
|
||||||
|
= HH.tr_
|
||||||
|
[ HH.td_ [ S.input_domain UpdateNewDomainMX rr.domain rr.valid ]
|
||||||
|
, HH.td_ [ S.input_ttl UpdateNewTTLMX rr.ttl rr.valid ]
|
||||||
|
, HH.td_ [ S.input_priority UpdateNewMXPriority rr.priority rr.valid ]
|
||||||
|
, HH.td_ [ S.input_value UpdateNewMXValue rr.value rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
render_srv_new_record :: forall (w :: Type). (SRVRR ()) -> HH.HTML w Action
|
||||||
|
render_srv_new_record rr
|
||||||
|
= S.hdiv [ S.h3 "New SRV record", table ]
|
||||||
|
where
|
||||||
|
table = HH.table [] [ S.srv_table_header, render_record_builder ]
|
||||||
|
|
||||||
|
-- render_record_builder :: forall w. HH.HTML w Action
|
||||||
|
render_record_builder
|
||||||
|
= HH.tr_
|
||||||
|
[ HH.td_ [ S.input_domain UpdateNewDomainSRV rr.domain rr.valid ]
|
||||||
|
, HH.td_ [ S.input_ttl UpdateNewTTLSRV rr.ttl rr.valid ]
|
||||||
|
, HH.td_ [ S.input_priority UpdateNewSRVPriority rr.priority rr.valid ]
|
||||||
|
, HH.td_ [ S.input_weight UpdateNewSRVWeight rr.weight rr.valid ]
|
||||||
|
, HH.td_ [ S.input_port UpdateNewSRVPort rr.port rr.valid ]
|
||||||
|
, HH.td_ [ S.input_value UpdateNewSRVValue rr.value rr.valid ]
|
||||||
|
, HH.td_ [ S.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
-- Component definition and initial state
|
||||||
|
|
||||||
|
render_new_records :: forall (w :: Type). State -> HH.HTML w Action
|
||||||
|
render_new_records state
|
||||||
|
= S.hdiv
|
||||||
|
[ S.h1 "Adding new records"
|
||||||
|
, S.columns []
|
||||||
|
[ 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_new_record_column_simple :: forall (w :: Type).
|
||||||
|
(SimpleRR ()) -> HH.HTML w Action
|
||||||
|
render_new_record_column_simple rr
|
||||||
|
= S.column_ $ [ S.box
|
||||||
|
[ S.h3 "NS, A, AAAA, CNAME, TXT"
|
||||||
|
, type_selection
|
||||||
|
, S.box_input_domain UpdateNewDomainSimple rr.domain rr.valid
|
||||||
|
, S.box_input_ttl UpdateNewTTLSimple rr.ttl rr.valid
|
||||||
|
, S.box_input_value UpdateNewEntryValue rr.value rr.valid
|
||||||
|
, S.btn_add AddSimple (TellSomethingWentWrong rr.id "cannot add") rr.valid
|
||||||
|
]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
-- type_selection :: forall w i. HH.HTML w i
|
||||||
|
type_selection = HH.select
|
||||||
|
[ HE.onSelectedIndexChange UpdateNewType ]
|
||||||
|
$ map type_option baseRecords
|
||||||
|
type_option n
|
||||||
|
= HH.option
|
||||||
|
[ HP.value n
|
||||||
|
, HP.selected (n == rr.t)
|
||||||
|
] [ HH.text n ]
|
||||||
|
|
||||||
|
|
||||||
|
render_new_record_colunm_mx :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action
|
||||||
|
render_new_record_colunm_mx rr
|
||||||
|
= S.column_ $ [ S.box
|
||||||
|
[ S.h3 "MX"
|
||||||
|
, S.box_input_domain UpdateNewDomainMX rr.domain rr.valid
|
||||||
|
, S.box_input_ttl UpdateNewTTLMX rr.ttl rr.valid
|
||||||
|
, S.box_input_priority UpdateNewMXPriority rr.priority rr.valid
|
||||||
|
, S.box_input_value UpdateNewMXValue rr.value rr.valid
|
||||||
|
, S.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
render_new_record_colunm_srv :: forall (w :: Type). (SRVRR ()) -> HH.HTML w Action
|
||||||
|
render_new_record_colunm_srv rr
|
||||||
|
= S.column_ $ [ S.box
|
||||||
|
[ S.h3 "SRV"
|
||||||
|
, S.box_input_domain UpdateNewDomainSRV rr.domain rr.valid
|
||||||
|
, S.box_input_ttl UpdateNewTTLSRV rr.ttl rr.valid
|
||||||
|
, S.box_input_priority UpdateNewSRVPriority rr.priority rr.valid
|
||||||
|
, S.box_input_weight UpdateNewSRVWeight rr.weight rr.valid
|
||||||
|
, S.box_input_port UpdateNewSRVPort rr.port rr.valid
|
||||||
|
, S.box_input_value UpdateNewSRVValue rr.value rr.valid
|
||||||
|
, S.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
classes_nav :: Array (HH.ClassName)
|
||||||
|
classes_nav = class_breadcrumb <> class_centered <> class_succeeds_sep
|
||||||
|
class_succeeds_sep :: Array (HH.ClassName)
|
||||||
|
class_succeeds_sep = [HH.ClassName "has-succeeds-separator" ]
|
||||||
|
class_breadcrumb :: Array (HH.ClassName)
|
||||||
|
class_breadcrumb = [HH.ClassName "breadcrumb"]
|
||||||
|
class_centered :: Array (HH.ClassName)
|
||||||
|
class_centered = [HH.ClassName "is-centered"]
|
||||||
|
|
||||||
|
-- TODO: wrong type
|
||||||
|
--home_icon :: forall r w i. Array (HP.IProp r i) -> HH.HTML w i
|
||||||
|
--home_icon = HH.span
|
||||||
|
-- [HP.classes [HH.ClassName "icon is-small"]]
|
||||||
|
-- [HH.i ([HP.classes [HH.ClassName "fas fa-home"]] <> aria) []]
|
||||||
|
-- where aria = [Aria.hidden "true"]
|
||||||
|
|
||||||
|
aria_current :: forall r i. String -> HP.IProp r i
|
||||||
|
aria_current = HP.attr (AttrName "aria-current")
|
||||||
|
|
||||||
|
nav_bar :: forall w i. String -> HH.HTML w i
|
||||||
|
nav_bar domain
|
||||||
|
= HH.nav
|
||||||
|
[ HP.classes classes_nav
|
||||||
|
, Aria.label "breadcrumbs"
|
||||||
|
] [ HH.ul_
|
||||||
|
[ HH.li_ [ HH.a [HP.href "/"] [ HH.text "Home"] ]
|
||||||
|
, HH.li []
|
||||||
|
[ HH.a
|
||||||
|
[HP.href "/", aria_current "page"]
|
||||||
|
[HH.text ("Domain: " <> domain)]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
|
-- ACTIONS
|
||||||
|
|
||||||
|
-- add a new record and get a new placeholter
|
||||||
|
add_new_entry :: State -> (SimpleRR ()) -> State
|
||||||
|
add_new_entry state rr
|
||||||
|
= state { _rr = new_rr_list, _current_entry = new_placeholder }
|
||||||
|
where new_placeholder = defaultResourceA
|
||||||
|
new_rr_list = state._rr <> [ new_rr ]
|
||||||
|
new_rr = rr { id = getNewID state }
|
||||||
|
|
||||||
|
-- add a new record and get a new placeholter
|
||||||
|
add_new_mx :: State -> (MXRR ()) -> State
|
||||||
|
add_new_mx state rr
|
||||||
|
= state { _mxrr = new_rr_list, _current_entry_mx = new_placeholder }
|
||||||
|
where new_placeholder = defaultResourceMX
|
||||||
|
new_rr_list = state._mxrr <> [ new_rr ]
|
||||||
|
new_rr = rr { id = getNewID state }
|
||||||
|
|
||||||
|
-- add a new record and get a new placeholter
|
||||||
|
add_new_srv :: State -> (SRVRR ()) -> State
|
||||||
|
add_new_srv state rr
|
||||||
|
= state { _srvrr = new_rr_list, _current_entry_srv = new_placeholder }
|
||||||
|
where new_placeholder = defaultResourceSRV
|
||||||
|
new_rr_list = state._srvrr <> [ new_rr ]
|
||||||
|
new_rr = rr { id = getNewID state }
|
||||||
|
|
||||||
|
changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l)
|
||||||
|
changeType rr Nothing = rr
|
||||||
|
changeType rr (Just s) = rr { t = s }
|
||||||
|
|
||||||
|
update_value :: forall (l :: Row Type).
|
||||||
|
Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
|
||||||
|
update_value rrid val
|
||||||
|
= update (\rr -> rr { modified = true, value = val }) rrid
|
||||||
|
|
||||||
|
update_ttl :: forall (l :: Row Type).
|
||||||
|
Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
|
||||||
|
update_ttl rrid val
|
||||||
|
= update (\rr -> rr { modified = true, ttl = val, valid = isInteger val }) rrid
|
||||||
|
|
||||||
|
update_priority :: forall (l :: Row Type). Int -> Priority -> Array (MXRR l) -> Array (MXRR l)
|
||||||
|
update_priority rrid val = update (\rr -> rr { modified = true, priority = val}) rrid
|
||||||
|
|
||||||
|
update_weight :: forall (l :: Row Type). Int -> Priority -> Array (SRVRR l) -> Array (SRVRR l)
|
||||||
|
update_weight rrid val = update (\rr -> rr { modified = true, weight = val}) rrid
|
||||||
|
|
||||||
|
update_port :: Int -> Priority -> Array (SRVRR ()) -> Array (SRVRR ())
|
||||||
|
update_port rrid val = update (\rr -> rr { modified = true, port = val}) rrid
|
||||||
|
|
||||||
|
|
||||||
|
isIntRegex :: Regex
|
||||||
|
isIntRegex = unsafeRegex "^[0-9]*$" noFlags
|
||||||
|
|
||||||
|
isInteger :: String -> Boolean
|
||||||
|
isInteger = test isIntRegex
|
||||||
|
|
||||||
|
update :: forall (l :: Row Type).
|
||||||
|
(SimpleRR l -> SimpleRR l) -> Int -> Array (SimpleRR l) -> Array (SimpleRR l)
|
||||||
|
update f rrid records = map doSmth records
|
||||||
|
where
|
||||||
|
doSmth rr
|
||||||
|
| rrid == rr.id = f rr
|
||||||
|
| otherwise = rr
|
||||||
|
|
||||||
|
|
||||||
|
getNewID :: State -> Int
|
||||||
|
getNewID state = (_ + 1) $ foldl max 0 [ maxIDrr
|
||||||
|
, maxIDmxrr
|
||||||
|
, maxIDsrvrr
|
||||||
|
]
|
||||||
|
|
||||||
|
where
|
||||||
|
maxIDrr = foldl max 0 $ map _.id state._rr
|
||||||
|
maxIDmxrr = foldl max 0 $ map _.id state._mxrr
|
||||||
|
maxIDsrvrr = foldl max 0 $ map _.id state._srvrr
|
||||||
|
|
||||||
Loading…
Reference in New Issue
Block a user