Pages do not handle connection states at all.
This commit is contained in:
parent
5d6c1b33e6
commit
35bda9c01b
@ -477,12 +477,9 @@ handleAction = case _ of
|
||||
|
||||
-- | `authd websocket component` wants to do something.
|
||||
AuthenticationDaemonEvent ev -> case ev of
|
||||
WS.MessageReceived (Tuple _ message) -> do
|
||||
handleAction $ DecodeAuthMessage message
|
||||
WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeAuthMessage message
|
||||
|
||||
WS.WSJustConnected -> do
|
||||
H.tell _ai unit AI.ConnectionIsUp
|
||||
H.tell _admini unit AdminInterface.ConnectionIsUp
|
||||
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
||||
token <- H.liftEffect $ Storage.getItem "user-authd-token" sessionstorage
|
||||
case token of
|
||||
@ -491,9 +488,7 @@ handleAction = case _ of
|
||||
handleAction $ Log $ SystemLog "Let's authenticate to authd"
|
||||
handleAction $ AuthenticateToAuthd (Left t)
|
||||
|
||||
WS.WSJustClosed -> do
|
||||
H.tell _ai unit AI.ConnectionIsDown
|
||||
H.tell _admini unit AdminInterface.ConnectionIsDown
|
||||
WS.WSJustClosed -> handleAction $ Log $ ErrorLog "You just got disconnected from authd."
|
||||
WS.Log message -> handleAction $ Log message
|
||||
WS.KeepAlive -> handleAction $ KeepAlive $ Left unit
|
||||
|
||||
@ -656,12 +651,9 @@ handleAction = case _ of
|
||||
|
||||
-- | `dnsmanagerd websocket component` wants to do something.
|
||||
DNSManagerDaemonEvent ev -> case ev of
|
||||
WS.MessageReceived (Tuple _ message) -> do
|
||||
handleAction $ DecodeDNSMessage message
|
||||
WS.WSJustConnected -> do
|
||||
handleAction AuthenticateToDNSManager
|
||||
H.tell _dli unit DomainListInterface.ConnectionIsUp
|
||||
WS.WSJustClosed -> H.tell _dli unit DomainListInterface.ConnectionIsDown
|
||||
WS.MessageReceived (Tuple _ message) -> handleAction $ DecodeDNSMessage message
|
||||
WS.WSJustConnected -> handleAction AuthenticateToDNSManager
|
||||
WS.WSJustClosed -> handleAction $ Log $ ErrorLog "You just got disconnected from dnsmanagerd."
|
||||
WS.Log message -> handleAction $ Log message
|
||||
WS.KeepAlive -> handleAction $ KeepAlive $ Right unit
|
||||
|
||||
|
@ -54,8 +54,6 @@ data Output
|
||||
|
||||
data Query a
|
||||
= MessageReceived AuthD.AnswerMessage a
|
||||
| ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
| GotOrphanDomainList (Array String) a
|
||||
| ProvideState (Maybe State) a
|
||||
|
||||
@ -104,7 +102,6 @@ type State =
|
||||
{ addUserForm :: StateAddUserForm
|
||||
, searchUserForm :: StateSearchUserForm
|
||||
, current_tab :: Tab
|
||||
, wsUp :: Boolean
|
||||
, matching_users :: Array UserPublic
|
||||
, orphan_domains :: Array String
|
||||
}
|
||||
@ -128,11 +125,10 @@ initialState _ = { addUserForm: { login: "", admin: false, email: "", pass: "
|
||||
, matching_users: []
|
||||
, orphan_domains: []
|
||||
, current_tab: Home
|
||||
, wsUp: true
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains, wsUp }
|
||||
render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domains }
|
||||
= Bulma.section_small
|
||||
[ fancy_tab_bar
|
||||
, case current_tab of
|
||||
@ -167,15 +163,14 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain
|
||||
, Bulma.btn_ (C.is_small) domain (ShowDomain domain)
|
||||
]
|
||||
up x = HandleAddUserInput <<< x
|
||||
active = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||
|
||||
render_adduser_form =
|
||||
HH.form
|
||||
[ HE.onSubmit PreventSubmit ]
|
||||
[ Bulma.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login active
|
||||
[ Bulma.box_input "login" "User login" "login" (up ADDUSER_INP_login) addUserForm.login
|
||||
, Bulma.btn_labeled "adminbtn" "Admin" (show addUserForm.admin) (HandleAddUserInput ADDUSER_toggle_admin)
|
||||
, Bulma.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email active
|
||||
, Bulma.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass active
|
||||
, Bulma.box_input "email" "User email" "email" (up ADDUSER_INP_email) addUserForm.email
|
||||
, Bulma.box_password "password" "User password" "password" (up ADDUSER_INP_pass) addUserForm.pass
|
||||
, Bulma.btn "Send" AddUserAttempt
|
||||
]
|
||||
|
||||
@ -186,11 +181,11 @@ render { addUserForm, searchUserForm, matching_users, current_tab, orphan_domain
|
||||
Following input accepts any regex.
|
||||
This is used to search for a user based on their login, full name or email address.
|
||||
"""
|
||||
, Bulma.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex active
|
||||
, Bulma.box_input "regex" "Regex" "regex" (up SEARCHUSER_INP_regex) searchUserForm.regex
|
||||
--, Bulma.btn_labeled "adminbtn" "Admin" (show searchUserForm.admin)
|
||||
-- (HandleAddUserInput SEARCHUSER_toggle_admin)
|
||||
--, Bulma.box_input "domain" "Domain owned" "blah.netlib.re."
|
||||
-- (up SEARCHUSER_INP_domain) searchUserForm.domain active
|
||||
-- (up SEARCHUSER_INP_domain) searchUserForm.domain
|
||||
, Bulma.btn "Send" SearchUserAttempt
|
||||
]
|
||||
|
||||
@ -315,14 +310,6 @@ handleQuery = case _ of
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Authentication server didn't send a valid message."
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
|
||||
GotOrphanDomainList domains a -> do
|
||||
H.modify_ _ { orphan_domains = domains }
|
||||
pure (Just a)
|
||||
|
@ -61,8 +61,6 @@ data Output
|
||||
-- | Also, the component is informed when the connection went up or down.
|
||||
data Query a
|
||||
= MessageReceived AuthD.AnswerMessage a
|
||||
| ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
@ -109,7 +107,6 @@ type State =
|
||||
, passwordRecoveryForm :: StatePasswordRecoveryForm
|
||||
, newPasswordForm :: StateNewPasswordForm
|
||||
, errors :: Array Error
|
||||
, wsUp :: Boolean
|
||||
, current_tab :: Tab
|
||||
}
|
||||
|
||||
@ -118,7 +115,6 @@ initialState _ =
|
||||
{ authenticationForm: { login: "", pass: "" }
|
||||
, passwordRecoveryForm: { login: "", email: "" }
|
||||
, newPasswordForm: { login: "", token: "", password: "", confirmation: "" }
|
||||
, wsUp: true
|
||||
, errors: []
|
||||
, current_tab: Auth
|
||||
}
|
||||
@ -136,15 +132,13 @@ component =
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { wsUp, current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
|
||||
render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm, errors } =
|
||||
Bulma.section_small
|
||||
[ fancy_tab_bar
|
||||
, if A.length errors > 0
|
||||
then HH.div_ [ Bulma.box [ HH.text (A.fold $ map show_error errors) ] ]
|
||||
else HH.div_ []
|
||||
, case wsUp of
|
||||
false -> Bulma.p "You are disconnected."
|
||||
true -> case current_tab of
|
||||
, case current_tab of
|
||||
Auth -> Bulma.box auth_form
|
||||
ILostMyPassword -> Bulma.box passrecovery_form
|
||||
Recovery -> Bulma.box newpass_form
|
||||
@ -219,18 +213,14 @@ render { wsUp, current_tab, authenticationForm, passwordRecoveryForm, newPasswor
|
||||
, render_new_password_form
|
||||
]
|
||||
|
||||
should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||
|
||||
render_auth_form = HH.form
|
||||
[ HE.onSubmit AuthenticationAttempt ]
|
||||
[ Bulma.box_input "loginLOGIN" "Login" "login" -- title, placeholder
|
||||
(HandleAuthenticationInput <<< AUTH_INP_login) -- action
|
||||
authenticationForm.login -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.box_password "passwordLOGIN" "Password" "password" -- title, placeholder
|
||||
(HandleAuthenticationInput <<< AUTH_INP_pass) -- action
|
||||
authenticationForm.pass -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.btn_validation
|
||||
|
||||
]
|
||||
@ -240,11 +230,9 @@ render { wsUp, current_tab, authenticationForm, passwordRecoveryForm, newPasswor
|
||||
[ Bulma.box_input "loginPASSR" "Login" "login" -- title, placeholder
|
||||
(HandlePasswordRecovery <<< PASSR_INP_login) -- action
|
||||
passwordRecoveryForm.login -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.box_input "emailPASSR" "Email" "email" -- title, placeholder
|
||||
(HandlePasswordRecovery <<< PASSR_INP_email) -- action
|
||||
passwordRecoveryForm.email -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.btn_validation
|
||||
]
|
||||
|
||||
@ -253,19 +241,15 @@ render { wsUp, current_tab, authenticationForm, passwordRecoveryForm, newPasswor
|
||||
[ Bulma.box_input "loginNEWPASS" "Login" "login"
|
||||
(HandleNewPassword <<< NEWPASS_INP_login)
|
||||
newPasswordForm.login
|
||||
should_be_disabled
|
||||
, Bulma.box_input "tokenNEWPASS" "Token" "token"
|
||||
(HandleNewPassword <<< NEWPASS_INP_token)
|
||||
newPasswordForm.token
|
||||
should_be_disabled
|
||||
, Bulma.box_password "passwordNEWPASS" "Password" "password"
|
||||
(HandleNewPassword <<< NEWPASS_INP_password)
|
||||
newPasswordForm.password
|
||||
should_be_disabled
|
||||
, Bulma.box_password "confirmationNEWPASS" "Confirmation" "confirmation"
|
||||
(HandleNewPassword <<< NEWPASS_INP_confirmation)
|
||||
newPasswordForm.confirmation
|
||||
should_be_disabled
|
||||
, Bulma.btn_validation
|
||||
]
|
||||
|
||||
@ -386,11 +370,3 @@ handleQuery = case _ of
|
||||
_ -> do
|
||||
H.raise $ Log $ ErrorLog $ "Message not handled in AuthenticationInterface."
|
||||
pure Nothing
|
||||
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
|
@ -64,8 +64,6 @@ data Output
|
||||
|
||||
data Query a
|
||||
= MessageReceived DNSManager.AnswerMessage a
|
||||
| ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
| ProvideState (Maybe State) a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
@ -122,7 +120,6 @@ type State =
|
||||
, accepted_domains :: Array String
|
||||
, my_domains :: Array String
|
||||
|
||||
, wsUp :: Boolean
|
||||
, active_modal :: Maybe String
|
||||
}
|
||||
|
||||
@ -152,16 +149,13 @@ initialState _ =
|
||||
}
|
||||
, accepted_domains: [ default_domain ]
|
||||
, my_domains: [ ]
|
||||
, wsUp: true
|
||||
, active_modal: Nothing
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { accepted_domains, my_domains, newDomainForm, wsUp, active_modal }
|
||||
render { accepted_domains, my_domains, newDomainForm, active_modal }
|
||||
= Bulma.section_small
|
||||
[ case wsUp of
|
||||
false -> Bulma.p "You are disconnected."
|
||||
true -> case active_modal of
|
||||
[ case active_modal of
|
||||
Nothing -> Bulma.columns_
|
||||
[ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form]
|
||||
, Bulma.column_ [ Bulma.h3 "My domains"
|
||||
@ -293,14 +287,6 @@ handleQuery = case _ of
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
|
||||
page_reload :: State -> DNSManager.AnswerMessage -> State
|
||||
page_reload s1 message =
|
||||
case message of
|
||||
|
@ -30,9 +30,7 @@ data Output
|
||||
| Log LogMessage
|
||||
|
||||
-- | The component is informed when the connection went up or down.
|
||||
data Query a
|
||||
= ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
data Query a = DoNothing a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
@ -65,7 +63,6 @@ type MailValidationForm = { login :: String, token :: String }
|
||||
type State =
|
||||
{ mailValidationForm :: MailValidationForm
|
||||
, errors :: Array Error
|
||||
, wsUp :: Boolean
|
||||
}
|
||||
|
||||
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||
@ -75,7 +72,6 @@ component =
|
||||
, render
|
||||
, eval: H.mkEval $ H.defaultEval
|
||||
{ handleAction = handleAction
|
||||
, handleQuery = handleQuery
|
||||
}
|
||||
}
|
||||
|
||||
@ -83,33 +79,24 @@ initialState :: Input -> State
|
||||
initialState _ =
|
||||
{ mailValidationForm: { login: "", token: "" }
|
||||
, errors: []
|
||||
, wsUp: true
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { wsUp, mailValidationForm }
|
||||
= Bulma.section_small
|
||||
[ case wsUp of
|
||||
false -> Bulma.p "You are disconnected."
|
||||
true -> Bulma.columns_ [ b mail_validation_form ]
|
||||
]
|
||||
render { mailValidationForm }
|
||||
= Bulma.section_small [ Bulma.columns_ [ b mail_validation_form ] ]
|
||||
|
||||
where
|
||||
b e = Bulma.column_ [ Bulma.box e ]
|
||||
mail_validation_form = [ Bulma.h3 "Verify your account", render_register_form ]
|
||||
|
||||
should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||
|
||||
render_register_form = HH.form
|
||||
[ HE.onSubmit ValidateInputs ]
|
||||
[ Bulma.box_input "loginValidation" "Login" "login" -- title, placeholder
|
||||
(HandleValidationInput <<< VALIDATION_INP_login) -- action
|
||||
mailValidationForm.login -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.box_input "tokenValidation" "Token" "token" -- title, placeholder
|
||||
(HandleValidationInput <<< VALIDATION_INP_token) -- action
|
||||
mailValidationForm.token -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.btn_validation
|
||||
]
|
||||
|
||||
@ -178,13 +165,3 @@ string_error_token = case _ of
|
||||
T.Size min max n -> "token size should be between "
|
||||
<> show min <> " and " <> show max
|
||||
<> " (currently: " <> show n <> ")"
|
||||
|
||||
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
||||
handleQuery = case _ of
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
|
@ -30,10 +30,7 @@ data Output
|
||||
= MessageToSend ArrayBuffer
|
||||
| Log LogMessage
|
||||
|
||||
-- | The component is informed when the connection went up or down.
|
||||
data Query a
|
||||
= ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
data Query a = DoNothing a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
@ -68,14 +65,12 @@ type StateRegistrationForm = { login :: String, email :: String, pass :: String
|
||||
type State =
|
||||
{ registrationForm :: StateRegistrationForm
|
||||
, errors :: Array Error
|
||||
, wsUp :: Boolean
|
||||
}
|
||||
|
||||
initialState :: Input -> State
|
||||
initialState _ =
|
||||
{ registrationForm: { login: "", email: "", pass: "" }
|
||||
, errors: []
|
||||
, wsUp: true
|
||||
}
|
||||
|
||||
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||
@ -85,38 +80,28 @@ component =
|
||||
, render
|
||||
, eval: H.mkEval $ H.defaultEval
|
||||
{ handleAction = handleAction
|
||||
, handleQuery = handleQuery
|
||||
}
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { wsUp, registrationForm }
|
||||
= Bulma.section_small
|
||||
[ case wsUp of
|
||||
false -> Bulma.p "You are disconnected."
|
||||
true -> Bulma.columns_ [ b registration_form ]
|
||||
]
|
||||
render { registrationForm }
|
||||
= Bulma.section_small [Bulma.columns_ [ b registration_form ]]
|
||||
|
||||
where
|
||||
b e = Bulma.column_ [ Bulma.box e ]
|
||||
registration_form = [ Bulma.h3 "Register", render_register_form ]
|
||||
|
||||
should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||
|
||||
render_register_form = HH.form
|
||||
[ HE.onSubmit ValidateInputs ]
|
||||
[ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder
|
||||
(HandleRegisterInput <<< REG_INP_login) -- action
|
||||
registrationForm.login -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.box_input "emailREGISTER" "Email" "email@example.com" -- title, placeholder
|
||||
(HandleRegisterInput <<< REG_INP_email) -- action
|
||||
registrationForm.email -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.box_password "passwordREGISTER" "Password" "password" -- title, placeholder
|
||||
(HandleRegisterInput <<< REG_INP_pass) -- action
|
||||
registrationForm.pass -- value
|
||||
should_be_disabled -- condition
|
||||
, Bulma.btn_validation
|
||||
]
|
||||
|
||||
@ -207,13 +192,3 @@ string_error_password = case _ of
|
||||
P.Size min max n -> "password size should be between "
|
||||
<> show min <> " and " <> show max
|
||||
<> " (currently: " <> show n <> ")"
|
||||
|
||||
handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a)
|
||||
handleQuery = case _ of
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
|
@ -28,12 +28,8 @@ data Output
|
||||
| DeleteUserAccount
|
||||
|
||||
-- | The component's parent provides received messages.
|
||||
-- |
|
||||
-- | Also, the component is informed when the connection went up or down.
|
||||
data Query a
|
||||
= MessageReceived AuthD.AnswerMessage a
|
||||
| ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
@ -64,7 +60,6 @@ data Modal
|
||||
type State =
|
||||
{ newPasswordForm :: StateNewPasswordForm
|
||||
, token :: String
|
||||
, wsUp :: Boolean
|
||||
, modal :: Modal
|
||||
}
|
||||
|
||||
@ -84,11 +79,10 @@ initialState token =
|
||||
{ newPasswordForm: { password: "", confirmation: "" }
|
||||
, token
|
||||
, modal: NoModal
|
||||
, wsUp: true
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { modal, wsUp, newPasswordForm } =
|
||||
render { modal, newPasswordForm } =
|
||||
Bulma.section_small
|
||||
[ case modal of
|
||||
DeleteAccountModal -> render_delete_account_modal
|
||||
@ -99,7 +93,6 @@ render { modal, wsUp, newPasswordForm } =
|
||||
|
||||
where
|
||||
b e = Bulma.column_ e
|
||||
should_be_disabled = (if wsUp then (HP.enabled true) else (HP.disabled true))
|
||||
|
||||
render_delete_account = Bulma.alert_btn "Delete my account" DeleteAccountPopup
|
||||
render_new_password_form = HH.form
|
||||
@ -107,11 +100,9 @@ render { modal, wsUp, newPasswordForm } =
|
||||
[ Bulma.box_password "passwordNEWPASS" "New Password" "password"
|
||||
(HandleNewPassword <<< NEWPASS_INP_password)
|
||||
newPasswordForm.password
|
||||
should_be_disabled
|
||||
, Bulma.box_password "confirmationNEWPASS" "Confirmation" "confirmation"
|
||||
(HandleNewPassword <<< NEWPASS_INP_confirmation)
|
||||
newPasswordForm.confirmation
|
||||
should_be_disabled
|
||||
, Bulma.btn_validation
|
||||
]
|
||||
|
||||
@ -181,11 +172,3 @@ handleQuery = case _ of
|
||||
_ -> do
|
||||
H.raise $ Log $ ErrorLog $ "Message not handled in SetupInterface."
|
||||
pure Nothing
|
||||
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
|
@ -2,19 +2,16 @@
|
||||
-- |
|
||||
-- | This interface allows to:
|
||||
-- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
|
||||
-- | - TODO: dedicated interfaces for: SPF, DKIM, DMARC
|
||||
-- | - provide dedicated interfaces for SPF and DKIM (TODO: DMARC)
|
||||
-- | - add, modify, remove resource records
|
||||
-- |
|
||||
-- | **WIP**: Display relevant information for each record type in the (add/mod) modal.
|
||||
-- | This includes explaining use cases and displaying an appropriate interface for the
|
||||
-- | task at hand. For example, having a dedicated interface for DKIM.
|
||||
-- | This includes explaining use cases and displaying an appropriate interface for the task at hand.
|
||||
-- |
|
||||
-- | TODO: display errors not only for a record but for the whole zone.
|
||||
-- | A DNS zone is bound by a set of rules, the whole zone must be consistent.
|
||||
-- | For example, a CNAME `target` has to point to the `name` of an existing record.
|
||||
-- |
|
||||
-- | TODO: do not allow for the modification of read-only resource records.
|
||||
-- |
|
||||
-- | TODO: move all serialization code to a single module.
|
||||
module App.Page.Zone where
|
||||
|
||||
@ -23,6 +20,8 @@ import Prelude (Unit, unit, void
|
||||
, not, comparing, discard, map, show
|
||||
, (+), (&&), ($), (/=), (<<<), (<>), (==), (>), (#))
|
||||
|
||||
--import Data.Generic.Rep (class Generic)
|
||||
--import Data.Show.Generic (genericShow)
|
||||
|
||||
import Data.Eq (class Eq)
|
||||
import Data.Array as A
|
||||
@ -77,13 +76,9 @@ data Output
|
||||
| Log LogMessage
|
||||
|
||||
-- | `App.ZoneInterface` can receive messages from `dnsmanagerd`.
|
||||
-- |
|
||||
-- | The component is also informed when the connection is lost or up again.
|
||||
|
||||
data Query a
|
||||
= MessageReceived DNSManager.AnswerMessage a
|
||||
| ConnectionIsDown a
|
||||
| ConnectionIsUp a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
@ -205,10 +200,12 @@ string_to_acceptedtype str = case str of
|
||||
|
||||
data Tab = Zone | TokenExplanation
|
||||
derive instance eqTab :: Eq Tab
|
||||
--derive instance genericTab :: Generic Tab _
|
||||
--instance showTab :: Show Tab where
|
||||
-- show = genericShow
|
||||
|
||||
type State =
|
||||
{ _domain :: String
|
||||
, wsUp :: Boolean
|
||||
|
||||
-- A modal to present a form for adding a new RR.
|
||||
, rr_modal :: RRModal
|
||||
@ -262,8 +259,7 @@ default_qualifier_str = "hard_fail" :: String
|
||||
|
||||
initialState :: Input -> State
|
||||
initialState domain =
|
||||
{ wsUp: true
|
||||
, rr_modal: NoModal
|
||||
{ rr_modal: NoModal
|
||||
|
||||
, _domain: domain
|
||||
|
||||
@ -305,12 +301,11 @@ render state
|
||||
is_tab_active tab = state.current_tab == tab
|
||||
|
||||
render_zone =
|
||||
case state.wsUp, state.rr_modal of
|
||||
false, _ -> Bulma.p "You are disconnected."
|
||||
true, RemoveRRModal rr_id -> modal_rr_delete rr_id
|
||||
true, NewRRModal _ -> render_current_rr_modal
|
||||
true, UpdateRRModal -> render_current_rr_modal
|
||||
true, NoModal -> HH.div_
|
||||
case state.rr_modal of
|
||||
RemoveRRModal rr_id -> modal_rr_delete rr_id
|
||||
NewRRModal _ -> render_current_rr_modal
|
||||
UpdateRRModal -> render_current_rr_modal
|
||||
NoModal -> HH.div_
|
||||
[ Bulma.h1 state._domain
|
||||
, Bulma.hr
|
||||
, render_resources $ sorted state._resources
|
||||
@ -366,13 +361,12 @@ render state
|
||||
, Bulma.box_input ("ttl" <> state._currentRR.rrtype) "TTL" "600"
|
||||
(updateForm Field_TTL)
|
||||
(show state._currentRR.ttl)
|
||||
should_be_disabled
|
||||
, case state._currentRR.rrtype of
|
||||
"AAAA" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "2001:db8::1" (updateForm Field_Target) state._currentRR.target should_be_disabled
|
||||
"TXT" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Your text" "blah blah" (updateForm Field_Target) state._currentRR.target should_be_disabled
|
||||
"CNAME" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "www" (updateForm Field_Target) state._currentRR.target should_be_disabled
|
||||
"NS" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "ns0.example.com." (updateForm Field_Target) state._currentRR.target should_be_disabled
|
||||
_ -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "198.51.100.5" (updateForm Field_Target) state._currentRR.target should_be_disabled
|
||||
"AAAA" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "2001:db8::1" (updateForm Field_Target) state._currentRR.target
|
||||
"TXT" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Your text" "blah blah" (updateForm Field_Target) state._currentRR.target
|
||||
"CNAME" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "www" (updateForm Field_Target) state._currentRR.target
|
||||
"NS" -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "ns0.example.com." (updateForm Field_Target) state._currentRR.target
|
||||
_ -> Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "198.51.100.5" (updateForm Field_Target) state._currentRR.target
|
||||
] <> case state.rr_modal of
|
||||
UpdateRRModal ->
|
||||
if A.elem state._currentRR.rrtype ["A", "AAAA"]
|
||||
@ -391,15 +385,12 @@ render state
|
||||
, Bulma.box_input ("ttlMX") "TTL" "600"
|
||||
(updateForm Field_TTL)
|
||||
(show state._currentRR.ttl)
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("targetMX") "Target" "www"
|
||||
(updateForm Field_Target)
|
||||
state._currentRR.target
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("priorityMX") "Priority" "10"
|
||||
(updateForm Field_Priority)
|
||||
(maybe "" show state._currentRR.priority)
|
||||
should_be_disabled
|
||||
]
|
||||
modal_content_srv :: Array (HH.HTML w Action)
|
||||
modal_content_srv =
|
||||
@ -408,31 +399,24 @@ render state
|
||||
, Bulma.box_input "domainSRV" "Service name" "service name"
|
||||
(updateForm Field_Domain)
|
||||
state._currentRR.name
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("protocolSRV") "Protocol" "tcp"
|
||||
(updateForm Field_Protocol)
|
||||
(fromMaybe "tcp" state._currentRR.protocol)
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("targetSRV") "Where the server is" "www"
|
||||
(updateForm Field_Target)
|
||||
state._currentRR.target
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("portSRV") "Port of the service" "5061"
|
||||
(updateForm Field_Port)
|
||||
(maybe "" show state._currentRR.port)
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("prioritySRV") "Priority" "10"
|
||||
(updateForm Field_Priority)
|
||||
(maybe "" show state._currentRR.priority)
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("ttlSRV") "TTL" "600"
|
||||
(updateForm Field_TTL)
|
||||
(show state._currentRR.ttl)
|
||||
should_be_disabled
|
||||
, Bulma.box_input ("weightSRV") "Weight" "100"
|
||||
(updateForm Field_Weight)
|
||||
(maybe "" show state._currentRR.weight)
|
||||
should_be_disabled
|
||||
]
|
||||
modal_content_spf :: Array (HH.HTML w Action)
|
||||
modal_content_spf =
|
||||
@ -445,10 +429,9 @@ render state
|
||||
, Bulma.box_input "ttlSPF" "TTL" "600"
|
||||
(updateForm Field_TTL)
|
||||
(show state._currentRR.ttl)
|
||||
should_be_disabled
|
||||
--, case state._currentRR.v of
|
||||
-- Nothing -> Bulma.p "default value for the version (spf1)"
|
||||
-- Just v -> Bulma.box_input "vSPF" "Version" "spf1" (updateForm Field_SPF_v) v should_be_disabled
|
||||
-- Just v -> Bulma.box_input "vSPF" "Version" "spf1" (updateForm Field_SPF_v) v
|
||||
, Bulma.hr
|
||||
, maybe (Bulma.p "no mechanism") display_mechanisms state._currentRR.mechanisms
|
||||
, Bulma.box
|
||||
@ -458,7 +441,6 @@ render state
|
||||
, Bulma.box_input "valueNewMechanismSPF" "Value" ""
|
||||
SPF_Mechanism_v
|
||||
state.spf_mechanism_v
|
||||
should_be_disabled
|
||||
, Bulma.btn "Add" SPF_Mechanism_Add
|
||||
]
|
||||
, Bulma.hr
|
||||
@ -469,7 +451,6 @@ render state
|
||||
, Bulma.box_input "valueNewModifierSPF" "Value" ""
|
||||
SPF_Modifier_v
|
||||
state.spf_modifier_v
|
||||
should_be_disabled
|
||||
, Bulma.btn "Add" SPF_Modifier_Add
|
||||
]
|
||||
, Bulma.hr
|
||||
@ -490,7 +471,6 @@ render state
|
||||
, Bulma.box_input "ttlDKIM" "TTL" "600"
|
||||
(updateForm Field_TTL)
|
||||
(show state._currentRR.ttl)
|
||||
should_be_disabled
|
||||
, Bulma.hr
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
|
||||
, Bulma.selection_field "idDKIMSignature" "Signature algo"
|
||||
@ -501,16 +481,11 @@ render state
|
||||
DKIM_hash_algo
|
||||
(map show DKIM.hash_algos)
|
||||
(show $ fromMaybe DKIM.SHA256 state.dkim.h)
|
||||
, Bulma.box_input "pkDKIM" "Public Key" "Your public key, such as 'MIIBIjANBgqh...'"
|
||||
DKIM_pubkey state.dkim.p should_be_disabled
|
||||
, Bulma.box_input "noteDKIM" "Note" "Note for fellow administrators."
|
||||
DKIM_note
|
||||
(fromMaybe "" state.dkim.n)
|
||||
should_be_disabled
|
||||
, Bulma.box_input "pkDKIM" "Public Key" "Your public key, such as 'MIIBIjANBgqh...'" DKIM_pubkey state.dkim.p
|
||||
, Bulma.box_input "noteDKIM" "Note" "Note for fellow administrators." DKIM_note (fromMaybe "" state.dkim.n)
|
||||
]
|
||||
|
||||
display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain)
|
||||
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
|
||||
newtokenbtn = Bulma.btn "🏁 Ask for a token!" (NewToken state._currentRR.rrid)
|
||||
foot_content x =
|
||||
case state.rr_modal of
|
||||
@ -768,14 +743,6 @@ handleQuery = case _ of
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in ZoneInterface."
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsDown a -> do
|
||||
H.modify_ _ { wsUp = false }
|
||||
pure (Just a)
|
||||
|
||||
ConnectionIsUp a -> do
|
||||
H.modify_ _ { wsUp = true }
|
||||
pure (Just a)
|
||||
|
||||
where
|
||||
-- replace_entry :: ResourceRecord
|
||||
replace_entry new_rr = do
|
||||
|
@ -258,8 +258,8 @@ div_field_content content
|
||||
[ HH.div [HP.classes C.field ] [ HH.div [HP.classes C.control ] [ content ] ] ]
|
||||
|
||||
field_inner :: forall w i.
|
||||
Boolean -> String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
|
||||
field_inner ispassword id title placeholder action value cond
|
||||
Boolean -> (HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
|
||||
field_inner ispassword cond id title placeholder action value
|
||||
= div_field
|
||||
[ div_field_label id title
|
||||
, div_field_content $ render_input ispassword id placeholder action value cond
|
||||
@ -286,13 +286,19 @@ labeled_field id title content
|
||||
, div_field_content content
|
||||
]
|
||||
|
||||
box_input :: forall w i.
|
||||
String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
|
||||
box_input = field_inner false
|
||||
box_input_ :: forall w i.
|
||||
(HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
|
||||
box_input_ = field_inner false
|
||||
|
||||
box_password :: forall w i.
|
||||
String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i
|
||||
box_password = field_inner true
|
||||
box_password_ :: forall w i.
|
||||
(HP.IProp DHI.HTMLinput i) -> String -> String -> String -> (String -> i) -> String -> HH.HTML w i
|
||||
box_password_ = field_inner true
|
||||
|
||||
box_input :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
|
||||
box_input = box_input_ (HP.enabled true)
|
||||
|
||||
box_password :: forall w i. String -> String -> String -> (String -> i) -> String -> HH.HTML w i
|
||||
box_password = box_password_ (HP.enabled true)
|
||||
|
||||
section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
|
||||
section_small = HH.section [ HP.classes (C.section <> C.is_small) ]
|
||||
|
Loading…
Reference in New Issue
Block a user