Show acceptable domains and my own domains.

beta
Philippe Pittoli 2023-06-30 01:56:40 +02:00
parent e77829b7a6
commit a1c1c462c9
2 changed files with 57 additions and 2 deletions

View File

@ -152,6 +152,9 @@ data Action
| WebSocketParseError String | WebSocketParseError String
| ConnectWebSocket | ConnectWebSocket
| UpdateAcceptedDomains (Array String)
| UpdateMyDomains (Array String)
| AuthenticateToDNSManager | AuthenticateToDNSManager
| HandleNewDomainInput NewDomainFormAction | HandleNewDomainInput NewDomainFormAction
@ -170,6 +173,9 @@ type State =
, token :: String , token :: String
, newDomainForm :: NewDomainFormState , newDomainForm :: NewDomainFormState
, accepted_domains :: Array String
, my_domains :: Array String
-- TODO: put network stuff in a record. -- TODO: put network stuff in a record.
, wsUrl :: String , wsUrl :: String
, wsConnection :: Maybe WS.WebSocket , wsConnection :: Maybe WS.WebSocket
@ -196,6 +202,9 @@ initialState (Tuple url token) =
, token: token , token: token
, newDomainForm: { new_domain: "" } , newDomainForm: { new_domain: "" }
, accepted_domains: [ "netlib.re" ]
, my_domains: [ ]
-- TODO: put network stuff in a record. -- TODO: put network stuff in a record.
, wsUrl: url , wsUrl: url
, wsConnection: Nothing , wsConnection: Nothing
@ -205,11 +214,15 @@ initialState (Tuple url token) =
render :: forall m. State -> H.ComponentHTML Action () m render :: forall m. State -> H.ComponentHTML Action () m
render { render {
messages, messages,
accepted_domains,
my_domains,
wsConnection, wsConnection,
canReconnect, canReconnect,
newDomainForm } newDomainForm }
= HH.div_ = HH.div_
[ Bulma.columns_ [ Bulma.column_ newdomain_form, Bulma.column_ list_of_own_domains ] [ Bulma.columns_ [ Bulma.column_ newdomain_form
, Bulma.column_ list_acceptable_domains
, Bulma.column_ list_of_own_domains ]
, render_messages , render_messages
, renderReconnectButton (isNothing wsConnection && canReconnect) , renderReconnectButton (isNothing wsConnection && canReconnect)
] ]
@ -220,8 +233,15 @@ render {
, render_adduser_form , render_adduser_form
] ]
list_acceptable_domains
= [ Bulma.h3 "Acceptable domains:"
, HH.ul_ $ map (\domain -> HH.li_ [ HH.text domain ]) accepted_domains
]
list_of_own_domains list_of_own_domains
= [ Bulma.h3 "You domains: (TODO)" ] = [ Bulma.h3 "My domains:"
, HH.ul_ $ map (\domain -> HH.li_ [ HH.text domain ]) my_domains
]
should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection) should_be_disabled = (maybe (HP.disabled true) (\_ -> HP.enabled true) wsConnection)
@ -288,6 +308,12 @@ handleAction = case _ of
H.modify_ _ { wsConnection = Just webSocket } H.modify_ _ { wsConnection = Just webSocket }
void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket) void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
UpdateAcceptedDomains domains -> do
H.modify_ _ { accepted_domains = domains }
UpdateMyDomains domains -> do
H.modify_ _ { my_domains = domains }
AuthenticateToDNSManager -> do AuthenticateToDNSManager -> do
{ wsConnection, token } <- H.get { wsConnection, token } <- H.get
appendMessage $ "[🤖] Trying to authenticate..." appendMessage $ "[🤖] Trying to authenticate..."
@ -362,6 +388,20 @@ handleAction = case _ of
appendMessage $ "[😈] Failed connection! Invalid token!" appendMessage $ "[😈] Failed connection! Invalid token!"
(DNSManager.MkDomainAlreadyExists _) -> do (DNSManager.MkDomainAlreadyExists _) -> do
appendMessage $ "[😈] Failed! The domain already exists." appendMessage $ "[😈] Failed! The domain already exists."
(DNSManager.MkUnacceptableDomain _) -> do
appendMessage $ "[😈] Failed! The domain is not acceptable (not in the list of accepted domains)."
(DNSManager.MkAcceptedDomains response) -> do
appendMessage $ "[😈] Received the list of accepted domains!"
handleAction $ UpdateAcceptedDomains response.domains
(DNSManager.MkLogged response) -> do
appendMessage $ "[😈] Logged!"
handleAction $ UpdateAcceptedDomains response.accepted_domains
handleAction $ UpdateMyDomains response.my_domains
(DNSManager.MkInvalidDomainName _) -> do
appendMessage $ "[😈] Failed! The domain is not valid!"
(DNSManager.MkSuccess _) -> do (DNSManager.MkSuccess _) -> do
appendMessage $ "[😈] Success!" appendMessage $ "[😈] Success!"
-- WTH?! -- WTH?!

View File

@ -158,6 +158,17 @@ type DomainList = { domains :: Array String }
codecDomainList ∷ CA.JsonCodec DomainList codecDomainList ∷ CA.JsonCodec DomainList
codecDomainList = CA.object "DomainList" (CAR.record { domains: CA.array CA.string }) codecDomainList = CA.object "DomainList" (CAR.record { domains: CA.array CA.string })
{- 15 -}
type AcceptedDomains = { domains :: Array String }
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 }
codecLogged ∷ CA.JsonCodec Logged
codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string
, my_domains: CA.array CA.string })
{- 50 -} {- 50 -}
type UnknownUser = { } type UnknownUser = { }
codecUnknownUser ∷ CA.JsonCodec UnknownUser codecUnknownUser ∷ CA.JsonCodec UnknownUser
@ -198,6 +209,8 @@ data AnswerMessage
| MkZone Zone -- 12 | MkZone Zone -- 12
| MkUnknownZone UnknownZone -- 13 | MkUnknownZone UnknownZone -- 13
| MkDomainList DomainList -- 14 | MkDomainList DomainList -- 14
| MkAcceptedDomains AcceptedDomains -- 15
| MkLogged Logged -- 16
| MkUnknownUser UnknownUser -- 50 | MkUnknownUser UnknownUser -- 50
| MkNoOwnership NoOwnership -- 51 | MkNoOwnership NoOwnership -- 51
@ -240,6 +253,8 @@ decode number string
12 -> error_management codecZone MkZone 12 -> error_management codecZone MkZone
13 -> error_management codecUnknownZone MkUnknownZone 13 -> error_management codecUnknownZone MkUnknownZone
14 -> error_management codecDomainList MkDomainList 14 -> error_management codecDomainList MkDomainList
15 -> error_management codecAcceptedDomains MkAcceptedDomains
16 -> error_management codecLogged MkLogged
50 -> error_management codecUnknownUser MkUnknownUser 50 -> error_management codecUnknownUser MkUnknownUser
51 -> error_management codecNoOwnership MkNoOwnership 51 -> error_management codecNoOwnership MkNoOwnership
_ -> Left UnknownNumber _ -> Left UnknownNumber