Parsing JSON messages: FIXED.

src/App/AuthenticationForm.purs

@@ -8,6 +8,7 @@ import Data.Array as A
 import Data.Tuple (Tuple(..))
 import Data.Bifunctor (lmap)
 -- import Data.Codec.Argonaut (JsonCodec, JsonDecodeError)
+import Data.Argonaut.Core as J
 import Data.Codec.Argonaut as CA
 import Data.Const (Const)
 import Data.Either (Either(..))
@@ -334,9 +335,9 @@ handleAction = case _ of
             -- Cases where we didn't understand the message.
             Left err -> do
               case err of
-                (AuthD.JSONERROR       jerr) -> do
+                (AuthD.JSONERROR jerr) -> do
                   print_json_string messageEvent.message
-                  handleAction $ WebSocketParseError ("JSON parsing error:" <> (CA.printJsonDecodeError jerr))
+                  handleAction $ WebSocketParseError ("JSON parsing error: " <> jerr <> " JSON is: " <> 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.

src/App/IPC.purs

@@ -18,7 +18,7 @@ import Prelude (bind, (<$>), discard, ($), (>>>), (+), (-))
 import Effect (Effect)
 import Effect.Class (liftEffect)
 
-import Data.UInt (fromInt, UInt)
+import Data.UInt (fromInt, toInt, UInt)
 import Data.Tuple (Tuple(..))
 import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer
 import Data.ArrayBuffer.Types (ArrayBuffer, DataView)
@@ -78,8 +78,8 @@ fromIPC arrayBuffer = do
   runParserT dataView do
     -- First parse a 32-bit big-endian length prefix for the length
     -- of the UTF-8 string in bytes.
-    length <- Parsing.DataView.anyInt32be
+    length <- Parsing.DataView.anyUint32be
-    stringview <- Parsing.DataView.takeN length
+    stringview <- Parsing.DataView.takeN (toInt length)
     stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
     hoistEffectParserT $ TextDecoder.decode stringarray textDecoder
 
@@ -93,10 +93,10 @@ fromTypedIPC arraybuffer = do
   runParserT dataView do
     -- First parse a 32-bit big-endian length prefix for the length
     -- of the UTF-8 string in bytes.
-    length <- Parsing.DataView.anyInt32be
+    length <- Parsing.DataView.anyUint32be
     -- Second parse a 8-bit unsigned integer representing the type of
     -- the message to decode.
     messageTypeNumber <- Parsing.DataView.anyUint8
-    stringview <- Parsing.DataView.takeN (length - 1)
+    stringview <- Parsing.DataView.takeN ((toInt length) - 1)
     stringarray <- lift $ liftEffect $ Cast.toUint8Array stringview
     hoistEffectParserT $ (Tuple messageTypeNumber) <$> TextDecoder.decode stringarray textDecoder

src/App/Messages/AuthenticationDaemon.purs

@@ -16,6 +16,8 @@ import Data.Tuple (Tuple(..))
 import Data.ArrayBuffer.Types (ArrayBuffer)
 
 import Effect.Class (liftEffect)
+import Data.Argonaut.Parser as JSONParser
+import Data.Bifunctor (lmap)
 
 import App.IPC as IPC
 
@@ -58,7 +60,8 @@ import App.IPC as IPC
 -}
 
 -- Basic message types.
-type Error = { reason :: Maybe String }
+-- type Error = { reason :: Maybe String }
+type Error = { reason :: String }
 type Token = { uid :: Int, token :: String }
 type Contacts = { user :: Int, email :: Maybe String, phone :: Maybe String }
 
@@ -66,6 +69,18 @@ type Email = String
 type Password = String
 type GetToken = { login :: String, password :: String }
 
+-- Related JSON codecs.
+codecGetToken ∷ CA.JsonCodec GetToken
+codecGetToken = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string })
+
+codecGotError ∷ CA.JsonCodec Error
+codecGotError = CA.object "Error" (CAR.record { reason: CA.string })
+-- codecGotError = CA.object "Error" (CAR.record { reason: CAR.optional CA.string })
+codecGotToken ∷ CA.JsonCodec Token
+codecGotToken = CA.object "Token" (CAR.record { "uid": CA.int, "token": CA.string })
+codecGotContacts ∷ CA.JsonCodec Contacts
+codecGotContacts = CA.object "Contacts" (CAR.record { user: CA.int, email: CAR.optional CA.string, phone: CAR.optional CA.string  })
+
 -- All possible requests.
 data RequestMessage
   = MkGetToken GetToken      -- 0
@@ -124,17 +139,13 @@ encode m = case m of
     -- 17 Delete
     -- 18 GetContacts
 
-  where
-    codecGetToken ∷ CA.JsonCodec GetToken
-    codecGetToken = CA.object "GetToken" (CAR.record { login: CA.string, password: CA.string })
-
 data DecodeError
-  = JSONERROR CA.JsonDecodeError
+  = JSONERROR String
   | UnknownError String
   | UnknownNumber
 
-decode :: Int -> J.Json -> Either DecodeError AnswerMessage
+decode :: Int -> String -> Either DecodeError AnswerMessage
-decode number json
+decode number string
   = case number of
     0  -> error_management codecGotError GotError
     1  -> error_management codecGotToken GotToken
@@ -154,17 +165,14 @@ decode number json
     -- Signature is required since the compiler's guess is wrong.
     error_management :: forall a. CA.JsonCodec a -> (a -> AnswerMessage) -> Either DecodeError AnswerMessage
     error_management codec f
-      = case (CA.decode codec json) of
+      = case (parseDecodeJSON codec string) of
           (Left err) -> Left (JSONERROR err)
           (Right v)  -> Right (f v)
 
-    -- Related JSON codecs.
+parseDecodeJSON :: forall a. CA.JsonCodec a -> String -> Either String a
-    codecGotError ∷ CA.JsonCodec Error
+parseDecodeJSON codec str = do
-    codecGotError = CA.object "Error" (CAR.record { "reason": CAR.optional CA.string })
+  json <- JSONParser.jsonParser str
-    codecGotToken ∷ CA.JsonCodec Token
+  lmap CA.printJsonDecodeError (CA.decode codec json)
-    codecGotToken = CA.object "Token" (CAR.record { "uid": CA.int, "token": CA.string })
-    codecGotContacts ∷ CA.JsonCodec Contacts
-    codecGotContacts = CA.object "Contacts" (CAR.record { user: CA.int, email: CAR.optional CA.string, phone: CAR.optional CA.string  })
 
 
 serialize :: RequestMessage -> Effect ArrayBuffer
@@ -178,6 +186,6 @@ deserialize arraybuffer
     value <- liftEffect $ IPC.fromTypedIPC arraybuffer
     pure $ case (value) of
       Left err -> Left (UnknownError $ show err)
-      Right (Tuple messageTypeNumber string) -> case (decode (toInt messageTypeNumber) $ J.fromString string) of
+      Right (Tuple messageTypeNumber string) -> case (decode (toInt messageTypeNumber) string) of
         Left parsingError -> Left parsingError
         Right answerMessage -> Right answerMessage