Fully embrace ownership management.
This commit is contained in:
parent
c98de0e4f0
commit
9346e81861
@ -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
|
||||||
})
|
})
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user