Parsing JSON messages: FIXED.
This commit is contained in:
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…
Reference in New Issue
Block a user