Broader use of the Generic class.

src/App/Container.purs

@@ -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)

src/App/Page/Navigation.purs

@@ -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
 

src/App/Page/Zone.purs

@@ -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) ]

src/App/Type/AcceptedRRTypes.purs

@@ -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

src/App/Type/DKIM.purs

@@ -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"

src/App/Type/GenericSerialization.purs

@@ -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

src/App/Type/Pages.purs

@@ -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