0d1a080a6e
* draft remote protocol types and external api * types (it compiles) * add error * move remote controller from http to remote host client protocol * refactor (doesnt compile) * fix compile * Connect remote session * WIP: wire in remote protocol * add commands and events * cleanup * fix desktop shutdown * prepare for testing remote files * Add file IO * update simplexmq to master with http2 to 4.1.4 * use json transcoder * update simplexmq * collapse RemoteHostSession states * fold RemoteHello back into the protocol command move http-command-response-http wrapper to protocol * use sendRemoteCommand with optional attachments use streaming request/response * ditch lazy body streaming * fix formatting * put body builder/processor closer together * wrap handleRemoteCommand around sending files * handle ChatError's too * remove binary, use 32-bit encoding for JSON bodies * enable tests * refactor * refactor request handling * return ChatError * Flatten remote host --------- Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
66 lines
2.2 KiB
Haskell
66 lines
2.2 KiB
Haskell
{-# LANGUAGE DeriveGeneric #-}
|
|
|
|
module JSONTests where
|
|
|
|
import Data.Aeson (FromJSON, ToJSON)
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.Aeson.Types as JT
|
|
import qualified Data.ByteString.Lazy.Char8 as LB
|
|
import GHC.Generics (Generic)
|
|
import Generic.Random (genericArbitraryU)
|
|
import MobileTests
|
|
import Simplex.Chat.Remote.Protocol (owsf2tagged)
|
|
import Simplex.Messaging.Parsers
|
|
import Test.Hspec
|
|
import Test.Hspec.QuickCheck (modifyMaxSuccess)
|
|
import Test.QuickCheck (Arbitrary (..), property)
|
|
|
|
jsonTests :: Spec
|
|
jsonTests = describe "owsf2tagged" $ do
|
|
it "should convert chat types" owsf2TaggedJSONTest
|
|
describe "SomeType" owsf2TaggedSomeTypeTests
|
|
|
|
owsf2TaggedJSONTest :: IO ()
|
|
owsf2TaggedJSONTest = do
|
|
noActiveUserSwift `to` noActiveUserTagged
|
|
activeUserExistsSwift `to` activeUserExistsTagged
|
|
activeUserSwift `to` activeUserTagged
|
|
chatStartedSwift `to` chatStartedTagged
|
|
networkStatusesSwift `to` networkStatusesTagged
|
|
memberSubSummarySwift `to` memberSubSummaryTagged
|
|
userContactSubSummarySwift `to` userContactSubSummaryTagged
|
|
pendingSubSummarySwift `to` pendingSubSummaryTagged
|
|
parsedMarkdownSwift `to` parsedMarkdownTagged
|
|
where
|
|
to :: LB.ByteString -> LB.ByteString -> IO ()
|
|
owsf `to` tagged =
|
|
case J.eitherDecode owsf of
|
|
Right json -> Right (owsf2tagged json) `shouldBe` J.eitherDecode tagged
|
|
Left e -> expectationFailure e
|
|
|
|
data SomeType
|
|
= Nullary
|
|
| Unary (Maybe SomeType)
|
|
| Product String (Maybe SomeType)
|
|
| Record
|
|
{ testOne :: Int,
|
|
testTwo :: Maybe Bool,
|
|
testThree :: Maybe SomeType
|
|
}
|
|
| List [Int]
|
|
deriving (Eq, Show, Generic)
|
|
|
|
instance Arbitrary SomeType where arbitrary = genericArbitraryU
|
|
|
|
instance ToJSON SomeType where
|
|
toJSON = J.genericToJSON $ singleFieldJSON_ (Just SingleFieldJSONTag) id
|
|
toEncoding = J.genericToEncoding $ singleFieldJSON_ (Just SingleFieldJSONTag) id
|
|
|
|
instance FromJSON SomeType where
|
|
parseJSON = J.genericParseJSON $ taggedObjectJSON id
|
|
|
|
owsf2TaggedSomeTypeTests :: Spec
|
|
owsf2TaggedSomeTypeTests =
|
|
modifyMaxSuccess (const 10000) $ it "should convert to tagged" $ property $ \x ->
|
|
(JT.parseMaybe J.parseJSON . owsf2tagged . J.toJSON) x == Just (x :: SomeType)
|