Preliminary work for ownership management.

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
+                            , Bulma.simple_quote "You are the exclusive owner of the following domains."
-                              then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_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
+    shared_domain_row domain = HH.tr_
-      = [ Bulma.alert_btn "delete" (DeleteDomainModal domain)
+      [ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ]
-        , Bulma.btn domain (EnterDomain domain)
+      , 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
+        -- TODO
-        handleAction $ UpdateMyDomains (my_domains <> [response.domain])
+        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
+        H.raise $ Log $ SystemLog "TODO: domain deleted: update my domains."
-        handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) 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
 

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

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