Implement the different messages for domain ownership management.

This commit is contained in:
Karchnu 2024-04-27 19:50:57 +02:00
parent 96f82adf6b
commit 04f9334f29
3 changed files with 72 additions and 17 deletions

View File

@ -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

View File

@ -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."

View File

@ -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