Parsing JSON messages: FIXED.

master
Philippe Pittoli 9 months ago
parent 0671e1780c
commit 2d269d088c

@ -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.

@ -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
stringview <- Parsing.DataView.takeN length
length <- Parsing.DataView.anyUint32be
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

@ -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 number json
decode :: Int -> String -> Either DecodeError AnswerMessage
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.
codecGotError ∷ CA.JsonCodec Error
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 })
parseDecodeJSON :: forall a. CA.JsonCodec a -> String -> Either String a
parseDecodeJSON codec str = do
json <- JSONParser.jsonParser str
lmap CA.printJsonDecodeError (CA.decode codec json)
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

Loading…
Cancel
Save