Show acceptable domains and my own domains.
parent
e77829b7a6
commit
a1c1c462c9
|
@ -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?!
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue