From 04f9334f29b1624cb7ea1b1bbf10086669e12d57 Mon Sep 17 00:00:00 2001 From: Karchnu Date: Sat, 27 Apr 2024 19:50:57 +0200 Subject: [PATCH] Implement the different messages for domain ownership management. --- src/App/Message/DNSManagerDaemon.purs | 33 +++++++++++++++++++-- src/App/Page/DomainList.purs | 42 +++++++++++++++++++-------- src/Bulma.purs | 14 +++++++-- 3 files changed, 72 insertions(+), 17 deletions(-) diff --git a/src/App/Message/DNSManagerDaemon.purs b/src/App/Message/DNSManagerDaemon.purs index af7521b..2523e26 100644 --- a/src/App/Message/DNSManagerDaemon.purs +++ b/src/App/Message/DNSManagerDaemon.purs @@ -107,6 +107,27 @@ type NewToken = { domain :: String, rrid :: Int } codecNewToken ∷ CA.JsonCodec NewToken codecNewToken = CA.object "NewToken" (CAR.record { domain: CA.string, rrid: CA.int }) +{- 19 is UseToken, which isn't useful in the webclient. -} +{- 20 -} +type AskShareToken = { domain :: String } +codecAskShareToken ∷ CA.JsonCodec AskShareToken +codecAskShareToken = CA.object "AskShareToken" (CAR.record { domain: CA.string }) + +{- 21 -} +type AskTransferToken = { domain :: String } +codecAskTransferToken ∷ CA.JsonCodec AskTransferToken +codecAskTransferToken = CA.object "AskTransferToken" (CAR.record { domain: CA.string }) + +{- 22 -} +type AskUnShareDomain = { domain :: String } +codecAskUnShareDomain ∷ CA.JsonCodec AskUnShareDomain +codecAskUnShareDomain = CA.object "AskUnShareDomain" (CAR.record { domain: CA.string }) + +{- 23 -} +type GainOwnership = { uuid :: String } +codecGainOwnership ∷ CA.JsonCodec GainOwnership +codecGainOwnership = CA.object "GainOwnership" (CAR.record { uuid: CA.string }) + {- 100 -} type GenerateAllZoneFiles = {} codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles @@ -185,9 +206,9 @@ codecInvalidZone ∷ CA.JsonCodec InvalidZone codecInvalidZone = CA.object "InvalidZone" (CAR.record { errors: CA.array CA.string }) {- 11 -} -type DomainChanged = { } +type DomainChanged = { domain :: DomainInfo.DomainInfo } codecDomainChanged ∷ CA.JsonCodec DomainChanged -codecDomainChanged = CA.object "DomainChanged" (CAR.record { }) +codecDomainChanged = CA.object "DomainChanged" (CAR.record { domain: DomainInfo.codec }) {- 12 -} type Zone = { zone :: DNSZone.DNSZone } @@ -297,6 +318,10 @@ data RequestMessage | MkAskGeneratedZoneFile AskGeneratedZoneFile -- 17 | MkNewToken NewToken -- 18 --| MkUseToken UseToken -- 19 + | MkAskShareToken AskShareToken -- 20 + | MkAskTransferToken AskTransferToken -- 21 + | MkAskUnShareDomain AskUnShareDomain -- 22 + | MkGainOwnership GainOwnership -- 23 | MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100 | MkGenerateZoneFile GenerateZoneFile -- 101 | MkKeepAlive KeepAlive -- 250 @@ -350,6 +375,10 @@ encode m = case m of (MkAskGeneratedZoneFile request) -> get_tuple 17 codecAskGeneratedZoneFile request (MkNewToken request) -> get_tuple 18 codecNewToken request --(MkUseToken request) -> get_tuple 19 codecUseToken request + (MkAskShareToken request) -> get_tuple 20 codecAskShareToken request + (MkAskTransferToken request) -> get_tuple 21 codecAskTransferToken request + (MkAskUnShareDomain request) -> get_tuple 22 codecAskUnShareDomain request + (MkGainOwnership request) -> get_tuple 23 codecGainOwnership request (MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request (MkGenerateZoneFile request) -> get_tuple 101 codecGenerateZoneFile request (MkKeepAlive request) -> get_tuple 250 codecKeepAlive request diff --git a/src/App/Page/DomainList.purs b/src/App/Page/DomainList.purs index 35fc0cd..1e7f466 100644 --- a/src/App/Page/DomainList.purs +++ b/src/App/Page/DomainList.purs @@ -87,8 +87,11 @@ data NewDomainFormAction -- | - update the list of own domains -- | - handle user inputs -- | - add a new domain --- | - remove a domain --- | - TODO: show the zone content (in another component) +-- | - delete a domain you exclusively own +-- | - share or transfer a domain (through dedicated tokens) +-- | - gain ownership over a domain (through dedicated tokens) +-- | - gain exclusive ownership of a shared domain (if the user is currently the only owner) +-- | - show the zone content (in another page) data Action = UpdateAcceptedDomains (Array String) @@ -102,7 +105,8 @@ data Action | RemoveDomain String | EnterDomain String | ShareDomain String - | UnshareDomain String + | UnShareDomain String + | TransferDomain String | DeleteDomainModal String | CancelModal @@ -236,18 +240,23 @@ render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, del <> "\". Are you sure you want to do this? This is " , HH.strong_ [ HH.text "irreversible" ] , HH.text "." + , Bulma.notification_warning' """ + In case this domain is shared, it won't be deleted, you'll just remove it from your domains. + """ ] 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 HH.td_ [ Bulma.alert_btn "Unshare" (UnshareDomain domain.name) ] + then HH.td_ [ Bulma.alert_btn "Unshare" (UnShareDomain domain.name) ] else HH.td_ [ Bulma.btn_ro (C.is_warning) "Cannot unshare it" ] + , HH.td_ [ Bulma.alert_btn "Delete" (DeleteDomainModal domain.name) ] ] owned_domain_row domain = HH.tr_ [ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ] + , HH.td_ [ Bulma.btn "Transfer" (TransferDomain domain.name) ] , HH.td_ [ Bulma.btn "Share" (ShareDomain domain.name) ] , HH.td_ [ Bulma.alert_btn "Delete" (DeleteDomainModal domain.name) ] ] @@ -316,10 +325,19 @@ handleAction = case _ of H.raise $ ChangePageZoneInterface domain ShareDomain domain -> do - H.raise $ Log $ SystemLog $ "TODO: Share domain " <> domain + message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskShareToken { domain: domain } + H.raise $ MessageToSend message + H.raise $ Log $ SystemLog $ "Ask a \"share token\" for domain " <> domain <> "." - UnshareDomain domain -> do - H.raise $ Log $ SystemLog $ "TODO: Unshare domain " <> domain + TransferDomain domain -> do + message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskTransferToken { domain: domain } + H.raise $ MessageToSend message + H.raise $ Log $ SystemLog $ "Ask a \"transfer token\" for domain " <> domain <> "." + + UnShareDomain domain -> do + message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskUnShareDomain { domain: domain } + H.raise $ MessageToSend message + H.raise $ Log $ SystemLog $ "Ask for exclusive ownership for domain " <> domain <> "." DeleteDomainModal domain -> do H.modify_ _ { deletion_modal = Just domain } @@ -357,11 +375,11 @@ handleAction = case _ of "", _ -> H.raise $ Log $ UnableToSend "You didn't enter the UUID of the transfer." uuid, [] -> do - --message <- H.liftEffect - -- $ DNSManager.serialize - -- $ DNSManager.MkNewDomain { domain: new_domain } - --H.raise $ MessageToSend message - H.raise $ Log $ SystemLog $ "TODO: Ask for a domain transfer (" <> uuid <> ")." + message <- H.liftEffect + $ DNSManager.serialize + $ DNSManager.MkGainOwnership { uuid: uuid } + H.raise $ MessageToSend message + H.raise $ Log $ SystemLog $ "Gain ownership of a domain (" <> uuid <> ")." handleAction $ AskDomainTransferUUIDInput "" _, _ -> H.raise $ Log $ UnableToSend $ "The UUID is invalid." diff --git a/src/Bulma.purs b/src/Bulma.purs index 1726481..9db5cfd 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -64,6 +64,7 @@ table_ classes prop xs = HH.table ([ HP.classes $ C.table <> classes] <> prop) x 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 "" ] , HH.th_ [ HH.text "" ] ] @@ -74,6 +75,7 @@ table_header_shared_domains = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ] , HH.th_ [ HH.text "Share key" ] , HH.th_ [ HH.text "" ] + , HH.th_ [ HH.text "" ] ] ] @@ -588,13 +590,16 @@ notification classes value deleteaction = ] notification_primary :: forall w i. String -> i -> HH.HTML w i -notification_primary value deleteaction = notification C.is_primary value deleteaction +notification_primary value action = notification C.is_primary value action notification_success :: forall w i. String -> i -> HH.HTML w i -notification_success value deleteaction = notification C.is_success value deleteaction +notification_success value action = notification C.is_success value action + +notification_warning :: forall w i. String -> i -> HH.HTML w i +notification_warning value action = notification C.is_warning value action notification_danger :: forall w i. String -> i -> HH.HTML w i -notification_danger value deleteaction = notification C.is_danger value deleteaction +notification_danger value action = notification C.is_danger value action notification_block' :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i notification_block' classes content = @@ -605,6 +610,9 @@ notification' classes value = HH.div [HP.classes (C.notification <> classes)] [ HH.text value ] +notification_warning' :: forall w i. String -> HH.HTML w i +notification_warning' value = notification' C.is_warning value + notification_danger' :: forall w i. String -> HH.HTML w i notification_danger' value = notification' C.is_danger value