Authd: error password too long + s/!/./.

src/App/Container.purs

@@ -573,42 +573,45 @@ handleAction = case _ of
             handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent."
             handleAction $ DispatchAuthDaemonMessage m
           (AuthD.GotErrorPasswordTooShort _) -> do
-            handleAction $ Log $ ErrorLog "Password too short!"
+            handleAction $ Log $ ErrorLog "Password too short."
             handleAction $ AddNotif $ BadNotification "The server told that your password is too short."
           (AuthD.GotErrorMailRequired _) -> do
-            handleAction $ Log $ ErrorLog "Email required!"
+            handleAction $ Log $ ErrorLog "Email required."
             handleAction $ AddNotif $ BadNotification "An email is required."
           (AuthD.GotErrorInvalidCredentials _) -> do
-            handleAction $ Log $ ErrorLog "Invalid credentials!"
+            handleAction $ Log $ ErrorLog "Invalid credentials."
             handleAction $ ToggleAuthenticated Nothing
-            handleAction $ AddNotif $ BadNotification "Invalid credentials!"
+            handleAction $ AddNotif $ BadNotification "Invalid credentials."
           (AuthD.GotErrorRegistrationsClosed _) -> do
             handleAction $ Log $ ErrorLog "Registration closed. Try another time or contact an administrator."
             handleAction $ AddNotif $ BadNotification "Registration are closed at the moment."
           (AuthD.GotErrorInvalidLoginFormat _) -> do
-            handleAction $ Log $ ErrorLog "Invalid login format!"
+            handleAction $ Log $ ErrorLog "Invalid login format."
             handleAction $ AddNotif $ BadNotification "Invalid login format."
           (AuthD.GotErrorInvalidEmailFormat _) -> do
-            handleAction $ Log $ ErrorLog "Invalid email format!"
+            handleAction $ Log $ ErrorLog "Invalid email format."
             handleAction $ AddNotif $ BadNotification "Invalid email format."
           (AuthD.GotErrorAlreadyUsersInDB _) -> do
-            handleAction $ Log $ ErrorLog "GotErrorAlreadyUsersInDB"
-            handleAction $ AddNotif $ BadNotification "Login already taken!"
+            handleAction $ Log $ ErrorLog "Login already taken."
+            handleAction $ AddNotif $ BadNotification "Login already taken."
           (AuthD.GotErrorReadOnlyProfileKeys _) -> do
-            handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys!"
-            handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys!"
+            handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys."
+            handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys."
           (AuthD.GotErrorInvalidActivationKey _) -> do
-            handleAction $ Log $ ErrorLog "Invalid activation key!"
-            handleAction $ AddNotif $ BadNotification "Invalid activation key!"
+            handleAction $ Log $ ErrorLog "Invalid activation key."
+            handleAction $ AddNotif $ BadNotification "Invalid activation key."
           (AuthD.GotErrorUserAlreadyValidated _) -> do
-            handleAction $ Log $ ErrorLog "User already validated!"
-            handleAction $ AddNotif $ BadNotification "User already validated!"
+            handleAction $ Log $ ErrorLog "User already validated."
+            handleAction $ AddNotif $ BadNotification "User already validated."
           (AuthD.GotErrorCannotContactUser _) -> do
             handleAction $ Log $ ErrorLog "User cannot be contacted. Email address may be invalid."
             handleAction $ AddNotif $ BadNotification "User cannot be contacted. Email address may be invalid."
           (AuthD.GotErrorInvalidRenewKey _) -> do
-            handleAction $ Log $ ErrorLog "Invalid renew key!"
-            handleAction $ AddNotif $ BadNotification "Invalid renew key!"
+            handleAction $ Log $ ErrorLog "Invalid renew key."
+            handleAction $ AddNotif $ BadNotification "Invalid renew key."
+          (AuthD.GotErrorPasswordTooLong _) -> do
+            handleAction $ Log $ ErrorLog "Password too long."
+            handleAction $ AddNotif $ BadNotification "Password too long."
           -- The authentication was a success!
           (AuthD.GotToken msg) -> do
             handleAction $ Log $ SuccessLog $ "Authenticated to authd."
@@ -684,8 +687,9 @@ handleAction = case _ of
           (DNSManager.MkInvalidZone _) -> do
             handleAction $ Log $ ErrorLog $ "InvalidZone"
             handleAction $ AddNotif $ BadNotification $ "The domain zone is invalid."
-          (DNSManager.MkDomainChanged _) -> do
-            handleAction $ Log $ ErrorLog $ "DomainChanged"
+          m@(DNSManager.MkDomainChanged response) -> do
+            handleAction $ Log $ SystemLog $ "Domain \"" <> response.domain.name <> "\" has been updated."
+            handleAction $ DispatchDNSMessage m
           (DNSManager.MkUnknownZone _) -> do
             handleAction $ Log $ ErrorLog $ "UnknownZone"
             handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown."
@@ -701,7 +705,7 @@ handleAction = case _ of
             handleAction $ AddNotif $ BadNotification $ "You do not have sufficient rights."
           -- The authentication failed.
           (DNSManager.MkError errmsg) -> do
-            handleAction $ Log $ ErrorLog $ "reason is: " <> errmsg.reason
+            handleAction $ Log $ ErrorLog errmsg.reason
           (DNSManager.MkErrorUserNotLogged _) -> do
             handleAction $ Log $ ErrorLog $ "The user isn't connected!"
             handleAction $ Log $ SystemLog $ "Trying to authenticate to fix the problem..."

src/App/Message/AuthenticationDaemon.purs

@@ -339,6 +339,11 @@ type ErrorInvalidRenewKey = {}
 codecGotErrorInvalidRenewKey :: CA.JsonCodec ErrorInvalidRenewKey
 codecGotErrorInvalidRenewKey = CA.object "ErrorInvalidRenewKey" (CAR.record {})
 
+{- 35 -}
+type ErrorPasswordTooLong = {}
+codecGotErrorPasswordTooLong :: CA.JsonCodec ErrorPasswordTooLong
+codecGotErrorPasswordTooLong = CA.object "ErrorPasswordTooLong" (CAR.record {})
+
 {- 250 -}
 -- type KeepAlive = { }
 codecGotKeepAlive ∷ CA.JsonCodec KeepAlive
@@ -393,6 +398,7 @@ data AnswerMessage
   | GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
   | GotErrorCannotContactUser    ErrorCannotContactUser    -- 33
   | GotErrorInvalidRenewKey      ErrorInvalidRenewKey      -- 34
+  | GotErrorPasswordTooLong      ErrorPasswordTooLong      -- 35
   | GotKeepAlive                 KeepAlive                 -- 250
 
 encode ∷ RequestMessage -> Tuple UInt String
@@ -455,6 +461,7 @@ decode number string
     32  -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
     33  -> error_management codecGotErrorCannotContactUser    GotErrorCannotContactUser
     34  -> error_management codecGotErrorInvalidRenewKey      GotErrorInvalidRenewKey
+    35  -> error_management codecGotErrorPasswordTooLong      GotErrorPasswordTooLong
     250 -> error_management codecGotKeepAlive                 GotKeepAlive
     _  -> Left UnknownNumber
   where

src/App/Message/DNSManagerDaemon.purs

@@ -2,6 +2,8 @@ module App.Message.DNSManagerDaemon where
 
 import Prelude (bind, pure, show, ($))
 
+import App.Type.DomainInfo as DomainInfo
+
 import Effect (Effect)
 
 import Data.Argonaut.Core as J
@@ -105,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
@@ -183,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 }
@@ -208,10 +231,10 @@ codecAcceptedDomains ∷ CA.JsonCodec AcceptedDomains
 codecAcceptedDomains = CA.object "AcceptedDomains" (CAR.record { domains: CA.array CA.string })
 
 {- 16  -}
-type Logged = { accepted_domains :: Array String, my_domains :: Array String, admin :: Boolean }
+type Logged = { accepted_domains :: Array String, my_domains :: Array DomainInfo.DomainInfo, admin :: Boolean }
 codecLogged ∷ CA.JsonCodec Logged
 codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string
-                                             ,       my_domains: CA.array CA.string
+                                             ,       my_domains: CA.array DomainInfo.codec
                                              ,            admin: CA.boolean
                                              })
 
@@ -295,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
@@ -348,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

src/App/Page/Authentication.purs

@@ -199,14 +199,14 @@ render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm,
     auth_form = [ Bulma.h3 "Authentication", render_auth_form ]
     passrecovery_form =
       [ Bulma.h3 "You forgot your password (or your login)"
-      , Bulma.div_content
+      , Bulma.div_content []
         [ Bulma.p "Enter either your login or email and you'll receive a recovery token."
         ]
       , render_password_recovery_form
       ]
     newpass_form =
       [ Bulma.h3 "You got the password recovery mail"
-      , Bulma.div_content
+      , Bulma.div_content []
         [ Bulma.p "Nice! You get to choose your new password."
         ]
       , render_new_password_form

src/App/Page/DomainList.purs

@@ -8,16 +8,17 @@
 -- |   - delete a domain
 -- |   - ask for confirmation
 -- |   - switch to the interface to show and modify the content of a Zone
--- |   - TODO: validate the domain before sending a message to `dnsmanagerd`
+-- |   - validate the domain before sending a message to `dnsmanagerd`
+-- |   - manage ownership of a domain: give, share, take back exclusive ownership.
 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 +33,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
@@ -84,18 +87,26 @@ 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)
-  | UpdateMyDomains (Array String)
+  | UpdateMyDomains (Array DomainInfo)
 
   | HandleNewDomainInput NewDomainFormAction
+  | AskDomainTransferUUIDInput String
 
   | NewDomainAttempt Event
+  | AskDomainTransferAttempt Event
   | RemoveDomain String
   | EnterDomain String
+  | ShareDomain String
+  | UnShareDomain String
+  | TransferDomain String
 
   | DeleteDomainModal String
   | CancelModal
@@ -103,8 +114,9 @@ data Action
   | Initialize
   | Finalize
 
--- | The form only has two elements:
+-- | The form only has two visible elements:
 -- | the subdomain name input and the selected TLD.
+-- | The type also includes validation errors.
 
 type NewDomainFormState
   = { new_domain      :: String
@@ -112,15 +124,21 @@ type NewDomainFormState
     , selected_domain :: String
     }
 
+-- | The form "askDomainTransfer" is simple enough: an input for the UUID and a button.
+-- | The type also includes validation errors.
+
+type AskDomainTransferState = { uuid :: String, _errors :: Array Validation.Error }
+
 -- | The entire component's state contains the form, accepted domains,
 -- | the list of own domains and a boolean to know if the connection is up.
 
 type State =
   { newDomainForm          :: NewDomainFormState
+  , askDomainTransferForm  :: AskDomainTransferState
   , accepted_domains       :: Array String
-  , my_domains             :: Array String
+  , my_domains             :: Array DomainInfo
 
-  , active_modal :: Maybe String
+  , deletion_modal :: Maybe String
   }
 
 component :: forall m. MonadAff m => H.Component Query Input Output m
@@ -141,47 +159,135 @@ 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
-                   }
+  { newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain }
+  , askDomainTransferForm: { uuid: "", _errors: [] }
   , accepted_domains: [ default_domain ]
-  , my_domains: [ ]
-  , active_modal: Nothing
+  , my_domains: []
+  , deletion_modal: Nothing
   }
 
 render :: forall m. State -> H.ComponentHTML Action () m
-render { accepted_domains, my_domains, newDomainForm, active_modal }
+render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, deletion_modal }
   = Bulma.section_small
-      [ case active_modal of
-          Nothing -> Bulma.columns_
-            [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form]
-            , 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
-                              else Bulma.p "No domain yet."
-                            ]
-            ]
+      [ case deletion_modal of
+          Nothing -> HH.div_ [ Bulma.columns_ domain_line
+                             , Bulma.hr
+                             , Bulma.columns_ new_domain_line
+                             , Bulma.hr
+                             , Bulma.columns_ explanations_line
+                             ]
           Just domain -> Bulma.modal "Deleting a domain"
             [warning_message domain] [modal_delete_button domain, modal_cancel_button]
       ]
   where
+    c = Bulma.column_
+
+    domain_line       = [ c render_my_domains,                  c render_my_shared_domains ]
+    new_domain_line   = [ c render_new_domain,                  c render_gain_ownership ]
+    explanations_line = [ c render_share_ownership_explanation, c render_transfer_ownership_explanation ]
+
+    render_my_domains =
+      [ Bulma.h3 "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."
+      ]
+    render_my_shared_domains =
+      [ 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."
+      ]
+    render_new_domain =
+      [ Bulma.h3 "New domain"
+      , Bulma.quote [ Bulma.p "The heart of dnsmanager! 🎉"
+                    , Bulma.p "You can reserve a domain name, right here."
+                    , HH.text """
+                        Later you will be able to change the content, share, transfer or even delete the domain.
+                        """
+                    ]
+      , render_add_domain_form
+      ]
+
+    render_gain_ownership =
+      [ Bulma.h3 "Get the ownership of a domain"
+      , Bulma.simple_quote """
+          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
+      ]
+    render_share_ownership_explanation =
+      [ 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.
+          """
+      ]
+
+    render_transfer_ownership_explanation =
+      [ 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.
+          """
+      ]
+
     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
                             <> "\". 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.
+                """
                 ]
 
-    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 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) ]
+      , case domain.transfer_key of
+          Just key -> HH.td_ [ Bulma.p key ]
+          Nothing  -> 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) ]
+      ]
 
     render_add_domain_form = HH.form
       [ HE.onSubmit NewDomainAttempt ]
@@ -196,6 +302,17 @@ render { accepted_domains, my_domains, newDomainForm, active_modal }
         else HH.div_ [ ]
       ]
 
+    render_ask_domain_transfer_form = HH.form
+      [ HE.onSubmit AskDomainTransferAttempt ]
+      [ Bulma.box_input "idTransferToken" "Token" "UUID of the domain"
+          AskDomainTransferUUIDInput
+          askDomainTransferForm.uuid
+      , Bulma.btn_validation_ "ask for a domain transfer"
+      , if A.length askDomainTransferForm._errors > 0
+        then HH.div_ $ map error_to_paragraph_label askDomainTransferForm._errors
+        else HH.div_ [ ]
+      ]
+
     domain_choice :: Int -> Action
     domain_choice i
       = HandleNewDomainInput <<< UpdateSelectedDomain $ maybe default_domain (\x -> x) $ accepted_domains A.!! i
@@ -210,7 +327,7 @@ handleAction = case _ of
     H.raise $ StoreState state
 
   CancelModal -> do
-    H.modify_ _ { active_modal = Nothing }
+    H.modify_ _ { deletion_modal = Nothing }
 
   UpdateAcceptedDomains domains -> do
     H.modify_ _ { accepted_domains = domains }
@@ -229,17 +346,35 @@ handleAction = case _ of
             Right _  -> H.modify_ _ { newDomainForm { _errors = [] } }
       UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
 
+  AskDomainTransferUUIDInput str -> do
+    H.modify_ _ { askDomainTransferForm { uuid = toLower str } }
+
   EnterDomain domain -> do
     H.raise $ ChangePageZoneInterface domain
 
+  ShareDomain domain -> do
+    message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskShareToken { domain: domain }
+    H.raise $ MessageToSend message
+    H.raise $ Log $ SystemLog $ "Ask a \"share token\" for 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_ _ { active_modal = Just domain }
+    H.modify_ _ { deletion_modal = Just domain }
 
   RemoveDomain domain -> do
     message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
     H.raise $ MessageToSend message
     H.raise $ Log $ SystemLog $ "Remove domain: " <> domain
-    H.modify_ _ { active_modal = Nothing }
+    H.modify_ _ { deletion_modal = Nothing }
 
   NewDomainAttempt ev -> do
     H.liftEffect $ Event.preventDefault ev
@@ -249,7 +384,7 @@ handleAction = case _ of
 
     case newDomainForm.new_domain, newDomainForm._errors, new_domain of
       "", _, _ ->
-        H.raise $ Log $ UnableToSend "You didn't enter the new domain!"
+        H.raise $ Log $ UnableToSend "You didn't enter the new domain."
       _, [], _ -> do
         message <- H.liftEffect
           $ DNSManager.serialize
@@ -260,6 +395,23 @@ handleAction = case _ of
       _, _, _ ->
         H.raise $ Log $ UnableToSend $ "The new domain name is invalid."
 
+  AskDomainTransferAttempt ev -> do
+    H.liftEffect $ Event.preventDefault ev
+
+    { askDomainTransferForm } <- H.get
+    case askDomainTransferForm.uuid, askDomainTransferForm._errors of
+      "", _ ->
+        H.raise $ Log $ UnableToSend "You didn't enter the UUID of the transfer."
+      uuid, [] -> do
+        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."
+
 handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
 handleQuery = case _ of
 
@@ -280,10 +432,17 @@ handleQuery = case _ of
         handleAction $ UpdateMyDomains response.my_domains
       (DNSManager.MkDomainAdded response) -> do
         { my_domains } <- H.get
-        handleAction $ UpdateMyDomains (my_domains <> [response.domain])
+        handleAction $ UpdateMyDomains (my_domains <> [ emptyDomainInfo { name = response.domain } ])
+      (DNSManager.MkDomainChanged response) -> do
+        { my_domains } <- H.get
+        let replaced_domains = map (\d -> if d.name == response.domain.name then response.domain else d) my_domains
+            new_domains = if A.elem response.domain replaced_domains
+                          then replaced_domains
+                          else replaced_domains <> [response.domain]
+        handleAction $ UpdateMyDomains new_domains
       (DNSManager.MkDomainDeleted response) -> do
         { my_domains } <- H.get
-        handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
+        handleAction $ UpdateMyDomains $ A.filter (\d -> d.name /= response.domain) my_domains
       _ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
     pure (Just a)
 

src/App/Page/Home.purs

@@ -55,9 +55,9 @@ render _ = HH.div_
              ]
   where
     title = Bulma.h3
-    expl content = Bulma.div_content [ Bulma.explanation content ]
+    expl content = Bulma.div_content [] [ Bulma.explanation content ]
     p = Bulma.p
-    b x = Bulma.column_ [ Bulma.box [ Bulma.div_content x ] ]
+    b x = Bulma.column_ [ Bulma.box [ Bulma.div_content [] x ] ]
 
     render_description = Bulma.columns_ [ render_basics, render_no_expert, render_no_housing ]
     render_update_why_and_contact = Bulma.columns_ [ render_updates, render_why, render_contact ]

src/App/Page/Zone.purs

@@ -55,7 +55,7 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR
                           , show_qualifier, show_qualifier_char
                           , show_mechanism_type, show_mechanism, to_mechanism
                           , show_modifier_type, show_modifier, to_modifier
-                          , all_qualifiers
+                          , qualifiers
                           , mechanism_types, qualifier_types, modifier_types)
 import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
 import App.Type.DKIM as DKIM
@@ -447,7 +447,7 @@ render state
           ]
         modal_content_srv :: Array (HH.HTML w Action)
         modal_content_srv =
-          [ Bulma.div_content [Bulma.explanation Explanations.srv_introduction]
+          [ Bulma.div_content [] [Bulma.explanation Explanations.srv_introduction]
           , render_errors
           , Bulma.box_input "domainSRV" "Service name" "service name"
               (updateForm Field_Domain)
@@ -473,7 +473,7 @@ render state
           ]
         modal_content_spf :: Array (HH.HTML w Action)
         modal_content_spf =
-          [ Bulma.div_content [Bulma.explanation Explanations.spf_introduction]
+          [ Bulma.div_content [] [Bulma.explanation Explanations.spf_introduction]
           , render_errors
           , Bulma.input_with_side_text "domainSPF" "Name" "Let this alone."
               (updateForm Field_Domain)
@@ -511,13 +511,13 @@ render state
           , Bulma.hr
           , Bulma.box
             [ Bulma.h3 "Default behavior"
-            , Bulma.div_content [Bulma.explanation Explanations.spf_default_behavior]
+            , Bulma.div_content [] [Bulma.explanation Explanations.spf_default_behavior]
             , Bulma.selection SPF_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q)
             ]
           ]
         modal_content_dkim :: Array (HH.HTML w Action)
         modal_content_dkim =
-          [ Bulma.div_content [Bulma.explanation Explanations.dkim_introduction]
+          [ Bulma.div_content [] [Bulma.explanation Explanations.dkim_introduction]
           , render_errors
           , Bulma.input_with_side_text "domainDKIM" "Name" "default._domainkey"
               (updateForm Field_Domain)
@@ -527,7 +527,7 @@ render state
               (updateForm Field_TTL)
               (show state._currentRR.ttl)
           , Bulma.hr
-          , Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
+          , Bulma.div_content [] [Bulma.explanation Explanations.dkim_default_algorithms]
           , Bulma.selection_field "idDKIMSignature" "Signature algo"
               DKIM_sign_algo
               (map show DKIM.sign_algos)
@@ -542,7 +542,7 @@ render state
 
         modal_content_dmarc :: Array (HH.HTML w Action)
         modal_content_dmarc =
-          [ Bulma.div_content [Bulma.explanation Explanations.dmarc_introduction]
+          [ Bulma.div_content [] [Bulma.explanation Explanations.dmarc_introduction]
           , render_errors
           , Bulma.input_with_side_text "domainDMARC" "Name" "_dmarc"
               (updateForm Field_Domain)
@@ -551,20 +551,27 @@ render state
           , Bulma.box_input "ttlDMARC" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl)
 
           , Bulma.hr
-          , Bulma.div_content [Bulma.explanation Explanations.dmarc_policy]
-          , Bulma.selection_field "idDMARCPolicy" "Policy" DMARC_policy (map show DMARC.policies) (show state.dmarc.p)
-          , Bulma.div_content [Bulma.explanation Explanations.dmarc_sp_policy]
-          , Bulma.selection_field "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
-            (["do not provide policy advice"] <> map show DMARC.policies) (maybe "-" show state.dmarc.sp)
+          , Bulma.div_content [] [Bulma.explanation Explanations.dmarc_policy]
+          , Bulma.selection_field' "idDMARCPolicy" "Policy" DMARC_policy
+              (A.zip DMARC.policies_txt DMARC.policies_raw)
+              (show state.dmarc.p)
+          , Bulma.div_content [] [Bulma.explanation Explanations.dmarc_sp_policy]
+          , Bulma.selection_field' "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
+              (zip_nullable DMARC.policies_txt_with_null DMARC.policies_raw)
+              (maybe "-" show state.dmarc.sp)
 
           , Bulma.hr
-          , Bulma.div_content [Bulma.explanation Explanations.dmarc_adkim]
-          , Bulma.selection_field "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim DMARC.consistency_policies_txt (maybe "-" show state.dmarc.adkim)
-          , Bulma.div_content [Bulma.explanation Explanations.dmarc_aspf]
-          , Bulma.selection_field "idDMARCaspf" "Consistency Policy for SPF"   DMARC_aspf  DMARC.consistency_policies_txt  (maybe "-" show state.dmarc.aspf)
+          , Bulma.div_content [] [Bulma.explanation Explanations.dmarc_adkim]
+          , Bulma.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim
+              (zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
+              (maybe "-" show state.dmarc.adkim)
+          , Bulma.div_content [] [Bulma.explanation Explanations.dmarc_aspf]
+          , Bulma.selection_field' "idDMARCaspf" "Consistency Policy for SPF"   DMARC_aspf
+              (zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
+              (maybe "-" show state.dmarc.aspf)
 
           , Bulma.hr
-          , Bulma.div_content [Bulma.explanation Explanations.dmarc_pct]
+          , Bulma.div_content [] [Bulma.explanation Explanations.dmarc_pct]
           , Bulma.box_input "idDMARCpct" "Sample rate [0..100]" "100" DMARC_pct (maybe "100" show state.dmarc.pct)
 
           , Bulma.hr
@@ -573,7 +580,7 @@ render state
               (maybe "-" show state.dmarc.fo)
 
           , Bulma.hr
-          , Bulma.div_content [Bulma.explanation Explanations.dmarc_contact]
+          , Bulma.div_content [] [Bulma.explanation Explanations.dmarc_contact]
           , maybe (Bulma.p "There is no address to send aggregated reports to.")
             (display_dmarc_mail_addresses "Addresses to contact for aggregated reports" DMARC_remove_rua) state.dmarc.rua
           , maybe (Bulma.p "There is no address to send detailed reports to.")
@@ -588,7 +595,7 @@ render state
                         ] []
 
           , Bulma.hr
-          , Bulma.div_content [Bulma.explanation Explanations.dmarc_ri]
+          , Bulma.div_content [] [Bulma.explanation Explanations.dmarc_ri]
           , Bulma.box_input "idDMARCri" "Report interval (in seconds)" "86400" DMARC_ri (maybe "0" show state.dmarc.ri)
           ]
 
@@ -822,7 +829,7 @@ handleAction = case _ of
   SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v                                            }
   SPF_Modifier_t v  -> H.modify_ _ { spf_modifier_t  = maybe "redirect" id $ modifier_types  A.!! v }
   SPF_Modifier_v v  -> H.modify_ _ { spf_modifier_v  = v                                            }
-  SPF_Qualifier v   -> H.modify_ _ { _currentRR { q  = all_qualifiers  A.!! v                     } }
+  SPF_Qualifier v   -> H.modify_ _ { _currentRR { q  = qualifiers A.!! v                          } }
   SPF_remove_mechanism i ->
     H.modify_ \s -> s { _currentRR { mechanisms = case s._currentRR.mechanisms of
                                        Just ms -> Just (remove_id i $ attach_id 0 ms)
@@ -1147,8 +1154,8 @@ render_resources records
 
   show_token_or_btn rr =
     case rr.rrtype of
-      "A"    -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token!" (NewToken rr.rrid)
-      "AAAA" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token!" (NewToken rr.rrid)
+      "A"    -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token" (NewToken rr.rrid)
+      "AAAA" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token" (NewToken rr.rrid)
       _      -> HH.text ""
 
   fancy_qualifier_display :: RR.Qualifier -> String

src/App/Text/Explanations.purs

@@ -6,7 +6,7 @@ import Bulma as Bulma
 expl' :: forall w i. String -> HH.HTML w i
 expl' text = expl [Bulma.p text]
 expl :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-expl content = Bulma.div_content [ Bulma.explanation content ]
+expl content = Bulma.div_content [] [ Bulma.explanation content ]
 expl_txt :: forall w i. String -> HH.HTML w i
 expl_txt content = Bulma.explanation [ Bulma.p content ]
 

src/App/Type/DMARC.purs

@@ -170,10 +170,13 @@ consistency_policies = [Strict, Relaxed]
 consistency_policies_txt :: Array String
 consistency_policies_txt
   = [ "Do not provide policy advice"
-    , "Strict"
-    , "Relaxed"
+    , "Strict: same domain"
+    , "Relaxed: same organizational domain"
     ]
 
+consistency_policies_raw :: Array String
+consistency_policies_raw = map show consistency_policies
+
 -- | Codec for just encoding a single value of type `ConsistencyPolicy`.
 codecConsistencyPolicy :: CA.JsonCodec ConsistencyPolicy
 codecConsistencyPolicy
@@ -235,6 +238,19 @@ data Policy
 policies :: Array Policy
 policies = [None, Quarantine, Reject]
 
+policies_raw :: Array String
+policies_raw = map show policies
+
+policies_txt :: Array String
+policies_txt =
+  [ "None (let the receiver decide)"
+  , "Quarantine (high spam score, flag, etc.)"
+  , "Reject"
+  ]
+
+policies_txt_with_null :: Array String
+policies_txt_with_null = [ "Do not provide policy advice" ] <> policies_txt
+
 -- | Codec for just encoding a single value of type `Policy`.
 codecPolicy :: CA.JsonCodec Policy
 codecPolicy = CA.prismaticCodec "Policy" str_to_policy generic_serialization CA.string

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 Int
+    }
+
+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.int
+    })
+
+emptyDomainInfo :: DomainInfo
+emptyDomainInfo
+  = { name: ""
+    , share_key: Nothing
+    , transfer_key: Nothing
+    , owners: []
+    }

src/App/Type/ResourceRecord.purs

@@ -232,8 +232,8 @@ emptyRR
     }
 
 data Qualifier = Pass | Neutral | SoftFail | HardFail
-all_qualifiers :: Array Qualifier
-all_qualifiers = [Pass, Neutral, SoftFail, HardFail]
+qualifiers :: Array Qualifier
+qualifiers = [Pass, Neutral, SoftFail, HardFail]
 qualifier_types :: Array String
 qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
 

src/Bulma.purs

@@ -61,6 +61,24 @@ 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 "" ]
+                       , 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 "" ]
+                       , 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" ]
@@ -538,12 +556,17 @@ tag_light_info str = HH.span [HP.classes (C.tag <> C.is_info <> C.is_light)] [HH
 div_large_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
 div_large_content content = HH.div [HP.classes (C.is_large <> C.content)] content
 
-div_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
-div_content content = HH.div [HP.classes (C.content)] content
+div_content :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+div_content classes content = HH.div [HP.classes (C.content <> classes)] content
 
 explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
 explanation content = HH.blockquote [HP.classes [HH.ClassName "justified"]] content
 
+quote :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+quote content = div_content [] [ explanation content ]
+
+simple_quote :: forall w i. String -> HH.HTML w i
+simple_quote content = quote [ p content ]
 
 tabs :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
 tabs classes tab_list = HH.div [HP.classes $ C.tabs <> classes] [HH.ul_ tab_list]
@@ -567,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 =
@@ -584,6 +610,12 @@ notification' classes value =
   HH.div [HP.classes (C.notification <> classes)]
          [ HH.text value ]
 
+notification_primary' :: forall w i. String -> HH.HTML w i
+notification_primary' value = notification' C.is_primary 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