WIP

src/App/AuthenticationDaemonAdminInterface.purs

@@ -4,6 +4,8 @@ module App.AuthenticationDaemonAdminInterface where
    This interface should allow to:
      - TODO: add, remove, search, validate users
      - TODO: raise a user to admin
+
+   TODO: authenticate
 -}
 
 import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=), not)

src/App/Container.purs

@@ -8,6 +8,7 @@ import Data.Maybe (Maybe(..))
 import Data.Tuple (Tuple(..))
 import App.AuthenticationForm as AF
 import App.AuthenticationDaemonAdminInterface as AAI
+import App.DNSManagerDomainsInterface         as NewDomainInterface
 import Halogen as H
 import Halogen.HTML as HH
 import Type.Proxy (Proxy(..))
@@ -21,10 +22,12 @@ type State = { token :: Maybe String, uid :: Maybe Int }
 type ChildSlots =
   ( af  :: AF.Slot Unit
   , aai :: AAI.Slot Unit
+  , ndi :: NewDomainInterface.Slot Unit
   )
 
 _af = Proxy :: Proxy "af"
 _aai = Proxy :: Proxy "aai"
+_ndi = Proxy :: Proxy "ndi"
 
 component :: forall q i o m. MonadAff m => H.Component q i o m
 component =
@@ -42,6 +45,7 @@ render state
   = HH.div_ $
     [ render_auth_form
     , render_authd_admin_interface
+    , render_newdomain_interface
     , div_token
     ]
   where
@@ -50,17 +54,25 @@ render state
 
     render_auth_form :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_auth_form = Bulma.box $ case state.token of
-      Nothing -> [ HH.slot _af unit AF.component "ws://127.0.0.1:8081" Authenticated ]
+      Nothing -> [ HH.slot _af unit AF.component "ws://127.0.0.1:8080" Authenticated ]
       Just current_token -> [ Bulma.p ("Token is: " <> current_token) ]
 
     render_authd_admin_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
     render_authd_admin_interface = Bulma.box $ case state.token of
       Just _ ->
         [ Bulma.h1 "Administrative interface for authd"
-        , HH.slot_ _aai unit AAI.component "ws://127.0.0.1:8081"
+        , HH.slot_ _aai unit AAI.component "ws://127.0.0.1:8080"
         ]
       Nothing -> [ Bulma.p "Here will be the administrative box." ]
 
+    render_newdomain_interface :: forall monad. MonadAff monad => H.ComponentHTML Action ChildSlots monad
+    render_newdomain_interface = Bulma.box $ case state.token of
+      Just _ ->
+        [ Bulma.h1 "New domain interface!"
+        , HH.slot_ _ndi unit NewDomainInterface.component "ws://127.0.0.1:8081"
+        ]
+      Nothing -> [ Bulma.p "Here will be the new domain box." ]
+
 handleAction :: forall o monad. MonadAff monad => Action -> H.HalogenM State Action ChildSlots o monad Unit
 handleAction = case _ of
   Authenticated (AF.AuthToken (Tuple uid token)) -> H.modify_ _ { uid = Just uid, token = Just token }

src/App/DNSManagerDomainsInterface.purs

@@ -7,6 +7,8 @@ module App.DNSManagerDomainsInterface where
 
    Some messages are lacking:
    - TODO: get the list of TLDs (netlib.re, codelib.re, etc.)
+
+   Also: must log user!
 -}
 
 import Prelude
@@ -139,7 +141,8 @@ type Slot = H.Slot Query Output
 
 type Query :: forall k. k -> Type
 type Query = Const Void
-type Input = String
+-- Input = url token
+type Input = Tuple String String
 
 data NewDomainFormAction
   = INP_newdomain String
@@ -149,6 +152,8 @@ data Action
   | WebSocketParseError String
   | ConnectWebSocket
 
+  | AuthenticateToDNSManager
+
   | HandleNewDomainInput NewDomainFormAction
 
   | NewDomainAttempt Event
@@ -156,13 +161,14 @@ data Action
   | HandleWebSocket (WebSocketEvent WebSocketMessageType)
 
 -- TODO: TLD
-type NewDomainForm = { new_domain :: String }
+type NewDomainFormState = { new_domain :: String }
 
 type State =
   { messages               :: Array String
   , messageHistoryLength   :: Int
 
-  , newDomainForm          :: NewDomainForm
+  , token                  :: String
+  , newDomainForm          :: NewDomainFormState
 
   -- TODO: put network stuff in a record.
   , wsUrl                  :: String
@@ -183,14 +189,15 @@ component =
     }
 
 initialState :: Input -> State
-initialState input =
+initialState (Tuple url token) =
   { messages: []
   , messageHistoryLength: 10
 
+  , token: token
   , newDomainForm: { new_domain: "" }
 
   -- TODO: put network stuff in a record.
-  , wsUrl: input
+  , wsUrl: url
   , wsConnection: Nothing
   , canReconnect: false
   }
@@ -280,6 +287,16 @@ handleAction = case _ of
     H.liftEffect $ WS.setBinaryType webSocket ArrayBuffer
     H.modify_ _ { wsConnection = Just webSocket }
     void $ H.subscribe (HandleWebSocket <$> webSocketEmitter webSocket)
+    handleAction AuthenticateToDNSManager
+
+  AuthenticateToDNSManager -> do
+    { wsConnection, token } <- H.get
+    appendMessage $ "[🤖] Trying to authenticate..."
+    case wsConnection of
+      Nothing -> appendMessage $ "[🤖] Can't authenticate, websocket is down!"
+      Just webSocket -> H.liftEffect $ do
+        ab <- DNSManager.serialize $ DNSManager.MkLogin { token: token }
+        sendArrayBuffer webSocket ab
 
   HandleNewDomainInput adduserinp -> do
     case adduserinp of
@@ -339,6 +356,11 @@ handleAction = case _ of
                 -- The authentication failed.
                 (DNSManager.MkError errmsg) -> do
                   appendMessage $ "[😈] Failed, reason is: " <> errmsg.reason
+                (DNSManager.MkErrorUserNotLogged _) -> do
+                  appendMessage $ "[😈] Failed! The user isn't connected!"
+                  handleAction AuthenticateToDNSManager
+                (DNSManager.MkErrorInvalidToken _) -> do
+                  appendMessage $ "[😈] Failed connection! Invalid token!"
                 (DNSManager.MkDomainAlreadyExists _) -> do
                   appendMessage $ "[😈] Failed! The domain already exists."
                 (DNSManager.MkSuccess _) -> do

src/App/Messages/DNSManagerDaemon.purs

@@ -104,6 +104,11 @@ type DomainAlreadyExists = { }
 codecDomainAlreadyExists ∷ CA.JsonCodec DomainAlreadyExists
 codecDomainAlreadyExists = CA.object "DomainAlreadyExists" (CAR.record { })
 
+{- 4  -}
+type ErrorUserNotLogged = { }
+codecErrorUserNotLogged ∷ CA.JsonCodec ErrorUserNotLogged
+codecErrorUserNotLogged = CA.object "ErrorUserNotLogged" (CAR.record { })
+
 {- 10  -}
 -- For now, Error is just an alias on String.
 -- type InvalidZone = { errors : Array(Storage::Zone::Error) }
@@ -162,6 +167,7 @@ data AnswerMessage
  | MkSuccess             Success             -- 1
  | MkErrorInvalidToken   ErrorInvalidToken   -- 2
  | MkDomainAlreadyExists DomainAlreadyExists -- 3
+ | MkErrorUserNotLogged  ErrorUserNotLogged  -- 4
  | MkInvalidZone         InvalidZone         -- 10
  | MkDomainChanged       DomainChanged       -- 11
  | MkZone                Zone                -- 12
@@ -199,6 +205,7 @@ decode number string
     1  -> error_management codecSuccess             MkSuccess
     2  -> error_management codecErrorInvalidToken   MkErrorInvalidToken
     3  -> error_management codecDomainAlreadyExists MkDomainAlreadyExists
+    4  -> error_management codecErrorUserNotLogged  MkErrorUserNotLogged
     10 -> error_management codecInvalidZone         MkInvalidZone
     11 -> error_management codecDomainChanged       MkDomainChanged
     12 -> error_management codecZone                MkZone