Remove FromCBOR and ToCBOR instances from LedgerDB.HD module.

As a result, we can remove `FromCBOR` and `ToCBOR` instances for the
`ApplyMapKind'` datatype as well. This warranted a small change to
serialisation in the `OnDisk` tests.

ouroboros-consensus-test/test-storage/Test/Ouroboros/Storage/LedgerDB/OnDisk.hs

@@ -32,6 +32,8 @@ module Test.Ouroboros.Storage.LedgerDB.OnDisk (
 
 import           Prelude hiding (elem)
 
+import qualified Codec.CBOR.Decoding as CBOR
+import qualified Codec.CBOR.Encoding as CBOR
 import           Codec.Serialise (Serialise)
 import qualified Codec.Serialise as S
 import           Control.Monad.Except (Except, runExcept)
@@ -313,8 +315,9 @@ instance SufficientSerializationForAnyBackingStore (LedgerState TestBlock) where
   codecLedgerTables = TokenToTValue $ CodecMK toCBOR toCBOR fromCBOR fromCBOR
 
 instance Serialise (LedgerTables (LedgerState TestBlock) EmptyMK) where
-  encode TokenToTValue {testUtxtokTable} = toCBOR testUtxtokTable
-  decode = fmap TokenToTValue fromCBOR
+  encode (TokenToTValue (_ :: EmptyMK Token TValue))
+         = CBOR.encodeNull
+  decode = TokenToTValue ApplyEmptyMK <$ CBOR.decodeNull
 
 instance ToCBOR Token where
   toCBOR (Token pt) = S.encode pt

ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Basics.hs

@@ -132,13 +132,10 @@ module Ouroboros.Consensus.Ledger.Basics (
 import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR
 import qualified Control.Exception as Exn
-import           Control.Monad (when)
 import           Data.Bifunctor (bimap)
 import           Data.Kind (Type)
 import qualified Data.Map as Map
 import           Data.Monoid (Sum (..))
-import           Data.Typeable (Typeable)
-import           Data.Word (Word8)
 import           GHC.Generics (Generic)
 import           GHC.Show (showCommaSpace, showSpace)
 import           NoThunks.Class (NoThunks (..), OnlyCheckWhnfNamed (..))
@@ -846,61 +843,6 @@ instance (Ord k, NoThunks k, NoThunks v) => NoThunks (ApplyMapKind' mk k v) wher
 
   showTypeOf _ = "ApplyMapKind"
 
-instance
-     (Typeable mk, Ord k, ToCBOR k, ToCBOR v, SingI mk)
-  => ToCBOR (ApplyMapKind' mk k v) where
-  toCBOR = \case
-      ApplyEmptyMK            -> encodeArityAndTag 0 []
-      ApplyKeysMK ks          -> encodeArityAndTag 1 [toCBOR ks]
-      ApplyValuesMK vs        -> encodeArityAndTag 2 [toCBOR vs]
-      ApplyTrackingMK vs diff -> encodeArityAndTag 3 [toCBOR vs, toCBOR diff]
-      ApplyDiffMK diff        -> encodeArityAndTag 4 [toCBOR diff]
-      ApplySeqDiffMK diffs    -> encodeArityAndTag 5 [toCBOR diffs]
-      ApplyQueryAllMK         -> encodeArityAndTag 7 []
-      ApplyQuerySomeMK ks     -> encodeArityAndTag 7 [toCBOR ks]
-    where
-      encodeArityAndTag :: Word8 -> [CBOR.Encoding] -> CBOR.Encoding
-      encodeArityAndTag tag xs =
-           CBOR.encodeListLen (1 + toEnum (length xs))
-        <> CBOR.encodeWord8 tag
-        <> mconcat xs
-
-instance
-     (Typeable mk, Ord k, FromCBOR k, FromCBOR v, SingI mk)
-  => FromCBOR (ApplyMapKind' mk k v) where
-  fromCBOR = do
-    case smk of
-      SEmptyMK    -> decodeArityAndTag 0 0 *> (ApplyEmptyMK    <$  pure ())
-      SKeysMK     -> decodeArityAndTag 1 1 *> (ApplyKeysMK     <$> fromCBOR)
-      SValuesMK   -> decodeArityAndTag 1 2 *> (ApplyValuesMK   <$> fromCBOR)
-      STrackingMK -> decodeArityAndTag 2 3 *> (ApplyTrackingMK <$> fromCBOR <*> fromCBOR)
-      SDiffMK     -> decodeArityAndTag 1 4 *> (ApplyDiffMK     <$> fromCBOR)
-      SSeqDiffMK  -> decodeArityAndTag 1 5 *> (ApplySeqDiffMK  <$> fromCBOR)
-      SQueryMK    -> do
-        len <- CBOR.decodeListLen
-        tag <- CBOR.decodeWord8
-        case (len, tag) of
-          (2, 7) -> pure ApplyQueryAllMK
-          (3, 8) -> ApplyQuerySomeMK <$> fromCBOR
-          o      -> fail $ "decode @ApplyMapKind SQueryMK, " <> show o
-    where
-      smk = sMapKind @(ApplyMapKind' mk)
-
-      decodeArityAndTag :: Int -> Word8 -> CBOR.Decoder s ()
-      decodeArityAndTag len tag = do
-        len' <- CBOR.decodeListLen
-        tag' <- CBOR.decodeWord8
-        -- @len@ here ought to match the @length xs@ in @encodeArityAndTag@ in
-        -- the corresponding 'ToCBOR' instance, so we need to add one in order
-        -- to match the length recorded in the CBOR stream (ie @len'@)
-        --
-        -- This use of 'when' corresponds to the use of 'decodeListLenOf'
-        -- throughout most of our CBOR decoders: it catches encoder/decoder
-        -- mismatches.
-        when
-          (1 + len /= len' || tag /= tag')
-          (fail $ "decode @ApplyMapKind " <> show (smk, len, tag, len', tag'))
-
 showsApplyMapKind :: (Show k, Show v) => ApplyMapKind' mk k v -> ShowS
 showsApplyMapKind = \case
     ApplyEmptyMK                -> showString "ApplyEmptyMK"

ouroboros-consensus/src/Ouroboros/Consensus/Storage/LedgerDB/HD.hs

@@ -47,10 +47,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.HD (
   , SudMeasure (..)
   ) where
 
-import qualified Codec.CBOR.Decoding as CBOR
-import qualified Codec.CBOR.Encoding as CBOR
 import qualified Control.Exception as Exn
-import           Data.Foldable (toList)
 import           Data.Map (Map)
 import qualified Data.Map.Merge.Strict as MapMerge
 import qualified Data.Map.Strict as Map
@@ -114,44 +111,14 @@ mapUtxoValues f (UtxoValues vs) = UtxoValues $ Map.map f vs
 newtype UtxoDiff k v = UtxoDiff (Map k (UtxoEntryDiff v))
   deriving (Eq, Generic, NoThunks, Show)
 
-instance (Ord k, ToCBOR k, ToCBOR v) => ToCBOR (UtxoDiff k v) where
-  toCBOR (UtxoDiff m) = versionZeroProductToCBOR [toCBOR m]
-
-instance (Ord k, FromCBOR k, FromCBOR v) => FromCBOR (UtxoDiff k v) where
-  fromCBOR = versionZeroProductFromCBOR "UtxoDiff" 1 $ UtxoDiff <$> fromCBOR
-
 -- | The key's value and how it changed
 data UtxoEntryDiff v = UtxoEntryDiff !v !UtxoEntryDiffState
   deriving (Eq, Generic, NoThunks, Show)
 
-instance ToCBOR v => ToCBOR (UtxoEntryDiff v) where
-  toCBOR (UtxoEntryDiff v diffstate) =
-      versionZeroProductToCBOR [toCBOR v, toCBOR diffstate]
-
-instance FromCBOR v => FromCBOR (UtxoEntryDiff v) where
-  fromCBOR =
-        versionZeroProductFromCBOR "UtxoEntryDiff" 2
-      $ UtxoEntryDiff <$> fromCBOR <*> fromCBOR
-
 -- | Whether an entry was deleted, inserted, or inserted-and-then-deleted
 data UtxoEntryDiffState = UedsDel | UedsIns | UedsInsAndDel
   deriving (Eq, Generic, NoThunks, Show)
 
-instance ToCBOR UtxoEntryDiffState where
-  toCBOR = (CBOR.encodeListLen 1 <>) . \case
-    UedsDel       -> CBOR.encodeWord 0
-    UedsIns       -> CBOR.encodeWord 1
-    UedsInsAndDel -> CBOR.encodeWord 2
-
-instance FromCBOR UtxoEntryDiffState where
-  fromCBOR = do
-      CBOR.decodeListLenOf 1
-      CBOR.decodeWord >>= \case
-        0 -> pure UedsDel
-        1 -> pure UedsIns
-        2 -> pure UedsInsAndDel
-        o -> fail $ "UtxoEntryDiffState unknown tag: " <> show o
-
 -- | Assumes the colliding value is equivalent, since UTxO map is functional
 --
 -- Note that this fails via 'error' if a UTxO is inserted twice, deleted twice,
@@ -204,12 +171,6 @@ differenceUtxoValues (UtxoValues m1) (UtxoValues m2) =
 newtype UtxoKeys k v = UtxoKeys (Set k)
   deriving (Eq, Generic, NoThunks, Show)
 
-instance (Ord k, ToCBOR k, ToCBOR v) => ToCBOR (UtxoKeys k v) where
-  toCBOR (UtxoKeys m) = versionZeroProductToCBOR [toCBOR m]
-
-instance (Ord k, FromCBOR k, FromCBOR v) => FromCBOR (UtxoKeys k v) where
-  fromCBOR = versionZeroProductFromCBOR "UtxoKeys" 1 $ UtxoKeys <$> fromCBOR
-
 instance Ord k => Monoid (UtxoKeys k v) where
   mempty = UtxoKeys Set.empty
 
@@ -287,14 +248,6 @@ newtype SeqUtxoDiff k v =
     SeqUtxoDiff (StrictFingerTree (SudMeasure k v) (SudElement k v))
   deriving (Eq, Generic, NoThunks, Show)
 
-instance (Ord k, ToCBOR k, ToCBOR v) => ToCBOR (SeqUtxoDiff k v) where
-  toCBOR (SeqUtxoDiff ft) = versionZeroProductToCBOR [toCBOR (toList ft)]
-
-instance (Ord k, FromCBOR k, FromCBOR v) => FromCBOR (SeqUtxoDiff k v) where
-  fromCBOR =
-        versionZeroProductFromCBOR "SeqUtxoDiff" 1
-      $ (SeqUtxoDiff . FT.fromList) <$> fromCBOR
-
 -- TODO no Semigroup instance just because I don't think we need it
 
 emptySeqUtxoDiff :: Ord k => SeqUtxoDiff k v
@@ -311,25 +264,6 @@ data SudMeasure k v =
                      !(UtxoDiff k v)   -- ^ cumulative diff
   deriving (Eq, Generic, Show)
 
-instance (Ord k, ToCBOR k, ToCBOR v) => ToCBOR (SudMeasure k v) where
-  toCBOR = \case
-    SudMeasureNothing             -> CBOR.encodeListLen 1 <> CBOR.encodeWord 0
-    SudMeasureJust size slot diff ->
-         CBOR.encodeListLen 4
-      <> CBOR.encodeWord 1
-      <> toCBOR size
-      <> toCBOR slot
-      <> toCBOR diff
-
-instance (Ord k, FromCBOR k, FromCBOR v) => FromCBOR (SudMeasure k v) where
-  fromCBOR = do
-      len <- CBOR.decodeListLen
-      tag <- CBOR.decodeWord
-      case (len, tag) of
-        (1, 0) -> pure SudMeasureNothing
-        (4, 1) -> SudMeasureJust <$> fromCBOR <*> fromCBOR <*> fromCBOR
-        o      -> fail $ "SudMeasure unknown len and tag: " <> show o
-
 sizeSudMeasure :: SudMeasure k v -> Int
 sizeSudMeasure = \case
     SudMeasureNothing               -> 0
@@ -357,14 +291,6 @@ instance Ord k => Semigroup (SudMeasure k v) where
 data SudElement k v = SudElement {-# UNPACK #-} !SlotNo !(UtxoDiff k v)
   deriving (Eq, Generic, NoThunks, Show)
 
-instance (Ord k, ToCBOR k, ToCBOR v) => ToCBOR (SudElement k v) where
-  toCBOR (SudElement slot diff) = versionZeroProductToCBOR [toCBOR slot, toCBOR diff]
-
-instance (Ord k, FromCBOR k, FromCBOR v) => FromCBOR (SudElement k v) where
-  fromCBOR =
-        versionZeroProductFromCBOR "SudElement" 1
-      $ SudElement <$> fromCBOR <*> fromCBOR
-
 instance
      Ord k
   => FT.Measured (SudMeasure k v) (SudElement k v)