Compare commits
18 Commits
103fb0d643
...
dcc587bd19
Author | SHA1 | Date | |
---|---|---|---|
dcc587bd19 | |||
2f75e29991 | |||
cfd1ecf265 | |||
a43884f98a | |||
06a52e6480 | |||
e1c069c497 | |||
108c78a206 | |||
67d0ca700f | |||
ea2160b857 | |||
04f9334f29 | |||
96f82adf6b | |||
9346e81861 | |||
c98de0e4f0 | |||
797f2ce248 | |||
b4a75feca0 | |||
d8c78e4370 | |||
0605cf1a05 | |||
4181c86c82 |
@ -573,42 +573,45 @@ handleAction = case _ of
|
||||
handleAction $ AddNotif $ GoodNotification "Your password recovery mail has been sent."
|
||||
handleAction $ DispatchAuthDaemonMessage m
|
||||
(AuthD.GotErrorPasswordTooShort _) -> do
|
||||
handleAction $ Log $ ErrorLog "Password too short!"
|
||||
handleAction $ Log $ ErrorLog "Password too short."
|
||||
handleAction $ AddNotif $ BadNotification "The server told that your password is too short."
|
||||
(AuthD.GotErrorMailRequired _) -> do
|
||||
handleAction $ Log $ ErrorLog "Email required!"
|
||||
handleAction $ Log $ ErrorLog "Email required."
|
||||
handleAction $ AddNotif $ BadNotification "An email is required."
|
||||
(AuthD.GotErrorInvalidCredentials _) -> do
|
||||
handleAction $ Log $ ErrorLog "Invalid credentials!"
|
||||
handleAction $ Log $ ErrorLog "Invalid credentials."
|
||||
handleAction $ ToggleAuthenticated Nothing
|
||||
handleAction $ AddNotif $ BadNotification "Invalid credentials!"
|
||||
handleAction $ AddNotif $ BadNotification "Invalid credentials."
|
||||
(AuthD.GotErrorRegistrationsClosed _) -> do
|
||||
handleAction $ Log $ ErrorLog "Registration closed. Try another time or contact an administrator."
|
||||
handleAction $ AddNotif $ BadNotification "Registration are closed at the moment."
|
||||
(AuthD.GotErrorInvalidLoginFormat _) -> do
|
||||
handleAction $ Log $ ErrorLog "Invalid login format!"
|
||||
handleAction $ Log $ ErrorLog "Invalid login format."
|
||||
handleAction $ AddNotif $ BadNotification "Invalid login format."
|
||||
(AuthD.GotErrorInvalidEmailFormat _) -> do
|
||||
handleAction $ Log $ ErrorLog "Invalid email format!"
|
||||
handleAction $ Log $ ErrorLog "Invalid email format."
|
||||
handleAction $ AddNotif $ BadNotification "Invalid email format."
|
||||
(AuthD.GotErrorAlreadyUsersInDB _) -> do
|
||||
handleAction $ Log $ ErrorLog "GotErrorAlreadyUsersInDB"
|
||||
handleAction $ AddNotif $ BadNotification "Login already taken!"
|
||||
handleAction $ Log $ ErrorLog "Login already taken."
|
||||
handleAction $ AddNotif $ BadNotification "Login already taken."
|
||||
(AuthD.GotErrorReadOnlyProfileKeys _) -> do
|
||||
handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys!"
|
||||
handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys!"
|
||||
handleAction $ Log $ ErrorLog "Trying to add a profile with some invalid (read-only) keys."
|
||||
handleAction $ AddNotif $ BadNotification "Trying to add a profile with some invalid (read-only) keys."
|
||||
(AuthD.GotErrorInvalidActivationKey _) -> do
|
||||
handleAction $ Log $ ErrorLog "Invalid activation key!"
|
||||
handleAction $ AddNotif $ BadNotification "Invalid activation key!"
|
||||
handleAction $ Log $ ErrorLog "Invalid activation key."
|
||||
handleAction $ AddNotif $ BadNotification "Invalid activation key."
|
||||
(AuthD.GotErrorUserAlreadyValidated _) -> do
|
||||
handleAction $ Log $ ErrorLog "User already validated!"
|
||||
handleAction $ AddNotif $ BadNotification "User already validated!"
|
||||
handleAction $ Log $ ErrorLog "User already validated."
|
||||
handleAction $ AddNotif $ BadNotification "User already validated."
|
||||
(AuthD.GotErrorCannotContactUser _) -> do
|
||||
handleAction $ Log $ ErrorLog "User cannot be contacted. Email address may be invalid."
|
||||
handleAction $ AddNotif $ BadNotification "User cannot be contacted. Email address may be invalid."
|
||||
(AuthD.GotErrorInvalidRenewKey _) -> do
|
||||
handleAction $ Log $ ErrorLog "Invalid renew key!"
|
||||
handleAction $ AddNotif $ BadNotification "Invalid renew key!"
|
||||
handleAction $ Log $ ErrorLog "Invalid renew key."
|
||||
handleAction $ AddNotif $ BadNotification "Invalid renew key."
|
||||
(AuthD.GotErrorPasswordTooLong _) -> do
|
||||
handleAction $ Log $ ErrorLog "Password too long."
|
||||
handleAction $ AddNotif $ BadNotification "Password too long."
|
||||
-- The authentication was a success!
|
||||
(AuthD.GotToken msg) -> do
|
||||
handleAction $ Log $ SuccessLog $ "Authenticated to authd."
|
||||
@ -684,8 +687,9 @@ handleAction = case _ of
|
||||
(DNSManager.MkInvalidZone _) -> do
|
||||
handleAction $ Log $ ErrorLog $ "InvalidZone"
|
||||
handleAction $ AddNotif $ BadNotification $ "The domain zone is invalid."
|
||||
(DNSManager.MkDomainChanged _) -> do
|
||||
handleAction $ Log $ ErrorLog $ "DomainChanged"
|
||||
m@(DNSManager.MkDomainChanged response) -> do
|
||||
handleAction $ Log $ SystemLog $ "Domain \"" <> response.domain.name <> "\" has been updated."
|
||||
handleAction $ DispatchDNSMessage m
|
||||
(DNSManager.MkUnknownZone _) -> do
|
||||
handleAction $ Log $ ErrorLog $ "UnknownZone"
|
||||
handleAction $ AddNotif $ BadNotification $ "The domain zone is unknown."
|
||||
@ -701,7 +705,7 @@ handleAction = case _ of
|
||||
handleAction $ AddNotif $ BadNotification $ "You do not have sufficient rights."
|
||||
-- The authentication failed.
|
||||
(DNSManager.MkError errmsg) -> do
|
||||
handleAction $ Log $ ErrorLog $ "reason is: " <> errmsg.reason
|
||||
handleAction $ Log $ ErrorLog errmsg.reason
|
||||
(DNSManager.MkErrorUserNotLogged _) -> do
|
||||
handleAction $ Log $ ErrorLog $ "The user isn't connected!"
|
||||
handleAction $ Log $ SystemLog $ "Trying to authenticate to fix the problem..."
|
||||
|
@ -339,6 +339,11 @@ type ErrorInvalidRenewKey = {}
|
||||
codecGotErrorInvalidRenewKey :: CA.JsonCodec ErrorInvalidRenewKey
|
||||
codecGotErrorInvalidRenewKey = CA.object "ErrorInvalidRenewKey" (CAR.record {})
|
||||
|
||||
{- 35 -}
|
||||
type ErrorPasswordTooLong = {}
|
||||
codecGotErrorPasswordTooLong :: CA.JsonCodec ErrorPasswordTooLong
|
||||
codecGotErrorPasswordTooLong = CA.object "ErrorPasswordTooLong" (CAR.record {})
|
||||
|
||||
{- 250 -}
|
||||
-- type KeepAlive = { }
|
||||
codecGotKeepAlive ∷ CA.JsonCodec KeepAlive
|
||||
@ -393,6 +398,7 @@ data AnswerMessage
|
||||
| GotErrorUserAlreadyValidated ErrorUserAlreadyValidated -- 32
|
||||
| GotErrorCannotContactUser ErrorCannotContactUser -- 33
|
||||
| GotErrorInvalidRenewKey ErrorInvalidRenewKey -- 34
|
||||
| GotErrorPasswordTooLong ErrorPasswordTooLong -- 35
|
||||
| GotKeepAlive KeepAlive -- 250
|
||||
|
||||
encode ∷ RequestMessage -> Tuple UInt String
|
||||
@ -455,6 +461,7 @@ decode number string
|
||||
32 -> error_management codecGotErrorUserAlreadyValidated GotErrorUserAlreadyValidated
|
||||
33 -> error_management codecGotErrorCannotContactUser GotErrorCannotContactUser
|
||||
34 -> error_management codecGotErrorInvalidRenewKey GotErrorInvalidRenewKey
|
||||
35 -> error_management codecGotErrorPasswordTooLong GotErrorPasswordTooLong
|
||||
250 -> error_management codecGotKeepAlive GotKeepAlive
|
||||
_ -> Left UnknownNumber
|
||||
where
|
||||
|
@ -2,6 +2,8 @@ module App.Message.DNSManagerDaemon where
|
||||
|
||||
import Prelude (bind, pure, show, ($))
|
||||
|
||||
import App.Type.DomainInfo as DomainInfo
|
||||
|
||||
import Effect (Effect)
|
||||
|
||||
import Data.Argonaut.Core as J
|
||||
@ -105,6 +107,27 @@ type NewToken = { domain :: String, rrid :: Int }
|
||||
codecNewToken ∷ CA.JsonCodec NewToken
|
||||
codecNewToken = CA.object "NewToken" (CAR.record { domain: CA.string, rrid: CA.int })
|
||||
|
||||
{- 19 is UseToken, which isn't useful in the webclient. -}
|
||||
{- 20 -}
|
||||
type AskShareToken = { domain :: String }
|
||||
codecAskShareToken ∷ CA.JsonCodec AskShareToken
|
||||
codecAskShareToken = CA.object "AskShareToken" (CAR.record { domain: CA.string })
|
||||
|
||||
{- 21 -}
|
||||
type AskTransferToken = { domain :: String }
|
||||
codecAskTransferToken ∷ CA.JsonCodec AskTransferToken
|
||||
codecAskTransferToken = CA.object "AskTransferToken" (CAR.record { domain: CA.string })
|
||||
|
||||
{- 22 -}
|
||||
type AskUnShareDomain = { domain :: String }
|
||||
codecAskUnShareDomain ∷ CA.JsonCodec AskUnShareDomain
|
||||
codecAskUnShareDomain = CA.object "AskUnShareDomain" (CAR.record { domain: CA.string })
|
||||
|
||||
{- 23 -}
|
||||
type GainOwnership = { uuid :: String }
|
||||
codecGainOwnership ∷ CA.JsonCodec GainOwnership
|
||||
codecGainOwnership = CA.object "GainOwnership" (CAR.record { uuid: CA.string })
|
||||
|
||||
{- 100 -}
|
||||
type GenerateAllZoneFiles = {}
|
||||
codecGenerateAllZoneFiles ∷ CA.JsonCodec GenerateAllZoneFiles
|
||||
@ -183,9 +206,9 @@ codecInvalidZone ∷ CA.JsonCodec InvalidZone
|
||||
codecInvalidZone = CA.object "InvalidZone" (CAR.record { errors: CA.array CA.string })
|
||||
|
||||
{- 11 -}
|
||||
type DomainChanged = { }
|
||||
type DomainChanged = { domain :: DomainInfo.DomainInfo }
|
||||
codecDomainChanged ∷ CA.JsonCodec DomainChanged
|
||||
codecDomainChanged = CA.object "DomainChanged" (CAR.record { })
|
||||
codecDomainChanged = CA.object "DomainChanged" (CAR.record { domain: DomainInfo.codec })
|
||||
|
||||
{- 12 -}
|
||||
type Zone = { zone :: DNSZone.DNSZone }
|
||||
@ -208,10 +231,10 @@ 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, admin :: Boolean }
|
||||
type Logged = { accepted_domains :: Array String, my_domains :: Array DomainInfo.DomainInfo, admin :: Boolean }
|
||||
codecLogged ∷ CA.JsonCodec Logged
|
||||
codecLogged = CA.object "Logged" (CAR.record { accepted_domains: CA.array CA.string
|
||||
, my_domains: CA.array CA.string
|
||||
, my_domains: CA.array DomainInfo.codec
|
||||
, admin: CA.boolean
|
||||
})
|
||||
|
||||
@ -295,6 +318,10 @@ data RequestMessage
|
||||
| MkAskGeneratedZoneFile AskGeneratedZoneFile -- 17
|
||||
| MkNewToken NewToken -- 18
|
||||
--| MkUseToken UseToken -- 19
|
||||
| MkAskShareToken AskShareToken -- 20
|
||||
| MkAskTransferToken AskTransferToken -- 21
|
||||
| MkAskUnShareDomain AskUnShareDomain -- 22
|
||||
| MkGainOwnership GainOwnership -- 23
|
||||
| MkGenerateAllZoneFiles GenerateAllZoneFiles -- 100
|
||||
| MkGenerateZoneFile GenerateZoneFile -- 101
|
||||
| MkKeepAlive KeepAlive -- 250
|
||||
@ -348,6 +375,10 @@ encode m = case m of
|
||||
(MkAskGeneratedZoneFile request) -> get_tuple 17 codecAskGeneratedZoneFile request
|
||||
(MkNewToken request) -> get_tuple 18 codecNewToken request
|
||||
--(MkUseToken request) -> get_tuple 19 codecUseToken request
|
||||
(MkAskShareToken request) -> get_tuple 20 codecAskShareToken request
|
||||
(MkAskTransferToken request) -> get_tuple 21 codecAskTransferToken request
|
||||
(MkAskUnShareDomain request) -> get_tuple 22 codecAskUnShareDomain request
|
||||
(MkGainOwnership request) -> get_tuple 23 codecGainOwnership request
|
||||
(MkGenerateAllZoneFiles request) -> get_tuple 100 codecGenerateAllZoneFiles request
|
||||
(MkGenerateZoneFile request) -> get_tuple 101 codecGenerateZoneFile request
|
||||
(MkKeepAlive request) -> get_tuple 250 codecKeepAlive request
|
||||
|
@ -199,14 +199,14 @@ render { current_tab, authenticationForm, passwordRecoveryForm, newPasswordForm,
|
||||
auth_form = [ Bulma.h3 "Authentication", render_auth_form ]
|
||||
passrecovery_form =
|
||||
[ Bulma.h3 "You forgot your password (or your login)"
|
||||
, Bulma.div_content
|
||||
, Bulma.div_content []
|
||||
[ Bulma.p "Enter either your login or email and you'll receive a recovery token."
|
||||
]
|
||||
, render_password_recovery_form
|
||||
]
|
||||
newpass_form =
|
||||
[ Bulma.h3 "You got the password recovery mail"
|
||||
, Bulma.div_content
|
||||
, Bulma.div_content []
|
||||
[ Bulma.p "Nice! You get to choose your new password."
|
||||
]
|
||||
, render_new_password_form
|
||||
|
@ -8,16 +8,17 @@
|
||||
-- | - delete a domain
|
||||
-- | - ask for confirmation
|
||||
-- | - switch to the interface to show and modify the content of a Zone
|
||||
-- | - TODO: validate the domain before sending a message to `dnsmanagerd`
|
||||
-- | - validate the domain before sending a message to `dnsmanagerd`
|
||||
-- | - manage ownership of a domain: give, share, take back exclusive ownership.
|
||||
module App.Page.DomainList where
|
||||
|
||||
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>))
|
||||
import Prelude (Unit, bind, discard, map, otherwise, pure, ($), (/=), (<<<), (<>), (>), (==))
|
||||
|
||||
import Data.Array as A
|
||||
import Data.ArrayBuffer.Types (ArrayBuffer)
|
||||
import Data.Either (Either(..))
|
||||
import Data.String (toLower)
|
||||
import Data.Maybe (Maybe(..), maybe)
|
||||
import Data.Maybe (Maybe(..), maybe, fromMaybe)
|
||||
import Data.String.Utils (endsWith)
|
||||
import Effect.Aff.Class (class MonadAff)
|
||||
import Halogen as H
|
||||
@ -32,7 +33,9 @@ import App.DisplayErrors (error_to_paragraph_label)
|
||||
|
||||
import App.Validation.Label as Validation
|
||||
|
||||
import App.Type.LogMessage
|
||||
import CSSClasses as C
|
||||
import App.Type.DomainInfo
|
||||
import App.Type.LogMessage (LogMessage(..))
|
||||
import App.Message.DNSManagerDaemon as DNSManager
|
||||
|
||||
-- | `App.DomainListInterface` can send messages through websocket interface
|
||||
@ -84,18 +87,26 @@ data NewDomainFormAction
|
||||
-- | - update the list of own domains
|
||||
-- | - handle user inputs
|
||||
-- | - add a new domain
|
||||
-- | - remove a domain
|
||||
-- | - TODO: show the zone content (in another component)
|
||||
-- | - delete a domain you exclusively own
|
||||
-- | - share or transfer a domain (through dedicated tokens)
|
||||
-- | - gain ownership over a domain (through dedicated tokens)
|
||||
-- | - gain exclusive ownership of a shared domain (if the user is currently the only owner)
|
||||
-- | - show the zone content (in another page)
|
||||
|
||||
data Action
|
||||
= UpdateAcceptedDomains (Array String)
|
||||
| UpdateMyDomains (Array String)
|
||||
| UpdateMyDomains (Array DomainInfo)
|
||||
|
||||
| HandleNewDomainInput NewDomainFormAction
|
||||
| AskDomainTransferUUIDInput String
|
||||
|
||||
| NewDomainAttempt Event
|
||||
| AskDomainTransferAttempt Event
|
||||
| RemoveDomain String
|
||||
| EnterDomain String
|
||||
| ShareDomain String
|
||||
| UnShareDomain String
|
||||
| TransferDomain String
|
||||
|
||||
| DeleteDomainModal String
|
||||
| CancelModal
|
||||
@ -103,8 +114,9 @@ data Action
|
||||
| Initialize
|
||||
| Finalize
|
||||
|
||||
-- | The form only has two elements:
|
||||
-- | The form only has two visible elements:
|
||||
-- | the subdomain name input and the selected TLD.
|
||||
-- | The type also includes validation errors.
|
||||
|
||||
type NewDomainFormState
|
||||
= { new_domain :: String
|
||||
@ -112,15 +124,21 @@ type NewDomainFormState
|
||||
, 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 list of own domains and a boolean to know if the connection is up.
|
||||
|
||||
type State =
|
||||
{ newDomainForm :: NewDomainFormState
|
||||
, askDomainTransferForm :: AskDomainTransferState
|
||||
, accepted_domains :: Array String
|
||||
, my_domains :: Array String
|
||||
, my_domains :: Array DomainInfo
|
||||
|
||||
, active_modal :: Maybe String
|
||||
, deletion_modal :: Maybe String
|
||||
}
|
||||
|
||||
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||
@ -141,47 +159,135 @@ component =
|
||||
default_domain :: String
|
||||
default_domain = "netlib.re"
|
||||
|
||||
--debug_domains :: Array DomainInfo
|
||||
--debug_domains
|
||||
-- = [ emptyDomainInfo { name = "test.example.com"
|
||||
-- , share_key = Just "UUID"
|
||||
-- , owners = ["myself", "you"] }
|
||||
-- , emptyDomainInfo { name = "my-domain.example.com" }
|
||||
-- , emptyDomainInfo { name = "my-other-domain.example.com" }
|
||||
-- ]
|
||||
|
||||
initialState :: Input -> State
|
||||
initialState _ =
|
||||
{ newDomainForm: { new_domain: ""
|
||||
, _errors: []
|
||||
, selected_domain: default_domain
|
||||
}
|
||||
{ newDomainForm: { new_domain: "", _errors: [], selected_domain: default_domain }
|
||||
, askDomainTransferForm: { uuid: "", _errors: [] }
|
||||
, accepted_domains: [ default_domain ]
|
||||
, my_domains: [ ]
|
||||
, active_modal: Nothing
|
||||
, my_domains: []
|
||||
, deletion_modal: Nothing
|
||||
}
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { accepted_domains, my_domains, newDomainForm, active_modal }
|
||||
render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, deletion_modal }
|
||||
= Bulma.section_small
|
||||
[ case active_modal of
|
||||
Nothing -> Bulma.columns_
|
||||
[ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form]
|
||||
, Bulma.column_ [ Bulma.h3 "My domains"
|
||||
, if A.length my_domains > 0
|
||||
then HH.ul_ $ map (\domain -> HH.li_ (domain_buttons domain)) $ A.sort my_domains
|
||||
else Bulma.p "No domain yet."
|
||||
]
|
||||
]
|
||||
[ case deletion_modal of
|
||||
Nothing -> HH.div_ [ Bulma.columns_ domain_line
|
||||
, Bulma.hr
|
||||
, Bulma.columns_ new_domain_line
|
||||
, Bulma.hr
|
||||
, Bulma.columns_ explanations_line
|
||||
]
|
||||
Just domain -> Bulma.modal "Deleting a domain"
|
||||
[warning_message domain] [modal_delete_button domain, modal_cancel_button]
|
||||
]
|
||||
where
|
||||
c = Bulma.column_
|
||||
|
||||
domain_line = [ c render_my_domains, c render_my_shared_domains ]
|
||||
new_domain_line = [ c render_new_domain, c render_gain_ownership ]
|
||||
explanations_line = [ c render_share_ownership_explanation, c render_transfer_ownership_explanation ]
|
||||
|
||||
render_my_domains =
|
||||
[ Bulma.h3 "My domains"
|
||||
, Bulma.simple_quote "You are the exclusive owner of the following domains."
|
||||
, if A.length domains_i_exclusively_own > 0
|
||||
then Bulma.table [] [ Bulma.table_header_owned_domains
|
||||
, HH.tbody_ $ map owned_domain_row domains_i_exclusively_own
|
||||
]
|
||||
else Bulma.p "No domain yet."
|
||||
]
|
||||
render_my_shared_domains =
|
||||
[ Bulma.h3 "Shared domains"
|
||||
, Bulma.simple_quote """
|
||||
The following domains are shared with other users.
|
||||
In case you are the last owner, you can "unshare" it and gain exclusive ownership.
|
||||
"""
|
||||
, if A.length domains_i_share > 0
|
||||
then Bulma.table [] [ Bulma.table_header_shared_domains
|
||||
, HH.tbody_ $ map shared_domain_row domains_i_share
|
||||
]
|
||||
else Bulma.p "No domain yet."
|
||||
]
|
||||
render_new_domain =
|
||||
[ Bulma.h3 "New domain"
|
||||
, Bulma.quote [ Bulma.p "The heart of dnsmanager! 🎉"
|
||||
, Bulma.p "You can reserve a domain name, right here."
|
||||
, HH.text """
|
||||
Later you will be able to change the content, share, transfer or even delete the domain.
|
||||
"""
|
||||
]
|
||||
, render_add_domain_form
|
||||
]
|
||||
|
||||
render_gain_ownership =
|
||||
[ Bulma.h3 "Get the ownership of a domain"
|
||||
, Bulma.simple_quote """
|
||||
Someone wants to give you (or share with you) the ownership of a domain.
|
||||
Please enter the UUID of the transfer.
|
||||
"""
|
||||
, render_ask_domain_transfer_form
|
||||
]
|
||||
render_share_ownership_explanation =
|
||||
[ Bulma.h3 "Share the ownership of a domain"
|
||||
, Bulma.simple_quote """
|
||||
Ask for a "share token" for your domain and give it to other users.
|
||||
All the owners be able to make modifications to the domain.
|
||||
"""
|
||||
]
|
||||
|
||||
render_transfer_ownership_explanation =
|
||||
[ Bulma.h3 "Transfer the ownership of a domain"
|
||||
, Bulma.simple_quote """
|
||||
Ask for a transfer token for your domain and give it to the new owner.
|
||||
"""
|
||||
]
|
||||
|
||||
modal_delete_button domain = Bulma.alert_btn "Delete the domain" (RemoveDomain domain)
|
||||
modal_cancel_button = Bulma.cancel_button CancelModal
|
||||
|
||||
-- I own all domain without a "share key".
|
||||
domains_i_exclusively_own = A.sort $ A.filter (\domain -> domain.share_key == Nothing) my_domains
|
||||
-- Shared domains are all domains with a share_key.
|
||||
domains_i_share = A.sort $ A.filter (\domain -> domain.share_key /= Nothing) my_domains
|
||||
|
||||
warning_message domain
|
||||
= HH.p [] [ HH.text $ "You are about to delete your domain \""
|
||||
<> domain
|
||||
<> "\". Are you sure you want to do this? This is "
|
||||
, HH.strong_ [ HH.text "irreversible" ]
|
||||
, HH.text "."
|
||||
, Bulma.notification_warning' """
|
||||
In case this domain is shared, it won't be deleted, you'll just remove it from your domains.
|
||||
"""
|
||||
]
|
||||
|
||||
domain_buttons domain
|
||||
= [ Bulma.alert_btn "delete" (DeleteDomainModal domain)
|
||||
, Bulma.btn domain (EnterDomain domain)
|
||||
]
|
||||
shared_domain_row domain = HH.tr_
|
||||
[ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ]
|
||||
, HH.td_ [ HH.text $ fromMaybe "" domain.share_key ]
|
||||
, if A.length domain.owners == 1
|
||||
then HH.td_ [ Bulma.alert_btn "Unshare" (UnShareDomain domain.name) ]
|
||||
else HH.td_ [ Bulma.btn_ro (C.is_warning) "Cannot unshare it" ]
|
||||
, HH.td_ [ Bulma.alert_btn "Delete" (DeleteDomainModal domain.name) ]
|
||||
]
|
||||
|
||||
owned_domain_row domain = HH.tr_
|
||||
[ HH.td_ [ Bulma.btn domain.name (EnterDomain domain.name) ]
|
||||
, case domain.transfer_key of
|
||||
Just key -> HH.td_ [ Bulma.p key ]
|
||||
Nothing -> HH.td_ [ Bulma.btn "Transfer" (TransferDomain domain.name) ]
|
||||
, HH.td_ [ Bulma.btn "Share" (ShareDomain domain.name) ]
|
||||
, HH.td_ [ Bulma.alert_btn "Delete" (DeleteDomainModal domain.name) ]
|
||||
]
|
||||
|
||||
render_add_domain_form = HH.form
|
||||
[ HE.onSubmit NewDomainAttempt ]
|
||||
@ -196,6 +302,17 @@ render { accepted_domains, my_domains, newDomainForm, active_modal }
|
||||
else HH.div_ [ ]
|
||||
]
|
||||
|
||||
render_ask_domain_transfer_form = HH.form
|
||||
[ HE.onSubmit AskDomainTransferAttempt ]
|
||||
[ Bulma.box_input "idTransferToken" "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 i
|
||||
= HandleNewDomainInput <<< UpdateSelectedDomain $ maybe default_domain (\x -> x) $ accepted_domains A.!! i
|
||||
@ -210,7 +327,7 @@ handleAction = case _ of
|
||||
H.raise $ StoreState state
|
||||
|
||||
CancelModal -> do
|
||||
H.modify_ _ { active_modal = Nothing }
|
||||
H.modify_ _ { deletion_modal = Nothing }
|
||||
|
||||
UpdateAcceptedDomains domains -> do
|
||||
H.modify_ _ { accepted_domains = domains }
|
||||
@ -229,17 +346,35 @@ handleAction = case _ of
|
||||
Right _ -> H.modify_ _ { newDomainForm { _errors = [] } }
|
||||
UpdateSelectedDomain domain -> H.modify_ _ { newDomainForm { selected_domain = domain } }
|
||||
|
||||
AskDomainTransferUUIDInput str -> do
|
||||
H.modify_ _ { askDomainTransferForm { uuid = toLower str } }
|
||||
|
||||
EnterDomain domain -> do
|
||||
H.raise $ ChangePageZoneInterface domain
|
||||
|
||||
ShareDomain domain -> do
|
||||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskShareToken { domain: domain }
|
||||
H.raise $ MessageToSend message
|
||||
H.raise $ Log $ SystemLog $ "Ask a \"share token\" for domain " <> domain <> "."
|
||||
|
||||
TransferDomain domain -> do
|
||||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskTransferToken { domain: domain }
|
||||
H.raise $ MessageToSend message
|
||||
H.raise $ Log $ SystemLog $ "Ask a \"transfer token\" for domain " <> domain <> "."
|
||||
|
||||
UnShareDomain domain -> do
|
||||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkAskUnShareDomain { domain: domain }
|
||||
H.raise $ MessageToSend message
|
||||
H.raise $ Log $ SystemLog $ "Ask for exclusive ownership for domain " <> domain <> "."
|
||||
|
||||
DeleteDomainModal domain -> do
|
||||
H.modify_ _ { active_modal = Just domain }
|
||||
H.modify_ _ { deletion_modal = Just domain }
|
||||
|
||||
RemoveDomain domain -> do
|
||||
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkDeleteDomain { domain: domain }
|
||||
H.raise $ MessageToSend message
|
||||
H.raise $ Log $ SystemLog $ "Remove domain: " <> domain
|
||||
H.modify_ _ { active_modal = Nothing }
|
||||
H.modify_ _ { deletion_modal = Nothing }
|
||||
|
||||
NewDomainAttempt ev -> do
|
||||
H.liftEffect $ Event.preventDefault ev
|
||||
@ -249,7 +384,7 @@ handleAction = case _ 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
|
||||
message <- H.liftEffect
|
||||
$ DNSManager.serialize
|
||||
@ -260,6 +395,23 @@ handleAction = case _ of
|
||||
_, _, _ ->
|
||||
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.MkGainOwnership { uuid: uuid }
|
||||
H.raise $ MessageToSend message
|
||||
H.raise $ Log $ SystemLog $ "Gain ownership of a domain (" <> 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 = case _ of
|
||||
|
||||
@ -280,10 +432,17 @@ handleQuery = case _ of
|
||||
handleAction $ UpdateMyDomains response.my_domains
|
||||
(DNSManager.MkDomainAdded response) -> do
|
||||
{ my_domains } <- H.get
|
||||
handleAction $ UpdateMyDomains (my_domains <> [response.domain])
|
||||
handleAction $ UpdateMyDomains (my_domains <> [ emptyDomainInfo { name = response.domain } ])
|
||||
(DNSManager.MkDomainChanged response) -> do
|
||||
{ my_domains } <- H.get
|
||||
let replaced_domains = map (\d -> if d.name == response.domain.name then response.domain else d) my_domains
|
||||
new_domains = if A.elem response.domain replaced_domains
|
||||
then replaced_domains
|
||||
else replaced_domains <> [response.domain]
|
||||
handleAction $ UpdateMyDomains new_domains
|
||||
(DNSManager.MkDomainDeleted response) -> do
|
||||
{ my_domains } <- H.get
|
||||
handleAction $ UpdateMyDomains $ A.filter ((/=) response.domain) my_domains
|
||||
handleAction $ UpdateMyDomains $ A.filter (\d -> d.name /= response.domain) my_domains
|
||||
_ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
|
||||
pure (Just a)
|
||||
|
||||
|
@ -55,9 +55,9 @@ render _ = HH.div_
|
||||
]
|
||||
where
|
||||
title = Bulma.h3
|
||||
expl content = Bulma.div_content [ Bulma.explanation content ]
|
||||
expl content = Bulma.div_content [] [ Bulma.explanation content ]
|
||||
p = Bulma.p
|
||||
b x = Bulma.column_ [ Bulma.box [ Bulma.div_content x ] ]
|
||||
b x = Bulma.column_ [ Bulma.box [ Bulma.div_content [] x ] ]
|
||||
|
||||
render_description = Bulma.columns_ [ render_basics, render_no_expert, render_no_housing ]
|
||||
render_update_why_and_contact = Bulma.columns_ [ render_updates, render_why, render_contact ]
|
||||
|
@ -2,12 +2,14 @@
|
||||
-- |
|
||||
-- | This interface enables to:
|
||||
-- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
|
||||
-- | - provide dedicated interfaces for SPF and DKIM (TODO: DMARC)
|
||||
-- | - provide dedicated interfaces for SPF, DKIM and 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.
|
||||
-- |
|
||||
-- | TODO: CAA records.
|
||||
-- |
|
||||
-- | 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.
|
||||
@ -55,7 +57,7 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR
|
||||
, show_qualifier, show_qualifier_char
|
||||
, show_mechanism_type, show_mechanism, to_mechanism
|
||||
, show_modifier_type, show_modifier, to_modifier
|
||||
, all_qualifiers
|
||||
, qualifiers
|
||||
, mechanism_types, qualifier_types, modifier_types)
|
||||
import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
|
||||
import App.Type.DKIM as DKIM
|
||||
@ -294,7 +296,7 @@ default_domain :: String
|
||||
default_domain = "netlib.re"
|
||||
|
||||
default_rr_A :: ResourceRecord
|
||||
default_rr_A = emptyRR { rrtype = "A", name = "www", target = "192.0.2.1" }
|
||||
default_rr_A = emptyRR { rrtype = "A", name = "server1", target = "192.0.2.1" }
|
||||
|
||||
default_empty_rr :: ResourceRecord
|
||||
default_empty_rr = default_rr_A
|
||||
@ -387,11 +389,11 @@ render state
|
||||
render_current_rr_modal :: forall w. HH.HTML w Action
|
||||
render_current_rr_modal =
|
||||
case state._currentRR.rrtype of
|
||||
"A" -> template modal_content_simple (foot_content A)
|
||||
"AAAA" -> template modal_content_simple (foot_content AAAA)
|
||||
"TXT" -> template modal_content_simple (foot_content TXT)
|
||||
"CNAME" -> template modal_content_simple (foot_content CNAME)
|
||||
"NS" -> template modal_content_simple (foot_content NS)
|
||||
"A" -> template (modal_content_simple A) (foot_content A)
|
||||
"AAAA" -> template (modal_content_simple AAAA) (foot_content AAAA)
|
||||
"TXT" -> template (modal_content_simple TXT) (foot_content TXT)
|
||||
"CNAME" -> template (modal_content_simple CNAME) (foot_content CNAME)
|
||||
"NS" -> template (modal_content_simple NS) (foot_content NS)
|
||||
"MX" -> template modal_content_mx (foot_content MX)
|
||||
"SRV" -> template modal_content_srv (foot_content SRV)
|
||||
"SPF" -> template modal_content_spf (foot_content SPF)
|
||||
@ -404,9 +406,10 @@ render state
|
||||
render_errors = if A.length state._currentRR_errors > 0
|
||||
then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._currentRR_errors
|
||||
else HH.div_ [ ]
|
||||
modal_content_simple :: Array (HH.HTML w Action)
|
||||
modal_content_simple =
|
||||
modal_content_simple :: AcceptedRRTypes -> Array (HH.HTML w Action)
|
||||
modal_content_simple x =
|
||||
[ render_errors
|
||||
, render_introduction_text x
|
||||
, Bulma.input_with_side_text ("domain" <> state._currentRR.rrtype) "Name" "www"
|
||||
(updateForm Field_Domain)
|
||||
state._currentRR.name
|
||||
@ -428,9 +431,19 @@ render state
|
||||
]
|
||||
else []
|
||||
_ -> []
|
||||
|
||||
render_introduction_text :: AcceptedRRTypes -> HH.HTML w Action
|
||||
render_introduction_text = case _ of
|
||||
A -> Bulma.div_content [] [Bulma.explanation Explanations.a_introduction]
|
||||
AAAA -> Bulma.div_content [] [Bulma.explanation Explanations.aaaa_introduction]
|
||||
TXT -> Bulma.div_content [] [Bulma.explanation Explanations.txt_introduction]
|
||||
CNAME -> Bulma.div_content [] [Bulma.explanation Explanations.cname_introduction]
|
||||
NS -> Bulma.div_content [] [Bulma.explanation Explanations.ns_introduction]
|
||||
_ -> HH.p_ []
|
||||
modal_content_mx :: Array (HH.HTML w Action)
|
||||
modal_content_mx =
|
||||
[ render_errors
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.mx_introduction]
|
||||
, Bulma.input_with_side_text "domainMX" "Name" "www"
|
||||
(updateForm Field_Domain)
|
||||
state._currentRR.name
|
||||
@ -447,7 +460,7 @@ render state
|
||||
]
|
||||
modal_content_srv :: Array (HH.HTML w Action)
|
||||
modal_content_srv =
|
||||
[ Bulma.div_content [Bulma.explanation Explanations.srv_introduction]
|
||||
[ Bulma.div_content [] [Bulma.explanation Explanations.srv_introduction]
|
||||
, render_errors
|
||||
, Bulma.box_input "domainSRV" "Service name" "service name"
|
||||
(updateForm Field_Domain)
|
||||
@ -473,7 +486,7 @@ render state
|
||||
]
|
||||
modal_content_spf :: Array (HH.HTML w Action)
|
||||
modal_content_spf =
|
||||
[ Bulma.div_content [Bulma.explanation Explanations.spf_introduction]
|
||||
[ Bulma.div_content [] [Bulma.explanation Explanations.spf_introduction]
|
||||
, render_errors
|
||||
, Bulma.input_with_side_text "domainSPF" "Name" "Let this alone."
|
||||
(updateForm Field_Domain)
|
||||
@ -511,13 +524,13 @@ render state
|
||||
, Bulma.hr
|
||||
, Bulma.box
|
||||
[ Bulma.h3 "Default behavior"
|
||||
, Bulma.div_content [Bulma.explanation Explanations.spf_default_behavior]
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.spf_default_behavior]
|
||||
, Bulma.selection SPF_Qualifier qualifier_types (maybe default_qualifier_str show_qualifier state._currentRR.q)
|
||||
]
|
||||
]
|
||||
modal_content_dkim :: Array (HH.HTML w Action)
|
||||
modal_content_dkim =
|
||||
[ Bulma.div_content [Bulma.explanation Explanations.dkim_introduction]
|
||||
[ Bulma.div_content [] [Bulma.explanation Explanations.dkim_introduction]
|
||||
, render_errors
|
||||
, Bulma.input_with_side_text "domainDKIM" "Name" "default._domainkey"
|
||||
(updateForm Field_Domain)
|
||||
@ -527,7 +540,7 @@ render state
|
||||
(updateForm Field_TTL)
|
||||
(show state._currentRR.ttl)
|
||||
, Bulma.hr
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dkim_default_algorithms]
|
||||
, Bulma.selection_field "idDKIMSignature" "Signature algo"
|
||||
DKIM_sign_algo
|
||||
(map show DKIM.sign_algos)
|
||||
@ -542,7 +555,7 @@ render state
|
||||
|
||||
modal_content_dmarc :: Array (HH.HTML w Action)
|
||||
modal_content_dmarc =
|
||||
[ Bulma.div_content [Bulma.explanation Explanations.dmarc_introduction]
|
||||
[ Bulma.div_content [] [Bulma.explanation Explanations.dmarc_introduction]
|
||||
, render_errors
|
||||
, Bulma.input_with_side_text "domainDMARC" "Name" "_dmarc"
|
||||
(updateForm Field_Domain)
|
||||
@ -551,20 +564,27 @@ render state
|
||||
, Bulma.box_input "ttlDMARC" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl)
|
||||
|
||||
, Bulma.hr
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_policy]
|
||||
, Bulma.selection_field "idDMARCPolicy" "Policy" DMARC_policy (map show DMARC.policies) (show state.dmarc.p)
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_sp_policy]
|
||||
, Bulma.selection_field "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
|
||||
(["do not provide policy advice"] <> map show DMARC.policies) (maybe "-" show state.dmarc.sp)
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_policy]
|
||||
, Bulma.selection_field' "idDMARCPolicy" "Policy" DMARC_policy
|
||||
(A.zip DMARC.policies_txt DMARC.policies_raw)
|
||||
(show state.dmarc.p)
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_sp_policy]
|
||||
, Bulma.selection_field' "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy
|
||||
(zip_nullable DMARC.policies_txt_with_null DMARC.policies_raw)
|
||||
(maybe "-" show state.dmarc.sp)
|
||||
|
||||
, Bulma.hr
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_adkim]
|
||||
, Bulma.selection_field "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim DMARC.consistency_policies_txt (maybe "-" show state.dmarc.adkim)
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_aspf]
|
||||
, Bulma.selection_field "idDMARCaspf" "Consistency Policy for SPF" DMARC_aspf DMARC.consistency_policies_txt (maybe "-" show state.dmarc.aspf)
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_adkim]
|
||||
, Bulma.selection_field' "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim
|
||||
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
|
||||
(maybe "-" show state.dmarc.adkim)
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_aspf]
|
||||
, Bulma.selection_field' "idDMARCaspf" "Consistency Policy for SPF" DMARC_aspf
|
||||
(zip_nullable DMARC.consistency_policies_txt DMARC.consistency_policies_raw)
|
||||
(maybe "-" show state.dmarc.aspf)
|
||||
|
||||
, Bulma.hr
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_pct]
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_pct]
|
||||
, Bulma.box_input "idDMARCpct" "Sample rate [0..100]" "100" DMARC_pct (maybe "100" show state.dmarc.pct)
|
||||
|
||||
, Bulma.hr
|
||||
@ -573,7 +593,7 @@ render state
|
||||
(maybe "-" show state.dmarc.fo)
|
||||
|
||||
, Bulma.hr
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_contact]
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_contact]
|
||||
, maybe (Bulma.p "There is no address to send aggregated reports to.")
|
||||
(display_dmarc_mail_addresses "Addresses to contact for aggregated reports" DMARC_remove_rua) state.dmarc.rua
|
||||
, maybe (Bulma.p "There is no address to send detailed reports to.")
|
||||
@ -588,7 +608,7 @@ render state
|
||||
] []
|
||||
|
||||
, Bulma.hr
|
||||
, Bulma.div_content [Bulma.explanation Explanations.dmarc_ri]
|
||||
, Bulma.div_content [] [Bulma.explanation Explanations.dmarc_ri]
|
||||
, Bulma.box_input "idDMARCri" "Report interval (in seconds)" "86400" DMARC_ri (maybe "0" show state.dmarc.ri)
|
||||
]
|
||||
|
||||
@ -658,11 +678,11 @@ handleAction = case _ of
|
||||
CreateNewRRModal t -> do
|
||||
state <- H.get
|
||||
H.modify_ _ { rr_modal = NewRRModal t }
|
||||
let default_rr_AAAA = emptyRR { rrtype = "AAAA", name = "www", target = "2001:db8::1" }
|
||||
let default_rr_AAAA = emptyRR { rrtype = "AAAA", name = "server1", target = "2001:db8::1" }
|
||||
default_rr_TXT = emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
|
||||
default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "blog", target = "www" }
|
||||
default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
|
||||
default_rr_NS = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." }
|
||||
default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 }
|
||||
default_rr_MX = emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
|
||||
default_rr_SRV = emptyRR { rrtype = "SRV", name = "voip", target = "server1"
|
||||
, port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
|
||||
default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
|
||||
@ -822,7 +842,7 @@ handleAction = case _ of
|
||||
SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v }
|
||||
SPF_Modifier_t v -> H.modify_ _ { spf_modifier_t = maybe "redirect" id $ modifier_types A.!! v }
|
||||
SPF_Modifier_v v -> H.modify_ _ { spf_modifier_v = v }
|
||||
SPF_Qualifier v -> H.modify_ _ { _currentRR { q = all_qualifiers A.!! v } }
|
||||
SPF_Qualifier v -> H.modify_ _ { _currentRR { q = qualifiers A.!! v } }
|
||||
SPF_remove_mechanism i ->
|
||||
H.modify_ \s -> s { _currentRR { mechanisms = case s._currentRR.mechanisms of
|
||||
Just ms -> Just (remove_id i $ attach_id 0 ms)
|
||||
@ -890,29 +910,19 @@ handleAction = case _ of
|
||||
|
||||
DMARC_remove_rua i -> do
|
||||
state <- H.get
|
||||
let current_ruas = case state._currentRR.dmarc of
|
||||
Nothing -> []
|
||||
Just dmarc -> fromMaybe [] dmarc.rua
|
||||
let current_ruas = fromMaybe [] state.dmarc.rua
|
||||
new_value = case (remove_id i $ attach_id 0 current_ruas) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
new_dmarc = case state._currentRR.dmarc of
|
||||
Nothing -> DMARC.emptyDMARCRR { rua = new_value }
|
||||
Just dmarc -> dmarc { rua = new_value }
|
||||
H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
|
||||
H.modify_ \s -> s { dmarc { rua = new_value } }
|
||||
|
||||
DMARC_remove_ruf i -> do
|
||||
state <- H.get
|
||||
let current_rufs = case state._currentRR.dmarc of
|
||||
Nothing -> []
|
||||
Just dmarc -> fromMaybe [] dmarc.ruf
|
||||
let current_rufs = fromMaybe [] state.dmarc.ruf
|
||||
new_value = case (remove_id i $ attach_id 0 current_rufs) of
|
||||
[] -> Nothing
|
||||
v -> Just v
|
||||
new_dmarc = case state._currentRR.dmarc of
|
||||
Nothing -> DMARC.emptyDMARCRR { ruf = new_value }
|
||||
Just dmarc -> dmarc { ruf = new_value }
|
||||
H.modify_ \s -> s { _currentRR { dmarc = Just new_dmarc } }
|
||||
H.modify_ \s -> s { dmarc { ruf = new_value } }
|
||||
|
||||
DMARC_policy v -> H.modify_ _ { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } }
|
||||
DMARC_sp_policy v -> H.modify_ _ { dmarc { sp = DMARC.policies A.!! (v - 1) } }
|
||||
@ -1147,8 +1157,8 @@ render_resources records
|
||||
|
||||
show_token_or_btn rr =
|
||||
case rr.rrtype of
|
||||
"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)
|
||||
"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)
|
||||
_ -> HH.text ""
|
||||
|
||||
fancy_qualifier_display :: RR.Qualifier -> String
|
||||
|
@ -6,7 +6,7 @@ import Bulma as Bulma
|
||||
expl' :: forall w i. String -> HH.HTML w i
|
||||
expl' text = expl [Bulma.p text]
|
||||
expl :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
|
||||
expl content = Bulma.div_content [ Bulma.explanation content ]
|
||||
expl content = Bulma.div_content [] [ Bulma.explanation content ]
|
||||
expl_txt :: forall w i. String -> HH.HTML w i
|
||||
expl_txt content = Bulma.explanation [ Bulma.p content ]
|
||||
|
||||
@ -155,6 +155,110 @@ basics = HH.div_
|
||||
, Bulma.p "Check out the \"Tokens? 🤨\" tab."
|
||||
]
|
||||
|
||||
a_introduction :: forall w i. Array (HH.HTML w i)
|
||||
a_introduction =
|
||||
[ Bulma.p """
|
||||
The A record enables to bind an IPv4 address to a domain.
|
||||
"""
|
||||
, HH.p []
|
||||
[ HH.text "🚨 "
|
||||
, HH.u_ [HH.text "Advice for beginners"]
|
||||
, HH.text ":"
|
||||
, HH.text """
|
||||
the "Name" field is for the name of the record, which should be the name of the server owning this IP address, such as "server1".
|
||||
The "Target" field is for the IP address.
|
||||
The default TTL should be fine.
|
||||
"""
|
||||
]
|
||||
]
|
||||
|
||||
aaaa_introduction :: forall w i. Array (HH.HTML w i)
|
||||
aaaa_introduction =
|
||||
[ Bulma.p """
|
||||
The AAAA record enables to bind an IPv6 address to a domain.
|
||||
"""
|
||||
, HH.p []
|
||||
[ HH.text "🚨 "
|
||||
, HH.u_ [HH.text "Advice for beginners"]
|
||||
, HH.text ":"
|
||||
, HH.text """
|
||||
the "Name" field is for the name of the record, which should be the name of the server owning this IP address, such as "server1".
|
||||
The "Target" field is for the IP address.
|
||||
The default TTL should be fine.
|
||||
"""
|
||||
]
|
||||
]
|
||||
|
||||
cname_introduction :: forall w i. Array (HH.HTML w i)
|
||||
cname_introduction =
|
||||
[ Bulma.p """
|
||||
The CNAME record enables to provide alternative names to records.
|
||||
"""
|
||||
, HH.p []
|
||||
[ HH.text "🚨 "
|
||||
, HH.u_ [HH.text "Advice for beginners"]
|
||||
, HH.text ":"
|
||||
, HH.text """
|
||||
this resource record helps keeping your zone clean.
|
||||
Let's say you have a server named "server1", you can register an A record for that server (since the server actually has an IP address).
|
||||
Then, your hosted services will be registered in your zone as CNAMEs: "www", "blog" and "voip" will point to "server1", the actual server hosting these services.
|
||||
"""
|
||||
]
|
||||
]
|
||||
|
||||
mx_introduction :: forall w i. Array (HH.HTML w i)
|
||||
mx_introduction =
|
||||
[ Bulma.p """
|
||||
The MX record enables to add a mail server to your zone.
|
||||
"""
|
||||
, HH.p []
|
||||
[ HH.text "🚨 "
|
||||
, HH.u_ [HH.text "Advice for beginners"]
|
||||
, HH.text ": handling a mail server is both complex and difficult."
|
||||
, HH.text """
|
||||
The tab "The basics 🧠" explains some parts of hosting a mail server, but keep in mind that this is time consuming to get it together.
|
||||
This page talks about the DNS aspect of it, but doesn't cover all you need to know to actually host a mail server, by a long shot.
|
||||
"""
|
||||
]
|
||||
, Bulma.p """
|
||||
Anyway, the MX record itself is simple to understand.
|
||||
Let's say you have a server named "server1" with your mail service.
|
||||
The MX record can be named "mail" and it will target "server1".
|
||||
Of course, "server1" needs a record for its IP address (A or AAAA).
|
||||
"""
|
||||
, Bulma.p """
|
||||
The priority field is important only in case you have multiple mail servers; keep the default value.
|
||||
"""
|
||||
]
|
||||
|
||||
txt_introduction :: forall w i. Array (HH.HTML w i)
|
||||
txt_introduction =
|
||||
[ Bulma.p """
|
||||
The TXT record enables to declare a small text.
|
||||
"""
|
||||
, HH.p []
|
||||
[ HH.text "🚨 "
|
||||
, HH.u_ [HH.text "Advice for beginners"]
|
||||
, HH.text ":"
|
||||
, HH.text """
|
||||
do not use this record directly.
|
||||
TXT records are used in several places, for example for mail security through SPF, DKIM and DMARC records.
|
||||
"""
|
||||
]
|
||||
, Bulma.notification_danger' """
|
||||
All of these specific records have a dedicated user interface on this website;
|
||||
use them instead of writing these records by yourself.
|
||||
"""
|
||||
]
|
||||
|
||||
ns_introduction :: forall w i. Array (HH.HTML w i)
|
||||
ns_introduction =
|
||||
[ Bulma.p """
|
||||
The NS record enables to declare a new Name Server, meaning a new server that would serve this zone.
|
||||
"""
|
||||
, Bulma.notification_danger' "🚨 Advice for beginners: do not use this resource record."
|
||||
]
|
||||
|
||||
dkim_introduction :: forall w i. Array (HH.HTML w i)
|
||||
dkim_introduction =
|
||||
[ Bulma.p """
|
||||
|
@ -170,10 +170,13 @@ consistency_policies = [Strict, Relaxed]
|
||||
consistency_policies_txt :: Array String
|
||||
consistency_policies_txt
|
||||
= [ "Do not provide policy advice"
|
||||
, "Strict"
|
||||
, "Relaxed"
|
||||
, "Strict: same domain"
|
||||
, "Relaxed: same organizational domain"
|
||||
]
|
||||
|
||||
consistency_policies_raw :: Array String
|
||||
consistency_policies_raw = map show consistency_policies
|
||||
|
||||
-- | Codec for just encoding a single value of type `ConsistencyPolicy`.
|
||||
codecConsistencyPolicy :: CA.JsonCodec ConsistencyPolicy
|
||||
codecConsistencyPolicy
|
||||
@ -235,6 +238,19 @@ data Policy
|
||||
policies :: Array Policy
|
||||
policies = [None, Quarantine, Reject]
|
||||
|
||||
policies_raw :: Array String
|
||||
policies_raw = map show policies
|
||||
|
||||
policies_txt :: Array String
|
||||
policies_txt =
|
||||
[ "None (let the receiver decide)"
|
||||
, "Quarantine (high spam score, flag, etc.)"
|
||||
, "Reject"
|
||||
]
|
||||
|
||||
policies_txt_with_null :: Array String
|
||||
policies_txt_with_null = [ "Do not provide policy advice" ] <> policies_txt
|
||||
|
||||
-- | Codec for just encoding a single value of type `Policy`.
|
||||
codecPolicy :: CA.JsonCodec Policy
|
||||
codecPolicy = CA.prismaticCodec "Policy" str_to_policy generic_serialization CA.string
|
||||
|
33
src/App/Type/DomainInfo.purs
Normal file
33
src/App/Type/DomainInfo.purs
Normal file
@ -0,0 +1,33 @@
|
||||
module App.Type.DomainInfo where
|
||||
|
||||
import Prelude ((<>), map, bind, pure)
|
||||
|
||||
import Data.Maybe (Maybe(..), maybe)
|
||||
|
||||
import Data.Codec.Argonaut (JsonCodec)
|
||||
import Data.Codec.Argonaut as CA
|
||||
import Data.Codec.Argonaut.Record as CAR
|
||||
|
||||
type DomainInfo
|
||||
= { name :: String
|
||||
, share_key :: Maybe String
|
||||
, transfer_key :: Maybe String
|
||||
, owners :: Array Int
|
||||
}
|
||||
|
||||
codec :: JsonCodec DomainInfo
|
||||
codec = CA.object "DomainInfo"
|
||||
(CAR.record
|
||||
{ name: CA.string
|
||||
, share_key: CAR.optional CA.string
|
||||
, transfer_key: CAR.optional CA.string
|
||||
, owners: CA.array CA.int
|
||||
})
|
||||
|
||||
emptyDomainInfo :: DomainInfo
|
||||
emptyDomainInfo
|
||||
= { name: ""
|
||||
, share_key: Nothing
|
||||
, transfer_key: Nothing
|
||||
, owners: []
|
||||
}
|
@ -232,8 +232,8 @@ emptyRR
|
||||
}
|
||||
|
||||
data Qualifier = Pass | Neutral | SoftFail | HardFail
|
||||
all_qualifiers :: Array Qualifier
|
||||
all_qualifiers = [Pass, Neutral, SoftFail, HardFail]
|
||||
qualifiers :: Array Qualifier
|
||||
qualifiers = [Pass, Neutral, SoftFail, HardFail]
|
||||
qualifier_types :: Array String
|
||||
qualifier_types = ["pass", "neutral", "soft_fail", "hard_fail"]
|
||||
|
||||
|
@ -61,6 +61,24 @@ table prop xs = HH.table ([ HP.classes $ C.table ] <> prop) xs
|
||||
table_ :: forall w i. Array HH.ClassName -> HH.Node DHI.HTMLtable w i
|
||||
table_ classes prop xs = HH.table ([ HP.classes $ C.table <> classes] <> prop) xs
|
||||
|
||||
table_header_owned_domains :: forall w i. HH.HTML w i
|
||||
table_header_owned_domains
|
||||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
|
||||
, HH.th_ [ HH.text "" ]
|
||||
, HH.th_ [ HH.text "" ]
|
||||
, HH.th_ [ HH.text "" ]
|
||||
]
|
||||
]
|
||||
|
||||
table_header_shared_domains :: forall w i. HH.HTML w i
|
||||
table_header_shared_domains
|
||||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name" ]
|
||||
, HH.th_ [ HH.text "Share key" ]
|
||||
, HH.th_ [ HH.text "" ]
|
||||
, HH.th_ [ HH.text "" ]
|
||||
]
|
||||
]
|
||||
|
||||
mechanism_table_header :: forall w i. HH.HTML w i
|
||||
mechanism_table_header
|
||||
= HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Policy" ]
|
||||
@ -538,12 +556,17 @@ tag_light_info str = HH.span [HP.classes (C.tag <> C.is_info <> C.is_light)] [HH
|
||||
div_large_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
|
||||
div_large_content content = HH.div [HP.classes (C.is_large <> C.content)] content
|
||||
|
||||
div_content :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
|
||||
div_content content = HH.div [HP.classes (C.content)] content
|
||||
div_content :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
|
||||
div_content classes content = HH.div [HP.classes (C.content <> classes)] content
|
||||
|
||||
explanation :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
|
||||
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 classes tab_list = HH.div [HP.classes $ C.tabs <> classes] [HH.ul_ tab_list]
|
||||
@ -567,13 +590,16 @@ notification classes value deleteaction =
|
||||
]
|
||||
|
||||
notification_primary :: forall w i. String -> i -> HH.HTML w i
|
||||
notification_primary value deleteaction = notification C.is_primary value deleteaction
|
||||
notification_primary value action = notification C.is_primary value action
|
||||
|
||||
notification_success :: forall w i. String -> i -> HH.HTML w i
|
||||
notification_success value deleteaction = notification C.is_success value deleteaction
|
||||
notification_success value action = notification C.is_success value action
|
||||
|
||||
notification_warning :: forall w i. String -> i -> HH.HTML w i
|
||||
notification_warning value action = notification C.is_warning value action
|
||||
|
||||
notification_danger :: forall w i. String -> i -> HH.HTML w i
|
||||
notification_danger value deleteaction = notification C.is_danger value deleteaction
|
||||
notification_danger value action = notification C.is_danger value action
|
||||
|
||||
notification_block' :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
|
||||
notification_block' classes content =
|
||||
@ -584,6 +610,12 @@ notification' classes value =
|
||||
HH.div [HP.classes (C.notification <> classes)]
|
||||
[ HH.text value ]
|
||||
|
||||
notification_primary' :: forall w i. String -> HH.HTML w i
|
||||
notification_primary' value = notification' C.is_primary value
|
||||
|
||||
notification_warning' :: forall w i. String -> HH.HTML w i
|
||||
notification_warning' value = notification' C.is_warning value
|
||||
|
||||
notification_danger' :: forall w i. String -> HH.HTML w i
|
||||
notification_danger' value = notification' C.is_danger value
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user