Print JSON message when there is a parsing problem.

src/App/AuthenticationForm.purs

@@ -1,10 +1,11 @@
 module App.AuthenticationForm where
 
-import Prelude
+import Prelude (Unit, Void, bind, discard, map, otherwise, pure, show, void, when, ($), (&&), (-), (<), (<$>), (<<<), (<>), (>=>), (>>=))
 
 import Control.Monad.Except (runExcept)
 import Control.Monad.State (class MonadState)
 import Data.Array as A
+import Data.Tuple (Tuple(..))
 import Data.Bifunctor (lmap)
 -- import Data.Codec.Argonaut (JsonCodec, JsonDecodeError)
 -- import Data.Codec.Argonaut as CA
@@ -32,6 +33,10 @@ import Web.Socket.Event.MessageEvent as WSME
 import Web.Socket.ReadyState (ReadyState(Connecting, Open, Closing, Closed))
 import Web.Socket.WebSocket as WS
 
+import Effect.Class (class MonadEffect)
+
+import App.IPC as IPC
+
 import App.Messages.AuthenticationDaemon as AuthD
 
 import Data.ArrayBuffer.Types (ArrayBuffer)
@@ -326,14 +331,24 @@ handleAction = case _ of
       WebSocketMessage messageEvent -> do
         receivedMessage <- H.liftEffect $ AuthD.deserialize messageEvent.message
         case receivedMessage of
-            Left _ -> do
-              handleAction $ WebSocketParseError "Generic parsing error, TODO."
+            -- Cases where we didn't understand the message.
+            Left err -> do
+              case err of
+                (AuthD.JSONERROR       jerr) -> do
+                  print_json_string messageEvent.message
+                  handleAction $ WebSocketParseError ("Parsing error: AuthD.JSONERROR" <> (show jerr))
+                (AuthD.UnknownError   unerr) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownError" <> (show unerr))
+                (AuthD.UnknownNumber       ) -> handleAction $ WebSocketParseError ("Parsing error: AuthD.UnknownNumber")
+            -- Cases where we understood the message.
             Right response -> do
               case response of
+                -- The authentication failed.
                 (AuthD.GotError _) -> do
                   appendMessage $ "[😈] Failed! (TODO: put the reason)"
+                -- The authentication was a success!
                 (AuthD.GotToken msg) -> 
                   appendMessage $ "[😈] Success! user " <> (show msg.uid) <> " has token: " <> msg.token
+                -- WTH?!
                 _ -> do
                   appendMessage $ "[😈] Failed! Don't understand the answer received!"
 
@@ -428,3 +443,13 @@ foreignToArrayBuffer
   renderForeignErrors :: F.MultipleErrors -> String
   renderForeignErrors =
     String.joinWith "; " <<< A.fromFoldable <<< map F.renderForeignError
+
+-- print_json_string :: forall m. MonadState State m => ArrayBuffer -> m Unit
+-- print_json_string :: forall (m :: Type -> Type) (a :: Type). MonadEffect m => Effect a -> m a
+print_json_string :: forall m. MonadEffect m => MonadState State m => ArrayBuffer -> m Unit
+print_json_string arraybuffer = do
+  -- fromTypedIPC :: ArrayBuffer -> Effect (Either ParseError (Tuple UInt String))
+  value <- H.liftEffect $ IPC.fromTypedIPC arraybuffer
+  appendMessage $ case (value) of
+    Left _ -> "Cannot even fromTypedIPC the message."
+    Right (Tuple messageTypeNumber string) -> "Number is: " <> show messageTypeNumber <> "Received string: " <> string

src/App/Container.purs

@@ -78,7 +78,7 @@ render state = HH.div_
   , HH.div
       [ HP.class_ (H.ClassName "box") ]
       [ HH.h1_ [ HH.text "Authentication form" ]
-      , HH.slot_ _af unit AF.component "ws://127.0.0.1:8080"
+      , HH.slot_ _af unit AF.component "ws://127.0.0.1:8081"
       ]
   , HH.div
       [ HP.class_ (H.ClassName "box") ]

src/App/IPC.purs

@@ -13,7 +13,7 @@ module App.IPC (toIPC, fromIPC, toTypedIPC, fromTypedIPC) where
   Actual message formats can be found in the App.Messages folder.
 -}
 
-import Prelude (bind, (<$>), discard, ($), (>>>), (+))
+import Prelude (bind, (<$>), discard, ($), (>>>), (+), (-))
 
 import Effect (Effect)
 import Effect.Class (liftEffect)
@@ -97,6 +97,6 @@ fromTypedIPC arraybuffer = do
     -- Second parse a 8-bit unsigned integer representing the type of
     -- the message to decode.
     messageTypeNumber <- Parsing.DataView.anyUint8
-    stringview <- Parsing.DataView.takeN length
+    stringview <- Parsing.DataView.takeN (length - 1)
     stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
     hoistEffectParserT $ (Tuple messageTypeNumber) <$> TextDecoder.decode stringarray textDecoder