dnsmanager-webclient/src/App/Page/DomainList.purs

-- | `App.DomainListInterface` is a simple component with the list of own domains
-- | and a form to add a new domain.
-- |
-- | This interface enables to:
-- |   - display the list of own domains
-- |   - show and select accepted domains (TLDs)
-- |   - create new domains
-- |   - delete a domain
-- |   - ask for confirmation
-- |   - switch to the interface to show and modify the content of a Zone
-- |   - 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 Data.Array as A
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Either (Either(..))
import Data.String (toLower)
import Data.Maybe (Maybe(..), maybe, fromMaybe)
import Data.String.Utils (endsWith)
import Effect.Aff.Class (class MonadAff)
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Events as HE
import Halogen.HTML.Events as HHE
import Web.Event.Event as Event
import Web.Event.Event (Event)
import Bulma as Bulma

import App.DisplayErrors (error_to_paragraph_label)

import App.Validation.Label as Validation

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
-- | connected to dnsmanagerd. See `App.WS`.
-- |
-- | Also, this component can log messages and ask its parent (`App.Container`) to
-- | reconnect the websocket to `dnsmanagerd`.
-- |
-- | Finally, the component can ask its state to its parent.
-- | The reason is quite simple.
-- | The component can be deleted, meaning that it loses its state.
-- | Instead of asking `dnsmanagerd` the list of available domains and the list of owned domains
-- | each time the component is instanciated, the parent stores the component's state when the
-- | component is removed. This way, the data is conserved.

data Output
  = MessageToSend ArrayBuffer
  | Log LogMessage
  | ChangePageZoneInterface String
  | AskState
  | StoreState State

-- | `App.DomainListInterface` can receive messages from `dnsmanagerd`.
-- |
-- | The component is also informed when the connection is lost or up again.
-- |
-- | Finally, its entire state can be provided by its parent.
-- | See the explanation for the `Output` data type.

data Query a
  = MessageReceived DNSManager.AnswerMessage a
  | ProvideState (Maybe State) a

type Slot = H.Slot Query Output

-- | `App.DomainListInterface` has no input.

type Input = Unit

-- | `App.DomainListInterface` has a single form to add a new domain.
-- | Only two possible inputs: the (sub)domain name and the selection of the TLD.

data NewDomainFormAction
  = INP_newdomain String
  | UpdateSelectedDomain String

-- | Possible component's actions are:
-- | - update the accepted domains (examples: netlib.re, codelib.re and example.com)
-- | - update the list of own domains
-- | - handle user inputs
-- | - add a new domain
-- | - remove a domain
-- | - TODO: show the zone content (in another component)

data Action
  = UpdateAcceptedDomains (Array String)
  | UpdateMyDomains (Array DomainInfo)

  | HandleNewDomainInput NewDomainFormAction
  | AskDomainTransferUUIDInput String

  | NewDomainAttempt Event
  | AskDomainTransferAttempt Event
  | RemoveDomain String
  | EnterDomain String
  | ShareDomain String
  | UnshareDomain String

  | DeleteDomainModal String
  | CancelModal

  | Initialize
  | Finalize

-- | 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
    , _errors         :: Array Validation.Error
    , 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 DomainInfo

  , deletion_modal :: Maybe String
  }

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

-- | Default available domain: netlib.re.

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 }
  , askDomainTransferForm: { uuid: "", _errors: [] }
  , accepted_domains: [ default_domain ]
  , my_domains: []
  , deletion_modal: Nothing
  }

render :: forall m. State -> H.ComponentHTML Action () m
render { accepted_domains, my_domains, newDomainForm, askDomainTransferForm, deletion_modal }
  = Bulma.section_small
      [ case deletion_modal of
          Nothing -> Bulma.columns_
            [ Bulma.column_ [ Bulma.h3 "New domain", render_add_domain_form
                            , Bulma.hr
                            , 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
                            , Bulma.hr
                            , 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.
                                """
                            , Bulma.hr
                            , 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.
                                """
                            ]
            , Bulma.column_ [ 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."
                            , Bulma.hr
                            , 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."
                            ]
            ]
          Just domain -> Bulma.modal "Deleting a domain"
            [warning_message domain] [modal_delete_button domain, modal_cancel_button]
      ]
  where
    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 "."
                ]

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

    owned_domain_row domain = HH.tr_
      [ HH.td_ [ Bulma.btn domain.name (EnterDomain 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 ]
      [ Bulma.new_domain_field
          (HandleNewDomainInput <<< INP_newdomain)
          newDomainForm.new_domain
          [ HHE.onSelectedIndexChange domain_choice ]
          (map (\v -> "." <> v) accepted_domains)
      , Bulma.btn_validation_ "add a new domain"
      , if A.length newDomainForm._errors > 0
        then HH.div_ $ map error_to_paragraph_label newDomainForm._errors
        else HH.div_ [ ]
      ]

    render_ask_domain_transfer_form = HH.form
      [ HE.onSubmit AskDomainTransferAttempt ]
      [ Bulma.box_input "idTransferToken" "Transfer 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

handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit
handleAction = case _ of
  Initialize -> do
    H.raise $ AskState

  Finalize -> do
    state <- H.get
    H.raise $ StoreState state

  CancelModal -> do
    H.modify_ _ { deletion_modal = Nothing }

  UpdateAcceptedDomains domains -> do
    H.modify_ _ { accepted_domains = domains }

  UpdateMyDomains domains -> do
    H.modify_ _ { my_domains = domains }

  HandleNewDomainInput adduserinp -> do
    case adduserinp of
      INP_newdomain v -> do
        H.modify_ _ { newDomainForm { new_domain = toLower v } }
        case v of
          "" -> H.modify_ _ { newDomainForm { _errors = [] } }
          _ -> case Validation.label v of
            Left arr -> H.modify_ _ { newDomainForm { _errors = arr } }
            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
    H.raise $ Log $ SystemLog $ "TODO: Share domain " <> domain

  UnshareDomain domain -> do
    H.raise $ Log $ SystemLog $ "TODO: Unshare domain " <> domain

  DeleteDomainModal domain -> do
    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_ _ { deletion_modal = Nothing }

  NewDomainAttempt ev -> do
    H.liftEffect $ Event.preventDefault ev

    { newDomainForm } <- H.get
    let new_domain = build_new_domain newDomainForm.new_domain newDomainForm.selected_domain

    case newDomainForm.new_domain, newDomainForm._errors, new_domain of
      "", _, _ ->
        H.raise $ Log $ UnableToSend "You didn't enter the new domain."
      _, [], _ -> do
        message <- H.liftEffect
          $ DNSManager.serialize
          $ DNSManager.MkNewDomain { domain: new_domain }
        H.raise $ MessageToSend message
        H.raise $ Log $ SystemLog $ "Add a new domain (" <> new_domain <> ")"
        handleAction $ HandleNewDomainInput $ INP_newdomain ""
      _, _, _ ->
        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.MkNewDomain { domain: new_domain }
        --H.raise $ MessageToSend message
        H.raise $ Log $ SystemLog $ "TODO: Ask for a domain transfer (" <> 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

  ProvideState maybe_state a -> do
    case maybe_state of
      Nothing -> pure Nothing
      Just s  -> do
        H.put s
        pure (Just a)

  MessageReceived message a -> do
    case message of
      -- The authentication failed.
      (DNSManager.MkAcceptedDomains response) -> do
        handleAction $ UpdateAcceptedDomains response.domains
      (DNSManager.MkLogged response) -> do
        handleAction $ UpdateAcceptedDomains response.accepted_domains
        handleAction $ UpdateMyDomains response.my_domains
      (DNSManager.MkDomainAdded response) -> do
        { my_domains } <- H.get
        handleAction $ UpdateMyDomains (my_domains <> [ emptyDomainInfo { name = response.domain } ])
      (DNSManager.MkDomainDeleted response) -> do
        { my_domains } <- H.get
        handleAction $ UpdateMyDomains $ A.filter (\d -> d.name /= response.domain) my_domains
      _ -> H.raise $ Log $ ErrorLog $ "Message not handled in DomainListInterface."
    pure (Just a)

page_reload :: State -> DNSManager.AnswerMessage -> State
page_reload s1 message =
  case message of
    DNSManager.MkLogged response ->
      s1 { accepted_domains = response.accepted_domains
         , my_domains = A.sort response.my_domains
         }
    _ -> s1

build_new_domain :: String -> String -> String
build_new_domain sub tld
  | endsWith "." sub = sub <> tld
  | otherwise        = sub <> "." <> tld