From 797f2ce248e00e7cc17f0181a2ba546ee599339a Mon Sep 17 00:00:00 2001 From: Philippe PITTOLI Date: Thu, 25 Apr 2024 11:50:56 +0200 Subject: [PATCH] Preliminary work for ownership management. --- src/App/Page/DomainList.purs | 104 ++++++++++++++++++++++++++++------- src/App/Type/DomainInfo.purs | 33 +++++++++++ src/Bulma.purs | 16 ++++++ 3 files changed, 134 insertions(+), 19 deletions(-) create mode 100644 src/App/Type/DomainInfo.purs diff --git a/src/App/Page/DomainList.purs b/src/App/Page/DomainList.purs index 25d817b..dd500d0 100644 --- a/src/App/Page/DomainList.purs +++ b/src/App/Page/DomainList.purs @@ -11,13 +11,13 @@ -- | - TODO: validate the domain before sending a message to `dnsmanagerd` module App.Page.DomainList where -import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>)) +import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==)) import Data.Array as A import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Either (Either(..)) import Data.String (toLower) -import Data.Maybe (Maybe(..), maybe) +import Data.Maybe (Maybe(..), maybe, fromMaybe) import Data.String.Utils (endsWith) import Effect.Aff.Class (class MonadAff) import Halogen as H @@ -32,7 +32,9 @@ import App.DisplayErrors (error_to_paragraph_label) import App.Validation.Label as Validation -import App.Type.LogMessage +import CSSClasses as C +import App.Type.DomainInfo +import App.Type.LogMessage (LogMessage(..)) import App.Message.DNSManagerDaemon as DNSManager -- | `App.DomainListInterface` can send messages through websocket interface @@ -98,6 +100,8 @@ data Action | AskDomainTransferAttempt Event | RemoveDomain String | EnterDomain String + | ShareDomain String + | UnshareDomain String | DeleteDomainModal String | CancelModal @@ -127,7 +131,7 @@ type State = { newDomainForm :: NewDomainFormState , askDomainTransferForm :: AskDomainTransferState , accepted_domains :: Array String - , my_domains :: Array String + , my_domains :: Array DomainInfo , active_modal :: Maybe String } @@ -150,12 +154,21 @@ 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" } + ] + initialState :: Input -> State initialState _ = { newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain } , askDomainTransferForm: { uuid: "", _errors: [] } , accepted_domains: [ default_domain ] - , my_domains: [ ] + , my_domains: debug_domains , active_modal: Nothing } @@ -166,16 +179,41 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, act Nothing -> Bulma.columns_ [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form , Bulma.hr - , Bulma.h3 "Ask for a domain transfer" + , Bulma.h3 "Get the ownership of a domain" , Bulma.simple_quote """ - Someone wants to give you the ownership of a domain. + Someone wants to give you (or share with you) the ownership of a domain. Please enter the UUID of the transfer. """ , render_ask_domain_transfer_form + , Bulma.hr + , Bulma.h3 "Share the ownership of a domain" + , Bulma.simple_quote """ + Ask for a "share token" for your domain and give it to other users. + All the owners be able to make modifications to the domain. + """ + , Bulma.hr + , Bulma.h3 "Transfer the ownership of a domain" + , Bulma.simple_quote """ + Ask for a transfer token for your domain and give it to the new owner. + """ ] , Bulma.column_ [ Bulma.h3 "My domains" - , if A.length my_domains > 0 - then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_domains + , Bulma.simple_quote "You are the exclusive owner of the following domains." + , if A.length domains_i_exclusively_own > 0 + then Bulma.table [] [ Bulma.table_header_owned_domains + , HH.tbody_ $ map owned_domain_row domains_i_exclusively_own + ] + else Bulma.p "No domain yet." + , Bulma.hr + , Bulma.h3 "Shared domains" + , Bulma.simple_quote """ + The following domains are shared with other users. + In case you are the last owner, you can "unshare" it and gain exclusive ownership. + """ + , if A.length domains_i_share > 0 + then Bulma.table [] [ Bulma.table_header_shared_domains + , HH.tbody_ $ map shared_domain_row domains_i_share + ] else Bulma.p "No domain yet." ] ] @@ -185,6 +223,12 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, act where modal_delete_button domain = Bulma.alert_btn "Delete the domain" (RemoveDomain domain) modal_cancel_button = Bulma.cancel_button CancelModal + + -- I own all domain without a "share key". + domains_i_exclusively_own = A.sort $ A.filter (\domain -> domain.share_key == Nothing) my_domains + -- Shared domains are all domains with a share_key. + domains_i_share = A.sort $ A.filter (\domain -> domain.share_key /= Nothing) my_domains + warning_message domain = HH.p [] [ HH.text $ "You are about to delete your domain \"" <> domain @@ -193,10 +237,20 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, act , HH.text "." ] - domain_buttons domain - = [ Bulma.alert_btn "delete" (DeleteDomainModal domain) - , Bulma.btn domain (EnterDomain domain) - ] + shared_domain_row domain = HH.tr_ + [ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ] + , HH.td_ [ HH.text $ fromMaybe "" domain.share_key ] + , if A.length domain.owners == 1 + then Bulma.alert_btn "Unshare" (UnshareDomain domain.name) + else Bulma.btn_ro (C.is_warning) "Cannot unshare it" + ] + + owned_domain_row domain = HH.tr_ + [ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ] + , HH.td_ [ Bulma.btn_ro (C.is_warning) "Share" ] + -- , Bulma.btn "Share" (ShareDomain domain.name) + , Bulma.alert_btn "Delete" (DeleteDomainModal domain.name) + ] render_add_domain_form = HH.form [ HE.onSubmit NewDomainAttempt ] @@ -242,7 +296,9 @@ handleAction = case _ of H.modify_ _ { accepted_domains = domains } UpdateMyDomains domains -> do - H.modify_ _ { my_domains = domains } + H.raise $ Log $ SystemLog "TODO: update my domains." + -- TODO + -- H.modify_ _ { my_domains = domains } HandleNewDomainInput adduserinp -> do case adduserinp of @@ -261,6 +317,12 @@ handleAction = case _ of EnterDomain domain -> do H.raise $ ChangePageZoneInterface domain + ShareDomain domain -> do + H.raise $ Log $ SystemLog $ "TODO: Share domain " <> domain + + UnshareDomain domain -> do + H.raise $ Log $ SystemLog $ "TODO: Unshare domain " <> domain + DeleteDomainModal domain -> do H.modify_ _ { active_modal = Just domain } @@ -325,11 +387,14 @@ handleQuery = case _ of handleAction $ UpdateAcceptedDomains response.accepted_domains handleAction $ UpdateMyDomains response.my_domains (DNSManager.MkDomainAdded response) -> do - { my_domains } <- H.get - handleAction $ UpdateMyDomains (my_domains <> [response.domain]) + -- TODO + H.raise $ Log $ SystemLog "TODO: domain added: update my domains." + --{ my_domains } <- H.get + --handleAction $ UpdateMyDomains (my_domains <> [response.domain]) (DNSManager.MkDomainDeleted response) -> do - { my_domains } <- H.get - handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains + H.raise $ Log $ SystemLog "TODO: domain deleted: update my domains." + --{ my_domains } <- H.get + --handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains _ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface." pure (Just a) @@ -338,7 +403,8 @@ page_reload s1 message = case message of DNSManager.MkLogged response -> s1 { accepted_domains = response.accepted_domains - , my_domains = A.sort response.my_domains + -- TODO + -- , my_domains = A.sort response.my_domains } _ -> s1 diff --git a/src/App/Type/DomainInfo.purs b/src/App/Type/DomainInfo.purs new file mode 100644 index 0000000..38148d2 --- /dev/null +++ b/src/App/Type/DomainInfo.purs @@ -0,0 +1,33 @@ +module App.Type.DomainInfo where + +import Prelude ((<>), map, bind, pure) + +import Data.Maybe (Maybe(..), maybe) + +import Data.Codec.Argonaut (JsonCodec) +import Data.Codec.Argonaut as CA +import Data.Codec.Argonaut.Record as CAR + +type DomainInfo + = { name :: String + , share_key :: Maybe String + , transfer_key :: Maybe String + , owners :: Array String + } + +codec :: JsonCodec DomainInfo +codec = CA.object "DomainInfo" + (CAR.record + { name: CA.string + , share_key: CAR.optional CA.string + , transfer_key: CAR.optional CA.string + , owners: CA.array CA.string + }) + +emptyDomainInfo :: DomainInfo +emptyDomainInfo + = { name: "" + , share_key: Nothing + , transfer_key: Nothing + , owners: [] + } diff --git a/src/Bulma.purs b/src/Bulma.purs index d715b68..1726481 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -61,6 +61,22 @@ table prop xs = HH.table ([ HP.classes $ C.table ] <> prop) xs table_ :: forall w i. Array HH.ClassName -> HH.Node DHI.HTMLtable w i table_ classes prop xs = HH.table ([ HP.classes $ C.table <> classes] <> prop) xs +table_header_owned_domains :: forall w i. HH.HTML w i +table_header_owned_domains + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ] + , HH.th_ [ HH.text "" ] + , HH.th_ [ HH.text "" ] + ] + ] + +table_header_shared_domains :: forall w i. HH.HTML w i +table_header_shared_domains + = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ] + , HH.th_ [ HH.text "Share key" ] + , HH.th_ [ HH.text "" ] + ] + ] + mechanism_table_header :: forall w i. HH.HTML w i mechanism_table_header = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ]