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

Further cleaning of the ZoneInterface module.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-10 20:33:28 +02:00
parent 252fbac269
commit 2f7ac68e2c
1 changed files with 38 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

99
src/App/ZoneInterface.purs
View File

@ -8,53 +8,33 @@
module App.ZoneInterface where module App.ZoneInterface where
import Prelude import Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show, ($), (+), (/=), (<<<), (<>), (==))
import CSSClasses as CSSClasses
import Data.Array as A import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer) import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe) import Data.Foldable as Foldable
import Data.String.Utils (endsWith) import Data.Maybe (Maybe(..), fromMaybe)
import Data.String.Regex as Regex
import Data.String.Regex.Flags as RegexFlags
import Data.String.Regex.Unsafe as RegexUnsafe
import Effect.Aff.Class (class MonadAff) import Effect.Aff.Class (class MonadAff)
import Halogen as H import Halogen as H
import Halogen.HTML as HH import Halogen.HTML as HH
import Halogen.HTML.Events as HE import Halogen.HTML.Events as HE
import Halogen.HTML.Events as HHE
import Halogen.HTML.Properties as HP import Halogen.HTML.Properties as HP
import Web.Event.Event as Event --import Web.Event.Event as Event
import Web.Event.Event (Event) --import Web.Event.Event (Event)
import Bulma as Bulma import Bulma as Bulma
import CSSClasses as C import CSSClasses as C
import App.RR import App.RR
import App.LogMessage import App.LogMessage (LogMessage(..))
import App.Messages.DNSManagerDaemon as DNSManager 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(..))
-- | `App.ZoneInterface` can send messages through websocket interface -- | `App.ZoneInterface` can send messages through websocket interface
-- | connected to dnsmanagerd. See `App.WS`. -- | connected to dnsmanagerd. See `App.WS`.
-- | -- |
@ -202,10 +182,10 @@ render state
] ]
] ]
where where
sorted = foldl (<>) [] sorted = Foldable.foldl (<>) []
$ map (sortBy (comparing (_.domain))) $ map (A.sortBy (comparing (_.domain)))
$ map toArray $ map NonEmpty.toArray
$ groupAllBy (comparing (_.t)) state._srr $ A.groupAllBy (comparing (_.t)) state._srr
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 =
@ -252,26 +232,22 @@ handleAction = case _ of
H.raise $ MessageToSend message H.raise $ MessageToSend message
Finalize -> do Finalize -> do
state <- H.get
H.raise $ Log $ SimpleLog "Finalized!" H.raise $ Log $ SimpleLog "Finalized!"
UpdateNewSRRForm rr_update -> case rr_update of UpdateNewSRRForm rr_update -> case rr_update of
Update_SRR_Type val -> do Update_SRR_Type val -> do
let new_type = fromMaybe "unknown" (baseRecords !! val) let new_type = fromMaybe "unknown" (baseRecords A.!! val)
H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type) H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
state <- H.get state <- H.get
H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords !! 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 domain: " <> val)
state <- H.get
H.modify_ _ { _current_entry { domain = val } } H.modify_ _ { _current_entry { domain = 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)
state <- H.get
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_Value val -> do
H.raise $ Log $ SimpleLog ("Update new entry value: " <> val) H.raise $ Log $ SimpleLog ("Update new entry value: " <> val)
state <- H.get
H.modify_ _ { _current_entry { value = val } } H.modify_ _ { _current_entry { value = val } }
UpdateNewMXForm rr_update -> case rr_update of UpdateNewMXForm rr_update -> case rr_update of
@ -340,10 +316,10 @@ handleAction = case _ of
UpdateLocalSRRForm rr_id rr_update -> case rr_update of UpdateLocalSRRForm rr_id rr_update -> case rr_update of
Update_SRR_Type val -> do Update_SRR_Type val -> do
let new_type = fromMaybe "unknown" (baseRecords !! val) let new_type = fromMaybe "unknown" (baseRecords A.!! val)
H.raise $ Log $ SimpleLog ("TODO: Update local RR " <> show rr_id <> " type: " <> new_type) H.raise $ Log $ SimpleLog ("TODO: Update local RR " <> show rr_id <> " type: " <> new_type)
-- state <- H.get -- state <- H.get
-- H.modify_ _ { _srr = changeType state._current_entry (baseRecords !! 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 <> " domain: " <> val)
state <- H.get state <- H.get
@ -420,17 +396,17 @@ handleAction = case _ of
DeleteSimple rr_id -> do DeleteSimple rr_id -> do
H.raise $ Log $ SimpleLog ("Delete SimpleRR: " <> show rr_id) H.raise $ Log $ SimpleLog ("Delete SimpleRR: " <> show rr_id)
state <- H.get state <- H.get
H.modify_ _ { _srr = filter (\rr -> rr.id /= rr_id) state._srr } H.modify_ _ { _srr = A.filter (\rr -> rr.id /= rr_id) state._srr }
H.raise $ Log $ SimpleLog ("TODO: remove from server") H.raise $ Log $ SimpleLog ("TODO: remove from server")
DeleteMX rr_id -> do DeleteMX rr_id -> do
H.raise $ Log $ SimpleLog ("Delete MX: " <> show rr_id) H.raise $ Log $ SimpleLog ("Delete MX: " <> show rr_id)
state <- H.get state <- H.get
H.modify_ _ { _mxrr = filter (\rr -> rr.id /= rr_id) state._mxrr } H.modify_ _ { _mxrr = A.filter (\rr -> rr.id /= rr_id) state._mxrr }
H.raise $ Log $ SimpleLog ("TODO: remove from server") H.raise $ Log $ SimpleLog ("TODO: remove from server")
DeleteSRV rr_id -> do DeleteSRV rr_id -> do
H.raise $ Log $ SimpleLog ("Delete SRV: " <> show rr_id) H.raise $ Log $ SimpleLog ("Delete SRV: " <> show rr_id)
state <- H.get state <- H.get
H.modify_ _ { _srvrr = filter (\rr -> rr.id /= rr_id) state._srvrr } H.modify_ _ { _srvrr = A.filter (\rr -> rr.id /= rr_id) state._srvrr }
H.raise $ Log $ SimpleLog ("TODO: remove from server") H.raise $ Log $ SimpleLog ("TODO: remove from server")
-- TODO: change the state to indicate problems? -- TODO: change the state to indicate problems?
@ -505,11 +481,11 @@ handleQuery = case _ of
(DNSManager.MkUnacceptableDomain _) -> do (DNSManager.MkUnacceptableDomain _) -> do
H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)." H.raise $ Log $ SimpleLog $ "[TODO] Failed! The domain is not acceptable (not in the list of accepted domains)."
(DNSManager.MkAcceptedDomains response) -> do (DNSManager.MkAcceptedDomains _) -> do
H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!" H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!"
-- handleAction $ UpdateAcceptedDomains response.domains -- handleAction $ UpdateAcceptedDomains response.domains
(DNSManager.MkLogged response) -> do (DNSManager.MkLogged _) -> do
H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!" H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
-- handleAction $ UpdateAcceptedDomains response.accepted_domains -- handleAction $ UpdateAcceptedDomains response.accepted_domains
-- handleAction $ UpdateMyDomains response.my_domains -- handleAction $ UpdateMyDomains response.my_domains
@ -527,9 +503,9 @@ handleQuery = case _ of
(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 (id: '" <> show response.rrid <> "') has been deleted!"
state <- H.get state <- H.get
H.modify_ _ { _srr = filter (\rr -> rr.id /= response.rrid) state._srr H.modify_ _ { _srr = A.filter (\rr -> rr.id /= response.rrid) state._srr
, _mxrr = filter (\rr -> rr.id /= response.rrid) state._mxrr , _mxrr = A.filter (\rr -> rr.id /= response.rrid) state._mxrr
, _srvrr = filter (\rr -> rr.id /= response.rrid) state._srvrr , _srvrr = A.filter (\rr -> rr.id /= response.rrid) state._srvrr
} }
(DNSManager.MkZone response) -> do (DNSManager.MkZone response) -> do
@ -837,11 +813,11 @@ update_port :: Int -> Priority -> Array (SRVRR ()) -> Array (SRVRR ())
update_port rr_id val = update (\rr -> rr { modified = true, port = val}) rr_id update_port rr_id val = update (\rr -> rr { modified = true, port = val}) rr_id
isIntRegex :: Regex isIntRegex :: Regex.Regex
isIntRegex = unsafeRegex "^[0-9]*$" noFlags isIntRegex = RegexUnsafe.unsafeRegex "^[0-9]*$" RegexFlags.noFlags
isInteger :: String -> Boolean isInteger :: String -> Boolean
isInteger = test isIntRegex isInteger = Regex.test isIntRegex
update :: forall (l :: Row Type). update :: forall (l :: Row Type).
(SimpleRR l -> SimpleRR l) -> Int -> Array (SimpleRR l) -> Array (SimpleRR l) (SimpleRR l -> SimpleRR l) -> Int -> Array (SimpleRR l) -> Array (SimpleRR l)
@ -853,13 +829,14 @@ update f rr_id records = map doSmth records
getNewID :: State -> Int getNewID :: State -> Int
getNewID state = (_ + 1) $ foldl max 0 [ maxIDrr getNewID state = (_ + 1)
, maxIDmxrr $ Foldable.foldl max 0 [ maxIDrr
, maxIDsrvrr , maxIDmxrr
] , maxIDsrvrr
]
where where
maxIDrr = foldl max 0 $ map _.id state._srr maxIDrr = Foldable.foldl max 0 $ map _.id state._srr
maxIDmxrr = foldl max 0 $ map _.id state._mxrr maxIDmxrr = Foldable.foldl max 0 $ map _.id state._mxrr
maxIDsrvrr = foldl max 0 $ map _.id state._srvrr maxIDsrvrr = Foldable.foldl max 0 $ map _.id state._srvrr