Fully embrace ownership management.

This commit is contained in:
Philippe PITTOLI 2024-04-25 23:17:14 +02:00
parent c98de0e4f0
commit 9346e81861
2 changed files with 29 additions and 32 deletions

View File

@ -2,6 +2,8 @@ module App.Message.DNSManagerDaemon where
import Prelude (bind, pure, show, ($)) import Prelude (bind, pure, show, ($))
import App.Type.DomainInfo as DomainInfo
import Effect (Effect) import Effect (Effect)
import Data.Argonaut.Core as J import Data.Argonaut.Core as J
@ -208,10 +210,10 @@ codecAcceptedDomains ∷ CA.JsonCodec AcceptedDomains
codecAcceptedDomains = CA.object "AcceptedDomains" (CAR.record { domains: CA.array CA.string }) codecAcceptedDomains = CA.object "AcceptedDomains" (CAR.record { domains: CA.array CA.string })
{- 16 -} {- 16 -}
type Logged = { accepted_domains :: Array String, my_domains :: Array String, admin :: Boolean } type Logged = { accepted_domains :: Array String, my_domains :: Array DomainInfo.DomainInfo, admin :: Boolean }
codecLogged ∷ CA.JsonCodec Logged codecLogged ∷ CA.JsonCodec Logged
codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string
, my_domains: CA.array CA.string , my_domains: CA.array DomainInfo.codec
, admin: CA.boolean , admin: CA.boolean
}) })

View File

@ -8,7 +8,8 @@
-- | - delete a domain -- | - delete a domain
-- | - ask for confirmation -- | - ask for confirmation
-- | - switch to the interface to show and modify the content of a Zone -- | - switch to the interface to show and modify the content of a Zone
-- | - TODO: validate the domain before sending a message to `dnsmanagerd` -- | - validate the domain before sending a message to `dnsmanagerd`
-- | - manage ownership of a domain: give, share, take back exclusive ownership.
module App.Page.DomainList where module App.Page.DomainList where
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==)) import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==))
@ -91,7 +92,7 @@ data NewDomainFormAction
data Action data Action
= UpdateAcceptedDomains (Array String) = UpdateAcceptedDomains (Array String)
| UpdateMyDomains (Array String) | UpdateMyDomains (Array DomainInfo)
| HandleNewDomainInput NewDomainFormAction | HandleNewDomainInput NewDomainFormAction
| AskDomainTransferUUIDInput String | AskDomainTransferUUIDInput String
@ -133,7 +134,7 @@ type State =
, accepted_domains :: Array String , accepted_domains :: Array String
, my_domains :: Array DomainInfo , my_domains :: Array DomainInfo
, active_modal :: Maybe String , deletion_modal :: Maybe String
} }
component :: forall m. MonadAff m => H.Component Query Input Output m component :: forall m. MonadAff m => H.Component Query Input Output m
@ -154,28 +155,28 @@ component =
default_domain :: String default_domain :: String
default_domain = "netlib.re" default_domain = "netlib.re"
debug_domains :: Array DomainInfo --debug_domains :: Array DomainInfo
debug_domains --debug_domains
= [ emptyDomainInfo { name = "test.example.com" -- = [ emptyDomainInfo { name = "test.example.com"
, share_key = Just "UUID" -- , share_key = Just "UUID"
, owners = ["myself", "you"] } -- , owners = ["myself", "you"] }
, emptyDomainInfo { name = "my-domain.example.com" } -- , emptyDomainInfo { name = "my-domain.example.com" }
, emptyDomainInfo { name = "my-other-domain.example.com" } -- , emptyDomainInfo { name = "my-other-domain.example.com" }
] -- ]
initialState :: Input -> State initialState :: Input -> State
initialState _ = initialState _ =
{ newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain } { newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain }
, askDomainTransferForm: { uuid: "", _errors: [] } , askDomainTransferForm: { uuid: "", _errors: [] }
, accepted_domains: [ default_domain ] , accepted_domains: [ default_domain ]
, my_domains: debug_domains , my_domains: []
, active_modal: Nothing , deletion_modal: Nothing
} }
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, active_modal } render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, deletion_modal }
= Bulma.section_small = Bulma.section_small
[ case active_modal of [ case deletion_modal of
Nothing -> Bulma.columns_ Nothing -> Bulma.columns_
[ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form
, Bulma.hr , Bulma.hr
@ -289,15 +290,13 @@ handleAction = case _ of
H.raise $ StoreState state H.raise $ StoreState state
CancelModal -> do CancelModal -> do
H.modify_ _ { active_modal = Nothing } H.modify_ _ { deletion_modal = Nothing }
UpdateAcceptedDomains domains -> do UpdateAcceptedDomains domains -> do
H.modify_ _ { accepted_domains = domains } H.modify_ _ { accepted_domains = domains }
UpdateMyDomains domains -> do UpdateMyDomains domains -> do
H.raise $ Log $ SystemLog "TODO: update my domains." H.modify_ _ { my_domains = domains }
-- TODO
-- H.modify_ _ { my_domains = domains }
HandleNewDomainInput adduserinp -> do HandleNewDomainInput adduserinp -> do
case adduserinp of case adduserinp of
@ -323,13 +322,13 @@ handleAction = case _ of
H.raise $ Log $ SystemLog $ "TODO: Unshare domain " <> domain H.raise $ Log $ SystemLog $ "TODO: Unshare domain " <> domain
DeleteDomainModal domain -> do DeleteDomainModal domain -> do
H.modify_ _ { active_modal = Just domain } H.modify_ _ { deletion_modal = Just domain }
RemoveDomain domain -> do RemoveDomain domain -> do
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain } message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
H.raise $ MessageToSend message H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "Remove domain: " <> domain H.raise $ Log $ SystemLog $ "Remove domain: " <> domain
H.modify_ _ { active_modal = Nothing } H.modify_ _ { deletion_modal = Nothing }
NewDomainAttempt ev -> do NewDomainAttempt ev -> do
H.liftEffect $ Event.preventDefault ev H.liftEffect $ Event.preventDefault ev
@ -386,14 +385,11 @@ handleQuery = case _ of
handleAction $ UpdateAcceptedDomains response.accepted_domains handleAction $ UpdateAcceptedDomains response.accepted_domains
handleAction $ UpdateMyDomains response.my_domains handleAction $ UpdateMyDomains response.my_domains
(DNSManager.MkDomainAdded response) -> do (DNSManager.MkDomainAdded response) -> do
-- TODO { my_domains } <- H.get
H.raise $ Log $ SystemLog "TODO: domain added: update my domains." handleAction $ UpdateMyDomains (my_domains <> [ emptyDomainInfo { name = response.domain } ])
--{ my_domains } <- H.get
--handleAction $ UpdateMyDomains (my_domains <> [response.domain])
(DNSManager.MkDomainDeleted response) -> do (DNSManager.MkDomainDeleted response) -> do
H.raise $ Log $ SystemLog "TODO: domain deleted: update my domains." { my_domains } <- H.get
--{ my_domains } <- H.get handleAction $ UpdateMyDomains $ A.filter (\d -> d.name /= response.domain) my_domains
--handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface." _ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
pure (Just a) pure (Just a)
@ -402,8 +398,7 @@ page_reload s1 message =
case message of case message of
DNSManager.MkLogged response -> DNSManager.MkLogged response ->
s1 { accepted_domains = response.accepted_domains s1 { accepted_domains = response.accepted_domains
-- TODO , my_domains = A.sort response.my_domains
-- , my_domains = A.sort response.my_domains
} }
_ -> s1 _ -> s1