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

93
src/App/ZoneInterface.purs
View File

@ -8,53 +8,33 @@
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.ArrayBuffer.Types (ArrayBuffer)
import Data.Array.NonEmpty as NonEmpty
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), maybe)
import Data.String.Utils (endsWith)
import Data.Foldable as Foldable
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 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 Web.Event.Event as Event
--import Web.Event.Event (Event)
import Bulma as Bulma
import CSSClasses as C
import App.RR
import App.LogMessage
import App.LogMessage (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(..))
-- | `App.ZoneInterface` can send messages through websocket interface
-- | connected to dnsmanagerd. See `App.WS`.
-- |
@ -202,10 +182,10 @@ render state
]
]
where
sorted = foldl (<>) []
$ map (sortBy (comparing (_.domain)))
$ map toArray
$ groupAllBy (comparing (_.t)) state._srr
sorted = Foldable.foldl (<>) []
$ map (A.sortBy (comparing (_.domain)))
$ map NonEmpty.toArray
$ A.groupAllBy (comparing (_.t)) state._srr
modal_rr_delete :: forall w. Int -> HH.HTML w Action
modal_rr_delete rr_id =
@ -252,26 +232,22 @@ handleAction = case _ of
H.raise $ MessageToSend message
Finalize -> do
state <- H.get
H.raise $ Log $ SimpleLog "Finalized!"
UpdateNewSRRForm rr_update -> case rr_update of
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)
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
H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val)
state <- H.get
H.modify_ _ { _current_entry { domain = val } }
Update_SRR_TTL val -> do
H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
state <- H.get
H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } }
Update_SRR_Value val -> do
H.raise $ Log $ SimpleLog ("Update new entry value: " <> val)
state <- H.get
H.modify_ _ { _current_entry { value = val } }
UpdateNewMXForm rr_update -> case rr_update of
@ -340,10 +316,10 @@ handleAction = case _ of
UpdateLocalSRRForm rr_id rr_update -> case rr_update of
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)
-- 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
H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " domain: " <> val)
state <- H.get
@ -420,17 +396,17 @@ handleAction = case _ of
DeleteSimple rr_id -> do
H.raise $ Log $ SimpleLog ("Delete SimpleRR: " <> show rr_id)
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")
DeleteMX rr_id -> do
H.raise $ Log $ SimpleLog ("Delete MX: " <> show rr_id)
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")
DeleteSRV rr_id -> do
H.raise $ Log $ SimpleLog ("Delete SRV: " <> show rr_id)
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")
-- TODO: change the state to indicate problems?
@ -505,11 +481,11 @@ handleQuery = case _ of
(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
(DNSManager.MkAcceptedDomains _) -> do
H.raise $ Log $ SimpleLog $ "[TODO] Received the list of accepted domains!"
-- handleAction $ UpdateAcceptedDomains response.domains
(DNSManager.MkLogged response) -> do
(DNSManager.MkLogged _) -> do
H.raise $ Log $ SimpleLog $ "[TODO] Authenticated to dnsmanagerd!"
-- handleAction $ UpdateAcceptedDomains response.accepted_domains
-- handleAction $ UpdateMyDomains response.my_domains
@ -527,9 +503,9 @@ handleQuery = case _ of
(DNSManager.MkRRDeleted response) -> do
H.raise $ Log $ SimpleLog $ "[🎉] RR (id: '" <> show response.rrid <> "') has been deleted!"
state <- H.get
H.modify_ _ { _srr = filter (\rr -> rr.id /= response.rrid) state._srr
, _mxrr = filter (\rr -> rr.id /= response.rrid) state._mxrr
, _srvrr = filter (\rr -> rr.id /= response.rrid) state._srvrr
H.modify_ _ { _srr = A.filter (\rr -> rr.id /= response.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.id /= response.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.id /= response.rrid) state._srvrr
}
(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
isIntRegex :: Regex
isIntRegex = unsafeRegex "^[0-9]*$" noFlags
isIntRegex :: Regex.Regex
isIntRegex = RegexUnsafe.unsafeRegex "^[0-9]*$" RegexFlags.noFlags
isInteger :: String -> Boolean
isInteger = test isIntRegex
isInteger = Regex.test isIntRegex
update :: forall (l :: Row Type).
(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 = (_ + 1) $ foldl max 0 [ maxIDrr
getNewID state = (_ + 1)
$ Foldable.foldl max 0 [ maxIDrr
, maxIDmxrr
, maxIDsrvrr
]
where
maxIDrr = foldl max 0 $ map _.id state._srr
maxIDmxrr = foldl max 0 $ map _.id state._mxrr
maxIDsrvrr = foldl max 0 $ map _.id state._srvrr
maxIDrr = Foldable.foldl max 0 $ map _.id state._srr
maxIDmxrr = Foldable.foldl max 0 $ map _.id state._mxrr
maxIDsrvrr = Foldable.foldl max 0 $ map _.id state._srvrr