diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index b64c641..a8da1df 100644 --- a/src/App/AuthenticationForm.purs +++ b/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. diff --git a/src/App/IPC.purs b/src/App/IPC.purs index a86af93..f681f86 100644 --- a/src/App/IPC.purs +++ b/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 - 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 diff --git a/src/App/Messages/AuthenticationDaemon.purs b/src/App/Messages/AuthenticationDaemon.purs index 75dc9e4..33bb9fb 100644 --- a/src/App/Messages/AuthenticationDaemon.purs +++ b/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 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