diff --git a/src/App/Message/DNSManagerDaemon.purs b/src/App/Message/DNSManagerDaemon.purs index f770a21..af7521b 100644 --- a/src/App/Message/DNSManagerDaemon.purs +++ b/src/App/Message/DNSManagerDaemon.purs @@ -2,6 +2,8 @@ module App.Message.DNSManagerDaemon where import Prelude (bind, pure, show, ($)) +import App.Type.DomainInfo as DomainInfo + import Effect (Effect) 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 }) {- 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.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 }) diff --git a/src/App/Page/DomainList.purs b/src/App/Page/DomainList.purs index 68ac10e..35fc0cd 100644 --- a/src/App/Page/DomainList.purs +++ b/src/App/Page/DomainList.purs @@ -8,7 +8,8 @@ -- | - delete a domain -- | - ask for confirmation -- | - 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 import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==)) @@ -91,7 +92,7 @@ data NewDomainFormAction data Action = UpdateAcceptedDomains (Array String) - | UpdateMyDomains (Array String) + | UpdateMyDomains (Array DomainInfo) | HandleNewDomainInput NewDomainFormAction | AskDomainTransferUUIDInput String @@ -133,7 +134,7 @@ type State = , accepted_domains :: Array String , my_domains :: Array DomainInfo - , active_modal :: Maybe String + , deletion_modal :: Maybe String } component :: forall m. MonadAff m => H.Component Query Input Output m @@ -154,28 +155,28 @@ component = default_domain :: String default_domain = "netlib.re" -debug_domains :: Array DomainInfo -debug_domains - = [ emptyDomainInfo { name = "test.example.com" - , share_key = Just "UUID" - , owners = ["myself", "you"] } - , emptyDomainInfo { name = "my-domain.example.com" } - , emptyDomainInfo { name = "my-other-domain.example.com" } - ] +--debug_domains :: Array DomainInfo +--debug_domains +-- = [ emptyDomainInfo { name = "test.example.com" +-- , share_key = Just "UUID" +-- , owners = ["myself", "you"] } +-- , emptyDomainInfo { name = "my-domain.example.com" } +-- , emptyDomainInfo { name = "my-other-domain.example.com" } +-- ] initialState :: Input -> State initialState _ = { newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain } , askDomainTransferForm: { uuid: "", _errors: [] } , accepted_domains: [ default_domain ] - , my_domains: debug_domains - , active_modal: Nothing + , my_domains: [] + , deletion_modal: Nothing } 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 - [ case active_modal of + [ case deletion_modal of Nothing -> Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form , Bulma.hr @@ -289,15 +290,13 @@ handleAction = case _ of H.raise $ StoreState state CancelModal -> do - H.modify_ _ { active_modal = Nothing } + H.modify_ _ { deletion_modal = Nothing } UpdateAcceptedDomains domains -> do H.modify_ _ { accepted_domains = domains } UpdateMyDomains domains -> do - H.raise $ Log $ SystemLog "TODO: update my domains." - -- TODO - -- H.modify_ _ { my_domains = domains } + H.modify_ _ { my_domains = domains } HandleNewDomainInput adduserinp -> do case adduserinp of @@ -323,13 +322,13 @@ handleAction = case _ of H.raise $ Log $ SystemLog $ "TODO: Unshare domain " <> domain DeleteDomainModal domain -> do - H.modify_ _ { active_modal = Just domain } + H.modify_ _ { deletion_modal = Just domain } RemoveDomain domain -> do message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain } H.raise $ MessageToSend message H.raise $ Log $ SystemLog $ "Remove domain: " <> domain - H.modify_ _ { active_modal = Nothing } + H.modify_ _ { deletion_modal = Nothing } NewDomainAttempt ev -> do H.liftEffect $ Event.preventDefault ev @@ -386,14 +385,11 @@ handleQuery = case _ of handleAction $ UpdateAcceptedDomains response.accepted_domains handleAction $ UpdateMyDomains response.my_domains (DNSManager.MkDomainAdded response) -> do - -- TODO - H.raise $ Log $ SystemLog "TODO: domain added: update my domains." - --{ my_domains } <- H.get - --handleAction $ UpdateMyDomains (my_domains <> [response.domain]) + { my_domains } <- H.get + handleAction $ UpdateMyDomains (my_domains <> [ emptyDomainInfo { name = response.domain } ]) (DNSManager.MkDomainDeleted response) -> do - H.raise $ Log $ SystemLog "TODO: domain deleted: update my domains." - --{ my_domains } <- H.get - --handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains + { my_domains } <- H.get + handleAction $ UpdateMyDomains $ A.filter (\d -> d.name /= response.domain) my_domains _ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface." pure (Just a) @@ -402,8 +398,7 @@ page_reload s1 message = case message of DNSManager.MkLogged response -> s1 { accepted_domains = response.accepted_domains - -- TODO - -- , my_domains = A.sort response.my_domains + , my_domains = A.sort response.my_domains } _ -> s1