Compare commits

...

3 Commits

3 changed files with 61 additions and 10 deletions

View File

@ -92,8 +92,10 @@ data Action
| UpdateMyDomains (Array String) | UpdateMyDomains (Array String)
| HandleNewDomainInput NewDomainFormAction | HandleNewDomainInput NewDomainFormAction
| AskDomainTransferUUIDInput String
| NewDomainAttempt Event | NewDomainAttempt Event
| AskDomainTransferAttempt Event
| RemoveDomain String | RemoveDomain String
| EnterDomain String | EnterDomain String
@ -103,8 +105,9 @@ data Action
| Initialize | Initialize
| Finalize | Finalize
-- | The form only has two elements: -- | The form only has two visible elements:
-- | the subdomain name input and the selected TLD. -- | the subdomain name input and the selected TLD.
-- | The type also includes validation errors.
type NewDomainFormState type NewDomainFormState
= { new_domain :: String = { new_domain :: String
@ -112,11 +115,17 @@ type NewDomainFormState
, selected_domain :: String , 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 entire component's state contains the form, accepted domains,
-- | the list of own domains and a boolean to know if the connection is up. -- | the list of own domains and a boolean to know if the connection is up.
type State = type State =
{ newDomainForm :: NewDomainFormState { newDomainForm :: NewDomainFormState
, askDomainTransferForm :: AskDomainTransferState
, accepted_domains :: Array String , accepted_domains :: Array String
, my_domains :: Array String , my_domains :: Array String
@ -143,21 +152,27 @@ default_domain = "netlib.re"
initialState :: Input -> State initialState :: Input -> State
initialState _ = initialState _ =
{ newDomainForm: { new_domain: "" { newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain }
, _errors: [] , askDomainTransferForm: { uuid: "", _errors: [] }
, selected_domain: default_domain
}
, accepted_domains: [ default_domain ] , accepted_domains: [ default_domain ]
, my_domains: [ ] , my_domains: [ ]
, active_modal: Nothing , active_modal: Nothing
} }
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
render { accepted_domains, my_domains, newDomainForm, active_modal } render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, active_modal }
= Bulma.section_small = Bulma.section_small
[ case active_modal of [ case active_modal of
Nothing -> Bulma.columns_ Nothing -> Bulma.columns_
[ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form] [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form
, Bulma.hr
, Bulma.h3 "Ask for a domain transfer"
, Bulma.simple_quote """
Someone wants to give you the ownership of a domain.
Please enter the UUID of the transfer.
"""
, render_ask_domain_transfer_form
]
, Bulma.column_ [ Bulma.h3 "My domains" , Bulma.column_ [ Bulma.h3 "My domains"
, if A.length my_domains > 0 , if A.length my_domains > 0
then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_domains then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_domains
@ -196,6 +211,17 @@ render { accepted_domains, my_domains, newDomainForm, active_modal }
else HH.div_ [ ] else HH.div_ [ ]
] ]
render_ask_domain_transfer_form = HH.form
[ HE.onSubmit AskDomainTransferAttempt ]
[ Bulma.box_input "idTransferToken" "Transfer 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 :: Int -> Action
domain_choice i domain_choice i
= HandleNewDomainInput <<< UpdateSelectedDomain $ maybe default_domain (\x -> x) $ accepted_domains A.!! i = HandleNewDomainInput <<< UpdateSelectedDomain $ maybe default_domain (\x -> x) $ accepted_domains A.!! i
@ -229,6 +255,9 @@ handleAction = case _ of
Right _ -> H.modify_ _ { newDomainForm { _errors = [] } } Right _ -> H.modify_ _ { newDomainForm { _errors = [] } }
UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } } UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
AskDomainTransferUUIDInput str -> do
H.modify_ _ { askDomainTransferForm { uuid = toLower str } }
EnterDomain domain -> do EnterDomain domain -> do
H.raise $ ChangePageZoneInterface domain H.raise $ ChangePageZoneInterface domain
@ -249,7 +278,7 @@ handleAction = case _ of
case newDomainForm.new_domain, newDomainForm._errors, new_domain 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 _, [], _ -> do
message <- H.liftEffect message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
@ -260,6 +289,23 @@ handleAction = case _ of
_, _, _ -> _, _, _ ->
H.raise $ Log $ UnableToSend $ "The new domain name is invalid." 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.MkNewDomain { domain: new_domain }
--H.raise $ MessageToSend message
H.raise $ Log $ SystemLog $ "TODO: Ask for a domain transfer (" <> 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 :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
handleQuery = case _ of handleQuery = case _ of

View File

@ -1154,8 +1154,8 @@ render_resources records
show_token_or_btn rr = show_token_or_btn rr =
case rr.rrtype of case rr.rrtype of
"A" -> 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) "AAAA" -> Bulma.btn_ (C.is_small) "🏁​ Ask for a token" (NewToken rr.rrid)
_ -> HH.text "" _ -> HH.text ""
fancy_qualifier_display :: RR.Qualifier -> String fancy_qualifier_display :: RR.Qualifier -> String

View File

@ -544,6 +544,11 @@ div_content content = HH.div [HP.classes (C.content)] content
explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
explanation content = HH.blockquote [HP.classes [HH.ClassName "justified"]] content 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 :: 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] tabs classes tab_list = HH.div [HP.classes $ C.tabs <> classes] [HH.ul_ tab_list]