[shelley] - ShelleyTxWits

IntersectMBO · Jan 23, 2025 · 2d9784d · 2d9784d
1 parent ef12d45
commit 2d9784d
Showing 1 changed file with 32 additions and 1 deletion.
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/TxWits.hs
@@ -62,6 +62,7 @@ import Cardano.Ledger.MemoBytes (
   Mem,
   MemoBytes,
   Memoized (..),
+  decodeMemoized,
   getMemoRawType,
   lensMemoRawType,
   mkMemoizedEra,
@@ -124,6 +125,9 @@ instance
 
 instance EraScript era => NoThunks (ShelleyTxWits era)
 
+instance (EraScript era, DecCBOR (Script era)) => DecCBOR (ShelleyTxWits era) where
+  decCBOR = ShelleyTxWitsConstr <$> decodeMemoized decCBOR
+
 -- =======================================================
 -- Accessors
 -- =======================================================
@@ -229,9 +233,36 @@ deriving via
 newtype IgnoreSigOrd kr = IgnoreSigOrd {unIgnoreSigOrd :: WitVKey kr}
   deriving (Eq)
 
+withIgnoreSigOrd :: Typeable kr => [WitVKey kr] -> Set (WitVKey kr)
+withIgnoreSigOrd = Set.map unIgnoreSigOrd . Set.fromList . fmap IgnoreSigOrd
+
 instance Typeable kr => Ord (IgnoreSigOrd kr) where
   compare (IgnoreSigOrd w1) (IgnoreSigOrd w2) = compare (witVKeyHash w1) (witVKeyHash w2)
 
+instance forall era. (EraScript era, DecCBOR (Script era)) => DecCBOR (ShelleyTxWitsRaw era) where
+  decCBOR =
+    decode $
+      SparseKeyed
+        "ShelleyTxWitsRaw"
+        (ShelleyTxWitsRaw mempty mempty mempty)
+        witField
+        []
+    where
+      witField :: Word -> Field (ShelleyTxWitsRaw era)
+      witField 0 =
+        field
+          (\x wits -> wits {addrWits' = x})
+          (D $ withIgnoreSigOrd <$> decodeList decCBOR)
+      witField 1 =
+        field
+          (\x wits -> wits {scriptWits' = x})
+          (D $ Map.fromElems (hashScript @era) <$> decodeList decCBOR)
+      witField 2 =
+        field
+          (\x wits -> wits {bootWits' = x})
+          (D $ Set.fromList <$> decodeList decCBOR)
+      witField n = field (\_ wits -> wits) (Invalid n)
+
 decodeWits ::
   forall era s.
   EraScript era =>
@@ -252,7 +283,7 @@ decodeWits =
         ( D $
             mapTraverseableDecoderA
               (decodeList decCBOR)
-              (Set.map unIgnoreSigOrd . Set.fromList . fmap IgnoreSigOrd)
+              withIgnoreSigOrd
         )
     witField 1 =
       fieldAA