Remove Dummy Query, since morpho doesn't support node-to-client queries

The only problem is that the roundtrip_all tries to test node-to-client
queries. We can just run its individual test cases though, leaving out
the node-to-client ones

morpho-checkpoint-node/src/Morpho/Ledger/Serialise.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -16,8 +17,6 @@
 module Morpho.Ledger.Serialise where
 
 import Cardano.Prelude
-import Codec.CBOR.Decoding (Decoder)
-import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR
 import Codec.Serialise (Serialise (..))
 import Control.Monad.Except
@@ -178,33 +177,12 @@ instance
   (blk ~ MorphoBlock h c, BftCrypto c) =>
   SerialiseNodeToClient blk (SomeSecond Query blk)
   where
-  encodeNodeToClient _ _ (SomeSecond q) = encodeMorphoQuery q
-  decodeNodeToClient _ _ = decodeMorphoQuery
+  encodeNodeToClient _ _ query = case query of
+  decodeNodeToClient _ _ = fail "Morpho doesn't support node-to-client queries"
 
 instance
   (blk ~ MorphoBlock h c, BftCrypto c) =>
   SerialiseResult blk (Query blk)
   where
-  encodeResult _ _ = encodeMorphoResult
-  decodeResult _ _ = decodeMorphoResult
-
-encodeMorphoQuery :: Query (MorphoBlock h c) result -> CBOR.Encoding
-encodeMorphoQuery query = case query of
-  GetDummy -> CBOR.encodeWord8 0
-
-decodeMorphoQuery :: Decoder s (SomeSecond Query (MorphoBlock h c))
-decodeMorphoQuery = do
-  tag <- CBOR.decodeWord8
-  case tag of
-    0 -> return $ SomeSecond GetDummy
-    _ -> fail $ "decodeMorphoQuery: invalid tag " <> show tag
-
-encodeMorphoResult :: Query (MorphoBlock h c) result -> result -> CBOR.Encoding
-encodeMorphoResult query = case query of
-  GetDummy -> encode
-
-decodeMorphoResult ::
-  Query (MorphoBlock h c) result ->
-  forall s. Decoder s result
-decodeMorphoResult query = case query of
-  GetDummy -> decode
+  encodeResult _ _ query = case query of
+  decodeResult _ _ query = case query of

morpho-checkpoint-node/src/Morpho/Ledger/Update.hs

@@ -7,7 +7,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -25,7 +24,7 @@ module Morpho.Ledger.Update
     GenTx (..),
     LedgerState (..),
     MorphoStateDefaultConstraints,
-    Query (..),
+    Query,
     ExtractTxError (..),
     WontPushCheckpoint (..),
     Ticked (..),
@@ -374,16 +373,15 @@ instance HasHardForkHistory (MorphoBlock h c) where
   QueryLedger
 -------------------------------------------------------------------------------}
 
-data instance Query (MorphoBlock h c) :: Type -> Type where
-  GetDummy :: Query (MorphoBlock h c) ()
+data instance Query (MorphoBlock h c) :: Type -> Type
 
 deriving instance Show (Query (MorphoBlock h c) result)
 
 instance SameDepIndex (Query (MorphoBlock h c)) where
-  sameDepIndex GetDummy GetDummy = Just Refl
+  sameDepIndex query = case query of
 
 instance ShowQuery (Query (MorphoBlock h c)) where
-  showResult GetDummy = show
+  showResult query = case query of
 
 instance QueryLedger (MorphoBlock h c) where
-  answerQuery _ GetDummy _ = ()
+  answerQuery _ query = case query of

morpho-checkpoint-node/tests/Test/Morpho/Generators.hs

@@ -152,12 +152,6 @@ instance Arbitrary (HeaderHash blk) => Arbitrary (ChainHash blk) where
 instance Arbitrary (SomeSecond (NestedCtxt Header) TestBlock) where
   arbitrary = return $ SomeSecond indexIsTrivial
 
-instance Arbitrary (SomeSecond Query TestBlock) where
-  arbitrary = return $ SomeSecond GetDummy
-
-instance Arbitrary (SomeResult TestBlock) where
-  arbitrary = SomeResult GetDummy <$> arbitrary
-
 instance Arbitrary (LedgerState TestBlock) where
   arbitrary = MorphoLedgerState <$> arbitrary
 

morpho-checkpoint-node/tests/Test/Morpho/Serialisation.hs

@@ -4,28 +4,38 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Test.Morpho.Serialisation
   ( serialiseTests,
   )
 where
 
+import Cardano.Prelude
 import Morpho.Ledger.Block
 import Morpho.Ledger.Serialise
-import Ouroboros.Consensus.Node.Serialisation ()
 import Ouroboros.Consensus.Util (Dict (..))
 import Test.Morpho.Generators
 import Test.Tasty
+import Test.Tasty.QuickCheck
 import Test.Util.Orphans.Arbitrary ()
 import Test.Util.Serialisation.Roundtrip
-import Prelude
 
 serialiseTests :: TestTree
 serialiseTests =
   testGroup
     "Serialisation"
-    [ roundtrip_all testCodecCfg dictNestedHdr
+    [ testGroup "SerialiseDisk" $ roundtrip_SerialiseDisk testCodecCfg dictNestedHdr,
+      testGroup "SerialiseNodeToNode" $ roundtrip_SerialiseNodeToNode testCodecCfg,
+      -- We don't have any node-to-client queries, so we can't derive an Arbitrary instance for testing it
+      --, testGroup "SerialiseNodeToClient" $ roundtrip_SerialiseNodeToClient testCodecCfg
+      testProperty "envelopes" $ roundtrip_envelopes testCodecCfg,
+      testProperty "ConvertRawHash" $ roundtrip_ConvertRawHash (Proxy @TestBlock),
+      testProperty "hashSize" $ prop_hashSize (Proxy @TestBlock)
+      -- Currently the prop_estimateBlockSize is not exported by Test.Util.Serialisation.Roundtrip
+      -- TODO: Uncomment after https://github.com/input-output-hk/ouroboros-network/pull/2972 is included
+      --, testProperty "estimateBlockSize"  $ prop_estimateBlockSize         testCodecCfg
     ]
   where
     testCodecCfg :: CodecConfig TestBlock