Broader use of the Generic class.
parent
c0a1d2000f
commit
22f78dc475
|
|
@ -241,8 +241,7 @@ render state
|
|||
= HH.div_ $
|
||||
[ render_header
|
||||
, render_nav
|
||||
, Bulma.columns_ [ Bulma.column_ [ render_login ]
|
||||
, Bulma.column_ [ render_notifications ] ]
|
||||
, render_notifications
|
||||
, case state.current_page of
|
||||
Home -> render_home
|
||||
Authentication -> render_auth_form
|
||||
|
|
@ -264,8 +263,6 @@ render state
|
|||
GoodNotification v -> Bulma.box [Bulma.notification_success v CloseNotif]
|
||||
BadNotification v -> Bulma.box [Bulma.notification_danger v CloseNotif]
|
||||
|
||||
render_login = maybe (Bulma.p "") (\l -> Bulma.box [ Bulma.p $ "You are connected as: " <> l]) state.login
|
||||
|
||||
render_home :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
render_home = HH.slot_ _ho unit HomeInterface.component unit
|
||||
render_domainlist_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
|
||||
|
|
@ -320,19 +317,21 @@ handleAction = case _ of
|
|||
Nothing -> revert_old_page
|
||||
Just _ -> pure unit -- Authentication will happen when web sockets are up!
|
||||
|
||||
login_name <- H.liftEffect $ Storage.getItem "user-login" sessionstorage
|
||||
case login_name of
|
||||
Nothing -> pure unit
|
||||
Just name -> do H.modify_ _ { login = Just name }
|
||||
H.tell _nav unit $ NavigationInterface.TellLogin (Just name)
|
||||
|
||||
Routing page -> do
|
||||
-- Store the current page we are on and restore it when we reload.
|
||||
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
||||
H.liftEffect $ Storage.setItem "current-page" (show page) sessionstorage
|
||||
|
||||
_ <- case page of
|
||||
Home -> H.liftEffect $ Storage.setItem "current-page" "Home" sessionstorage
|
||||
Authentication -> H.liftEffect $ Storage.setItem "current-page" "Authentication" sessionstorage
|
||||
Registration -> H.liftEffect $ Storage.setItem "current-page" "Registration" sessionstorage
|
||||
MailValidation -> H.liftEffect $ Storage.setItem "current-page" "MailValidation" sessionstorage
|
||||
DomainList -> H.liftEffect $ Storage.setItem "current-page" "DomainList" sessionstorage
|
||||
Zone zone -> do _ <- H.liftEffect $ Storage.setItem "current-page" "Zone" sessionstorage
|
||||
H.liftEffect $ Storage.setItem "current-zone" zone sessionstorage
|
||||
Setup -> H.liftEffect $ Storage.setItem "current-page" "Setup" sessionstorage
|
||||
Administration -> H.liftEffect $ Storage.setItem "current-page" "Administration" sessionstorage
|
||||
Zone zone -> H.liftEffect $ Storage.setItem "current-zone" zone sessionstorage
|
||||
_ -> pure unit
|
||||
|
||||
H.modify_ _ { current_page = page }
|
||||
|
||||
Log message -> do
|
||||
|
|
@ -403,7 +402,11 @@ handleAction = case _ of
|
|||
|
||||
AI.AuthenticateToAuthd v -> handleAction $ AuthenticateToAuthd (Right v)
|
||||
AI.Log message -> handleAction $ Log message
|
||||
AI.UserLogin login -> H.modify_ _ { login = Just login }
|
||||
AI.UserLogin login -> do
|
||||
sessionstorage <- H.liftEffect $ Window.sessionStorage =<< HTML.window
|
||||
_ <- H.liftEffect $ Storage.setItem "user-login" login sessionstorage
|
||||
H.modify_ _ { login = Just login }
|
||||
H.tell _nav unit $ NavigationInterface.TellLogin (Just login)
|
||||
|
||||
RegistrationInterfaceEvent ev -> case ev of
|
||||
RI.MessageToSend message -> H.tell _ws_auth unit (WS.ToSend message)
|
||||
|
|
|
|||
|
|
@ -34,6 +34,7 @@ data Output
|
|||
data Query a
|
||||
= ToggleLogged Boolean a
|
||||
| ToggleAdmin Boolean a
|
||||
| TellLogin (Maybe String) a
|
||||
|
||||
type Slot = H.Slot Query Output
|
||||
|
||||
|
|
@ -55,7 +56,7 @@ data Action
|
|||
-- | - `logged`, a boolean to toggle the display of some parts of the menu.
|
||||
-- | - `active`, a boolean to toggle the display of the menu.
|
||||
-- | - `admin`, a boolean to toggle the display of administration page link.
|
||||
type State = { logged :: Boolean, active :: Boolean, admin :: Boolean }
|
||||
type State = { logged :: Boolean, login :: Maybe String, active :: Boolean, admin :: Boolean }
|
||||
|
||||
component :: forall m. MonadAff m => H.Component Query Input Output m
|
||||
component =
|
||||
|
|
@ -68,7 +69,7 @@ component =
|
|||
}
|
||||
|
||||
initialState :: Input -> State
|
||||
initialState _ = { logged: false, active: false, admin: false }
|
||||
initialState _ = { logged: false, login: Nothing, active: false, admin: false }
|
||||
|
||||
handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
|
||||
handleAction = case _ of
|
||||
|
|
@ -87,6 +88,9 @@ handleQuery = case _ of
|
|||
ToggleAdmin isadmin a -> do
|
||||
H.modify_ _ { admin = isadmin }
|
||||
pure (Just a)
|
||||
TellLogin login a -> do
|
||||
H.modify_ _ { login = login }
|
||||
pure (Just a)
|
||||
|
||||
|
||||
-- | The navigation bar is a complex component to render.
|
||||
|
|
@ -98,7 +102,7 @@ handleQuery = case _ of
|
|||
-- | Also, when clicked again, the list disappears.
|
||||
|
||||
render :: forall m. State -> H.ComponentHTML Action () m
|
||||
render { logged, active, admin } =
|
||||
render { logged, active, admin, login } =
|
||||
main_nav
|
||||
[ nav_brand [ logo, burger_menu ]
|
||||
, nav_menu
|
||||
|
|
@ -117,7 +121,7 @@ render { logged, active, admin } =
|
|||
right_bar_div =
|
||||
case logged of
|
||||
false -> [ link_auth, link_register, link_mail_validation ]
|
||||
_ -> [ link_setup, link_disconnection ]
|
||||
_ -> render_login login <> [ link_setup, link_disconnection ]
|
||||
|
||||
navbar_color = C.is_success
|
||||
|
||||
|
|
@ -127,7 +131,7 @@ render { logged, active, admin } =
|
|||
, ARIA.role "navigation"
|
||||
]
|
||||
|
||||
logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🔻🍉"]
|
||||
logo = HH.strong [HP.classes $ C.navbar_item <> (C.is_size 4)] [HH.text "🍉"]
|
||||
-- HH.a [HP.classes C.navbar_item, HP.href "/"]
|
||||
-- [HH.img [HP.src "/logo.jpeg", HP.width 112, HP.height 28]]
|
||||
|
||||
|
|
@ -158,6 +162,8 @@ render { logged, active, admin } =
|
|||
link_register = nav_link_strong "Register" (Navigate Registration)
|
||||
link_mail_validation = nav_link "Mail verification" (Navigate MailValidation)
|
||||
link_setup = nav_link_warn "⚒ Setup" (Navigate Setup)
|
||||
render_login Nothing = []
|
||||
render_login (Just l)= [nav_link ("logged as " <> l) (Navigate Setup)]
|
||||
link_disconnection =
|
||||
nav_link_ (C.has_text_light <> C.has_background_danger) "Disconnection" UnLog
|
||||
|
||||
|
|
|
|||
|
|
@ -189,18 +189,6 @@ data RRModal
|
|||
| UpdateRRModal
|
||||
| RemoveRRModal RRId
|
||||
|
||||
show_accepted_type :: AcceptedRRTypes -> String
|
||||
show_accepted_type = case _ of
|
||||
A -> "A"
|
||||
AAAA -> "AAAA"
|
||||
TXT -> "TXT"
|
||||
CNAME -> "CNAME"
|
||||
NS -> "NS"
|
||||
MX -> "MX"
|
||||
SRV -> "SRV"
|
||||
SPF -> "SPF"
|
||||
DKIM -> "DKIM"
|
||||
|
||||
string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
|
||||
string_to_acceptedtype str = case str of
|
||||
"A" -> Just A
|
||||
|
|
@ -506,12 +494,12 @@ render state
|
|||
, Bulma.div_content [Bulma.explanation Explanations.dkim_default_algorithms]
|
||||
, Bulma.selection_field "idDKIMSignature" "Signature algo"
|
||||
DKIM_sign_algo
|
||||
(map DKIM.show_signature_algorithm DKIM.sign_algos)
|
||||
(DKIM.show_signature_algorithm $ fromMaybe DKIM.RSA state.dkim.k)
|
||||
(map show DKIM.sign_algos)
|
||||
(show $ fromMaybe DKIM.RSA state.dkim.k)
|
||||
, Bulma.selection_field "idDKIMHash" "Hash algo"
|
||||
DKIM_hash_algo
|
||||
(map DKIM.show_hashing_algorithm DKIM.hash_algos)
|
||||
(DKIM.show_hashing_algorithm $ fromMaybe DKIM.SHA256 state.dkim.h)
|
||||
(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."
|
||||
|
|
@ -535,7 +523,7 @@ render state
|
|||
where
|
||||
title = case state.rr_modal of
|
||||
NoModal -> "Error: no modal should be displayed"
|
||||
NewRRModal t_ -> "New " <> show_accepted_type t_ <> " resource record"
|
||||
NewRRModal t_ -> "New " <> show t_ <> " resource record"
|
||||
UpdateRRModal -> "Update RR " <> show state._currentRR.rrid
|
||||
RemoveRRModal rr_id -> "Error: should display removal modal instead (for RR " <> show rr_id <> ")"
|
||||
foot = foot_ <> [Bulma.cancel_button CancelModal]
|
||||
|
|
@ -922,10 +910,10 @@ render_resources records
|
|||
Just dkim ->
|
||||
[
|
||||
-- , HH.td_ [ Bulma.p $ maybe "(default)" id rr.v ] -- For now, version isn't displayed. Assume DKIM1.
|
||||
HH.td_ [ Bulma.p $ maybe "" DKIM.show_hashing_algorithm dkim.h ]
|
||||
, HH.td_ [ Bulma.p $ maybe "" DKIM.show_signature_algorithm dkim.k ]
|
||||
, HH.td_ [ Bulma.p $ CP.take 5 dkim.p ]
|
||||
, HH.td_ [ Bulma.p $ fromMaybe "" dkim.n ]
|
||||
HH.td_ [ Bulma.p $ maybe "" show dkim.h ]
|
||||
, HH.td_ [ Bulma.p $ maybe "" show dkim.k ]
|
||||
, HH.td_ [ Bulma.p $ CP.take 5 dkim.p ]
|
||||
, HH.td_ [ Bulma.p $ fromMaybe "" dkim.n ]
|
||||
, if rr.readonly
|
||||
then HH.td_ [ Bulma.btn_readonly ]
|
||||
else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
|
||||
|
|
|
|||
|
|
@ -18,7 +18,7 @@ data AcceptedRRTypes
|
|||
| SPF
|
||||
| DKIM
|
||||
|
||||
derive instance genericMyADT :: Generic AcceptedRRTypes _
|
||||
derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _
|
||||
|
||||
instance showMyADT :: Show AcceptedRRTypes where
|
||||
instance showAcceptedRRTypes :: Show AcceptedRRTypes where
|
||||
show = genericShow
|
||||
|
|
|
|||
|
|
@ -1,5 +1,10 @@
|
|||
module App.Type.DKIM where
|
||||
|
||||
import Prelude
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.Show.Generic (genericShow)
|
||||
|
||||
import App.Type.GenericSerialization (generic_serialization)
|
||||
import Data.Maybe (Maybe(..))
|
||||
|
||||
import Data.Codec.Argonaut (JsonCodec)
|
||||
|
|
@ -39,10 +44,13 @@ emptyDKIMRR = { v: Nothing, k: Just RSA, h: Just SHA256, p: "", n: Nothing }
|
|||
|
||||
data HashingAlgorithm = {- SHA1 | -} SHA256
|
||||
hash_algos = [ {- "sha1", -} SHA256] :: Array HashingAlgorithm
|
||||
derive instance genericHashingAlgorithm :: Generic HashingAlgorithm _
|
||||
instance showHashingAlgorithm :: Show HashingAlgorithm where
|
||||
show = genericShow
|
||||
|
||||
-- | Codec for just encoding a single value of type `HashingAlgorithm`.
|
||||
codecHashingAlgorithm :: CA.JsonCodec HashingAlgorithm
|
||||
codecHashingAlgorithm = CA.prismaticCodec "HashingAlgorithm" str_to_hashing_algorithm show_hashing_algorithm CA.string
|
||||
codecHashingAlgorithm = CA.prismaticCodec "HashingAlgorithm" str_to_hashing_algorithm generic_serialization CA.string
|
||||
|
||||
str_to_hashing_algorithm :: String -> Maybe HashingAlgorithm
|
||||
str_to_hashing_algorithm = case _ of
|
||||
|
|
@ -50,17 +58,15 @@ str_to_hashing_algorithm = case _ of
|
|||
"sha256" -> Just SHA256
|
||||
_ -> Nothing
|
||||
|
||||
show_hashing_algorithm :: HashingAlgorithm -> String
|
||||
show_hashing_algorithm = case _ of
|
||||
-- SHA1 -> "sha1"
|
||||
SHA256 -> "sha256"
|
||||
|
||||
data SignatureAlgorithm = RSA | ED25519
|
||||
sign_algos = [RSA, ED25519] :: Array SignatureAlgorithm
|
||||
derive instance genericSignatureAlgorithm :: Generic SignatureAlgorithm _
|
||||
instance showSignatureAlgorithm :: Show SignatureAlgorithm where
|
||||
show = genericShow
|
||||
|
||||
-- | Codec for just encoding a single value of type `SignatureAlgorithm`.
|
||||
codecSignatureAlgorithm :: CA.JsonCodec SignatureAlgorithm
|
||||
codecSignatureAlgorithm = CA.prismaticCodec "SignatureAlgorithm" str_to_signature_algorithm show_signature_algorithm CA.string
|
||||
codecSignatureAlgorithm = CA.prismaticCodec "SignatureAlgorithm" str_to_signature_algorithm generic_serialization CA.string
|
||||
|
||||
str_to_signature_algorithm :: String -> Maybe SignatureAlgorithm
|
||||
str_to_signature_algorithm = case _ of
|
||||
|
|
@ -68,22 +74,16 @@ str_to_signature_algorithm = case _ of
|
|||
"ed25519" -> Just ED25519
|
||||
_ -> Nothing
|
||||
|
||||
show_signature_algorithm :: SignatureAlgorithm -> String
|
||||
show_signature_algorithm = case _ of
|
||||
RSA -> "rsa"
|
||||
ED25519 -> "ed25519"
|
||||
|
||||
data Version = DKIM1
|
||||
derive instance genericVersion :: Generic Version _
|
||||
instance showVersion :: Show Version where
|
||||
show = genericShow
|
||||
|
||||
-- | Codec for just encoding a single value of type `Version`.
|
||||
codecVersion :: CA.JsonCodec Version
|
||||
codecVersion = CA.prismaticCodec "Version" str_to_version show_version CA.string
|
||||
codecVersion = CA.prismaticCodec "Version" str_to_version generic_serialization CA.string
|
||||
|
||||
str_to_version :: String -> Maybe Version
|
||||
str_to_version = case _ of
|
||||
"dkim1" -> Just DKIM1
|
||||
_ -> Nothing
|
||||
|
||||
show_version :: Version -> String
|
||||
show_version = case _ of
|
||||
DKIM1 -> "dkim1"
|
||||
|
|
|
|||
|
|
@ -0,0 +1,6 @@
|
|||
module App.Type.GenericSerialization where
|
||||
import Prelude (show, class Show, (<<<))
|
||||
import Data.String (toLower)
|
||||
|
||||
generic_serialization :: forall a. Show a => a -> String
|
||||
generic_serialization = toLower <<< show
|
||||
|
|
@ -1,4 +1,8 @@
|
|||
module App.Type.Pages where
|
||||
|
||||
import Prelude
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.Show.Generic (genericShow)
|
||||
-- | This list will grow in a near future.
|
||||
-- |
|
||||
-- | TODO:
|
||||
|
|
@ -11,3 +15,8 @@ data Page
|
|||
| Zone String -- | `Zone`: to manage a zone.
|
||||
| Setup -- | `Setup`: user account administration page
|
||||
| Administration -- | `Administration`: administration page (for both `authd` and `dnsmanagerd`).
|
||||
|
||||
derive instance genericPage :: Generic Page _
|
||||
|
||||
instance showPage :: Show Page where
|
||||
show = genericShow
|
||||
|
|
|
|||
Loading…
Reference in New Issue