Baguette/dnsmanager-webclient
3
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Preliminary work for ownership management.

Browse Source
This commit is contained in:
Philippe PITTOLI 2024-04-25 11:50:56 +02:00
parent b4a75feca0
commit 797f2ce248
3 changed files with 134 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
src/App/Page/DomainList.purs
View File

@ -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,9 +237,19 @@ 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
@ -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

33
src/App/Type/DomainInfo.purs Normal file
View File

@ -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: []
}

16
src/Bulma.purs
View File

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