New domains are now tested before submit.

This commit is contained in:
Philippe Pittoli 2023-07-25 16:47:29 +02:00
parent 729eedf475
commit fa4e6703ee

View File

@ -11,7 +11,7 @@
module App.DomainListInterface where
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>))
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), show)
import Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
@ -29,6 +29,9 @@ import Web.Event.Event (Event)
import Bulma as Bulma
import CSSClasses as C
import Parsing (runParser)
import DomainParser as DomainParser
import App.LogMessage
import App.Messages.DNSManagerDaemon as DNSManager
@ -108,6 +111,7 @@ data Action
type NewDomainFormState
= { new_domain :: String
, error_string :: Maybe String
, selected_domain :: String
}
@ -144,6 +148,7 @@ default_domain = "netlib.re"
initialState :: Input -> State
initialState _ =
{ newDomainForm: { new_domain: ""
, error_string: Nothing
, selected_domain: default_domain
}
, accepted_domains: [ default_domain ]
@ -198,7 +203,7 @@ render { accepted_domains, my_domains, newDomainForm, wsUp, active_modal }
newdomain_form
= [ Bulma.h3 "Add a domain!"
, render_adduser_form
, render_add_domain_form
]
list_of_own_domains
@ -221,13 +226,16 @@ render { accepted_domains, my_domains, newDomainForm, wsUp, active_modal }
[ HH.text domain ]
]
render_adduser_form = HH.form
render_add_domain_form = HH.form
[ HE.onSubmit NewDomainAttempt ]
[ Bulma.new_domain_field
(HandleNewDomainInput <<< INP_newdomain)
newDomainForm.new_domain
[ HHE.onSelectedIndexChange domain_choice ]
accepted_domains
, case newDomainForm.error_string of
Nothing -> HH.div_ []
Just str -> Bulma.strong str
]
domain_choice :: Int -> Action
@ -254,7 +262,11 @@ handleAction = case _ of
HandleNewDomainInput adduserinp -> do
case adduserinp of
INP_newdomain v -> H.modify_ _ { newDomainForm { new_domain = v } }
INP_newdomain v -> do
H.modify_ _ { newDomainForm { new_domain = v } }
case runParser v DomainParser.domain of
Left error_string -> H.modify_ _ { newDomainForm { error_string = Just $ show error_string } }
Right _ -> H.modify_ _ { newDomainForm { error_string = Nothing } }
UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
EnterDomain domain -> do