-- | `App.HomeInterface` presents the website and its features.
module App.Page.Home where

import Prelude (Unit, pure, unit, ($))

-- import Data.Either (Either(..))
-- import Data.Maybe (Maybe(..), maybe)
-- import Data.Tuple (Tuple(..))
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
-- import Halogen.HTML.Events as HE
import Halogen.HTML.Properties as HP

import CSSClasses as C
import Bulma as Bulma

type Input = Unit
type Action = Unit
type State = Unit

data Query a = DoNothing a
type Output = Unit
type Slot = H.Slot Query Output

component :: forall m. MonadAff m => H.Component Query Input Output m
component =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval
        { handleAction = handleAction
        }
    }

handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction _ = pure unit

initialState :: forall input. input -> State
initialState _ = unit

render :: forall m. State -> H.ComponentHTML Action () m
render _ = HH.div_
             [ Bulma.hero_danger
                 -- "THIS IS A BETA RELEASE"
                 -- "You can register, login and play a bit with the tool. Feel free to report errors and suggestions."
                 [ HH.text "MESSAGE DE MIGRATION" ]
                 [ Bulma.p "En bref : le site a été refait à neuf, en anglais (une traduction arrivera… un jour), et les comptes ont été migrés."
                 , Bulma.p "Les utilisateurs peuvent se connecter avec leurs identifiants habituels et leurs domaines sont toujours attribués, mais le contenu n'a pas été préservé (il faut re-configurer les zones)."
                 , Bulma.p """
                 Les comptes migrés sont conservés 6 mois, puis supprimés si aucune connexion n'est faite,
                 afin de purger un certain nombre de vieux comptes de robots.
                 """
                 , HH.p [ HP.classes [C.margin_top 3] ]
                   [ Bulma.outside_link [C.button, C.is_info] url_linuxfr "(LIEN BIENTÔT DISPONIBLE, l'article n'est pas encore publié)." ]
                 ]
             , Bulma.section_small
                 [ Bulma.h1 "Welcome to netlib.re"
                 , Bulma.subtitle "Free domain names for the common folks"
                 , Bulma.hr
                 , render_description
                 , render_update_why_and_contact
                 , Bulma.hr
                 , render_how_and_code
                 ]
             ]
  where
    url_linuxfr = "https://linuxfr.org"
    title = Bulma.h3
    expl content = Bulma.div_content [] [ Bulma.explanation content ]
    p = Bulma.p
    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 ]

    render_basics
      = b [ title "What is provided?"
          , p "Reserve a domain name in <something>.netlib.re for free."
          , p "Manage your own DNS zone."
          ]
    render_no_expert
      = b [ title "No need to be an expert"
          , p """
              This website will help you through your configuration, as much as we can.
              """
          ]
    render_no_housing
      = b [ title "No housing, just a name"
          , p """
              We don't host your services or websites.
              We just provide a name.
              You can host your websites anywhere you want: at home for example.
              """
          ]
    render_updates
      = b [ title "Automatic updates"
          , p "Update your records with a single, stupidly simple command. For example:"
          , expl [ Bulma.strong "wget https://netlib.re/token-update/<token>" ]
          , p "Every A and AAAA records have tokens for easy updates."
          ]

    render_why
      = b [ title "Why?"
          , p "Because everyone should be able to have a place on the Internet."
          , p "We provide a name, build something meaningful with it."
          ]
    render_contact
      = b [ title "Contact"
          , p "You have a question, you have seen a bug, you have suggestions or you just want to chat?"
          , p "You can contact us: netlibre@karchnu.fr"
          , p "For more important matter: abuse@netlib.re"
          ]

    render_how_and_code = Bulma.columns_ [ render_how, render_code ]
    render_how
      = b [ title "How does this work?"
          , p "We pay for the domain names (netlib.re and codelib.re) and let you have a subdomain."
          , p "This service helps you manage your domain (a subdomain of netlib.re or codelib.re)."
          ]
    render_code
      = b [ title "I want to see the code! 🤓​"
          , p "The project is fully open-source (ISC licence)."
          , HH.text "There are a few parts:"
          , HH.ul_
            [ link "https://git.baguette.netlib.re/Baguette/authd" "authentication daemon"
                   """
                   to authenticate clients through different services;
                   """
            , link "https://git.baguette.netlib.re/Baguette/dnsmanager" "dnsmanager daemon"
                   """
                   an interactive database enabling clients to ask for domains then to manage DNS zones;
                   """
            , link "https://git.baguette.netlib.re/Baguette/dnsmanager-webclient"
                   "dnsmanager webclient"
                   """
                   this user-friendly website, so you can manage your zones. 🥰
                   """
            ]
          , Bulma.hr
          , Bulma.p "But of course, there are a few more technical parts:"
          , HH.ul_
            [ link "https://git.baguette.netlib.re/Baguette/libipc" "libIPC"
                   """
                   the Inter Process Communication library used between different applications,
                   such as authd and dnsmanagerd;
                   """
            , link "https://git.baguette.netlib.re/Baguette/dodb.cr" "dodb"
                   """
                   the Document Oriented DataBase, enabling to store serialized objects
                   (a Zone, a User, etc.) in simple files as opposed to the usual complexity of
                   traditional databases.
                   """
            ]
          ]
    link url link_title content
      = HH.li_ [ Bulma.outside_link [] url link_title, HH.text ", ", HH.text content ]