Fix serialisation

Author: Lucsanszky

eras/conway/impl/src/Cardano/Ledger/Conway/TxCert.hs

@@ -26,6 +26,7 @@ module Cardano.Ledger.Conway.TxCert (
   ConwayGovCert (..),
   Delegatee (..),
   ConwayEraTxCert (..),
+  conwayTxCertDelegDecoder,
   fromShelleyDelegCert,
   toShelleyDelegCert,
   getScriptWitnessConwayTxCert,

eras/dijkstra/src/Cardano/Ledger/Dijkstra/TxCert.hs

@@ -25,7 +25,6 @@ import Cardano.Ledger.Binary (
   EncCBOR (..),
   FromCBOR (..),
   ToCBOR (..),
-  decodeNullStrictMaybe,
   decodeRecordSum,
   encodeListLen,
   encodeWord8,
@@ -57,6 +56,7 @@ import Cardano.Ledger.Conway.TxCert (
   Delegatee (..),
   conwayTotalDepositsTxCerts,
   conwayTotalRefundsTxCerts,
+  conwayTxCertDelegDecoder,
  )
 import Cardano.Ledger.Core (
   Era,
@@ -86,19 +86,19 @@ instance EncCBOR DijkstraDelegCert where
   encCBOR = \case
     DijkstraRegDelegCert cred (DelegStake poolId) deposit ->
       encodeListLen 4
-        <> encodeWord8 11
+        <> encodeWord8 19
         <> encCBOR cred
         <> encCBOR poolId
         <> encCBOR deposit
     DijkstraRegDelegCert cred (DelegVote drep) deposit ->
       encodeListLen 4
-        <> encodeWord8 12
+        <> encodeWord8 20
         <> encCBOR cred
         <> encCBOR drep
         <> encCBOR deposit
     DijkstraRegDelegCert cred (DelegStakeVote poolId dRep) deposit ->
       encodeListLen 5
-        <> encodeWord8 13
+        <> encodeWord8 21
         <> encCBOR cred
         <> encCBOR poolId
         <> encCBOR dRep
@@ -126,6 +126,8 @@ data DijkstraTxCert era
 data DijkstraTxCertUpgradeError
   = RegTxCertExpunged
   | UnRegTxCertExpunged
+  | RegDepositTxCertExpunged
+  | UnRegDepositTxCertExpunged
   | DelegTxCertExpunged
   deriving (Eq, Show)
 
@@ -159,49 +161,18 @@ instance
       | 3 <= t && t < 5 -> poolTxCertDecoder t
       | t == 5 -> fail "Genesis delegation certificates are no longer supported"
       | t == 6 -> fail "MIR certificates are no longer supported"
-      | 7 <= t -> dijkstraTxCertDelegDecoder t
+      | 7 <= t && t < 11 -> fail "Certificates without deposits are no longer supported"
+      | 11 <= t && t < 19 -> conwayTxCertDelegDecoder t
+      | 19 <= t -> dijkstraTxCertDelegDecoder t
     t -> invalidKey t
 
 dijkstraTxCertDelegDecoder :: ConwayEraTxCert era => Word -> Decoder s (Int, TxCert era)
 dijkstraTxCertDelegDecoder = \case
-  7 -> do
-    cred <- decCBOR
-    deposit <- decCBOR
-    pure (3, RegDepositTxCert cred deposit)
-  8 -> do
-    cred <- decCBOR
-    deposit <- decCBOR
-    pure (3, UnRegDepositTxCert cred deposit)
-  9 -> delegCertDecoder
-  10 -> delegCertDecoder
-  11 -> regDelegCertDecoder 4 (DelegStake <$> decCBOR)
-  12 -> regDelegCertDecoder 4 (DelegVote <$> decCBOR)
-  13 -> regDelegCertDecoder 5 (DelegStakeVote <$> decCBOR <*> decCBOR)
-  14 -> do
-    cred <- decCBOR
-    key <- decCBOR
-    pure (3, AuthCommitteeHotKeyTxCert cred key)
-  15 -> do
-    cred <- decCBOR
-    a <- decodeNullStrictMaybe decCBOR
-    pure (3, ResignCommitteeColdTxCert cred a)
-  16 -> do
-    cred <- decCBOR
-    deposit <- decCBOR
-    mAnchor <- decodeNullStrictMaybe decCBOR
-    pure (4, RegDRepTxCert cred deposit mAnchor)
-  17 -> do
-    cred <- decCBOR
-    deposit <- decCBOR
-    pure (3, UnRegDRepTxCert cred deposit)
-  18 -> do
-    cred <- decCBOR
-    mAnchor <- decodeNullStrictMaybe decCBOR
-    pure (3, UpdateDRepTxCert cred mAnchor)
+  19 -> regDelegCertDecoder 4 (DelegStake <$> decCBOR)
+  20 -> regDelegCertDecoder 4 (DelegVote <$> decCBOR)
+  21 -> regDelegCertDecoder 5 (DelegStakeVote <$> decCBOR <*> decCBOR)
   k -> invalidKey k
   where
-    delegCertDecoder = fail "Delegation certificates without deposits are no longer supported"
-    {-# INLINE delegCertDecoder #-}
     regDelegCertDecoder n decodeDelegatee = do
       cred <- decCBOR
       delegatee <- decodeDelegatee
@@ -225,18 +196,18 @@ instance EraTxCert DijkstraEra where
   type TxCertUpgradeError DijkstraEra = DijkstraTxCertUpgradeError
 
   upgradeTxCert = \case
-    RegPoolTxCert poolParams -> Right $ RegPoolTxCert poolParams -- x
-    RetirePoolTxCert poolId epochNo -> Right $ RetirePoolTxCert poolId epochNo -- x
-    RegTxCert _ -> Left RegTxCertExpunged -- x
-    UnRegTxCert _ -> Left UnRegTxCertExpunged -- x
-    RegDepositTxCert cred c -> Right $ RegDepositTxCert cred c -- x
-    UnRegDepositTxCert cred c -> Right $ UnRegDepositTxCert cred c -- x
+    RegPoolTxCert poolParams -> Right $ RegPoolTxCert poolParams
+    RetirePoolTxCert poolId epochNo -> Right $ RetirePoolTxCert poolId epochNo
+    RegTxCert _ -> Left RegTxCertExpunged
+    UnRegTxCert _ -> Left UnRegTxCertExpunged
+    RegDepositTxCert _ _ -> Left RegDepositTxCertExpunged
+    UnRegDepositTxCert _ _ -> Left UnRegDepositTxCertExpunged
     RegDepositDelegTxCert cred d c -> Right $ RegDepositDelegTxCert cred d c
-    AuthCommitteeHotKeyTxCert ck hk -> Right $ AuthCommitteeHotKeyTxCert ck hk -- x
-    ResignCommitteeColdTxCert ck a -> Right $ ResignCommitteeColdTxCert ck a -- x
-    RegDRepTxCert cred deposit mAnchor -> Right $ RegDRepTxCert cred deposit mAnchor -- x
-    UnRegDRepTxCert cred deposit -> Right $ UnRegDRepTxCert cred deposit -- x
-    UpdateDRepTxCert cred mAnchor -> Right $ UpdateDRepTxCert cred mAnchor -- x
+    AuthCommitteeHotKeyTxCert ck hk -> Right $ AuthCommitteeHotKeyTxCert ck hk
+    ResignCommitteeColdTxCert ck a -> Right $ ResignCommitteeColdTxCert ck a
+    RegDRepTxCert cred deposit mAnchor -> Right $ RegDRepTxCert cred deposit mAnchor
+    UnRegDRepTxCert cred deposit -> Right $ UnRegDRepTxCert cred deposit
+    UpdateDRepTxCert cred mAnchor -> Right $ UpdateDRepTxCert cred mAnchor
     -- Using wildcard here instead of a pattern match on DelegTxCert in order to
     -- workaround ghc disrespecting the completeness pragma.
     _ -> Left DelegTxCertExpunged