Further cleaning of the ZoneInterface module.
parent
252fbac269
commit
2f7ac68e2c
|
|
@ -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
|
||||
, maxIDmxrr
|
||||
, maxIDsrvrr
|
||||
]
|
||||
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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue