{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE QuasiQuotes #-} module Test.Offline.JSON (tests) where import Data.Aeson import Data.ByteString qualified as B import Data.ByteString.Lazy.Char8 qualified as C8 import Data.Either import Gargantext.API.Errors import Gargantext.API.Node.Corpus.Types import Gargantext.API.Node.Types import Gargantext.API.Viz.Types import Gargantext.Core.Types.Phylo import Gargantext.Database.Admin.Types.Node import Paths_gargantext import Prelude import Test.Instances () import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck import Text.RawString.QQ jsonRoundtrip :: (Show a, FromJSON a, ToJSON a, Eq a) => a -> Property jsonRoundtrip a = counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a class (Show a, FromJSON a, ToJSON a, Eq a, Enum a, Bounded a) => EnumBoundedJSON a instance EnumBoundedJSON BackendErrorCode instance EnumBoundedJSON NodeType jsonEnumRoundtrip :: forall a. Dict EnumBoundedJSON a -> Property jsonEnumRoundtrip d = case d of Dict -> conjoin $ map (prop Dict) [minBound .. maxBound] where prop :: Dict EnumBoundedJSON a -> a -> Property prop Dict a = counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a -- | Tests /all/ the 'BackendErrorCode' and their associated 'FrontendError' payloads. jsonFrontendErrorRoundtrip :: Property jsonFrontendErrorRoundtrip = conjoin $ map mk_prop [minBound .. maxBound] where mk_prop :: BackendErrorCode -> Property mk_prop code = forAll (genFrontendErr code) $ \a -> counterexample ("Parsed JSON: " <> C8.unpack (encode a)) $ eitherDecode (encode a) === Right a tests :: TestTree tests = testGroup "JSON" [ testProperty "NodeId roundtrips" (jsonRoundtrip @NodeId) , testProperty "RootId roundtrips" (jsonRoundtrip @RootId) , testProperty "Datafield roundtrips" (jsonRoundtrip @Datafield) , testProperty "WithQuery roundtrips" (jsonRoundtrip @WithQuery) , testProperty "FrontendError roundtrips" jsonFrontendErrorRoundtrip , testProperty "BackendErrorCode roundtrips" (jsonEnumRoundtrip (Dict @_ @BackendErrorCode)) , testProperty "NodeType roundtrips" (jsonEnumRoundtrip (Dict @_ @NodeType)) , testCase "WithQuery frontend compliance" testWithQueryFrontend , testGroup "Phylo" [ testProperty "PeriodToNode" (jsonRoundtrip @PeriodToNodeData) , testProperty "GraphData" (jsonRoundtrip @GraphData) , testProperty "GraphDataData" (jsonRoundtrip @GraphDataData) , testProperty "ObjectData" (jsonRoundtrip @ObjectData) , testProperty "PhyloData" (jsonRoundtrip @PhyloData) , testProperty "LayerData" (jsonRoundtrip @LayerData) , testCase "can parse bpa_phylo_test.json" testParseBpaPhylo , testCase "can parse open_science.json" testOpenSciencePhylo ] ] testWithQueryFrontend :: Assertion testWithQueryFrontend = do case eitherDecode @WithQuery (C8.pack cannedWithQueryPayload) of Left err -> fail $ "JSON instance will break frontend!: JSON decoding returned: " <> err Right _ -> pure () -- The aim of this type is to catch regressions in the frontend serialisation; this -- is what the frontend currently expects, and therefore if we were to change the JSON -- instances, this test would fail, and we will be notified. cannedWithQueryPayload :: String cannedWithQueryPayload = [r| {"query":"Haskell","node_id":138,"lang":"EN","flowListWith":{"type":"MyListsFirst"},"datafield": { "External": "Arxiv"},"databases":"Arxiv"} |] testParseBpaPhylo :: Assertion testParseBpaPhylo = do pth <- getDataFileName "test-data/phylo/bpa_phylo_test.json" jsonBlob <- B.readFile pth case eitherDecodeStrict' @GraphData jsonBlob of Left err -> error err Right _ -> pure () testOpenSciencePhylo :: Assertion testOpenSciencePhylo = do pth <- getDataFileName "test-data/phylo/open_science.json" jsonBlob <- B.readFile pth case eitherDecodeStrict' @PhyloData jsonBlob of Left err -> error err Right _ -> pure ()