serialization stuff

alonzo/impl/cardano-ledger-alonzo.cabal

@@ -59,6 +59,7 @@ library test
     Test.Cardano.Ledger.Alonzo.Serialisation.Generators
   build-depends:
     base >=4.14 && <4.15,
+    base16-bytestring,
     cardano-crypto-class,
     cardano-ledger-alonzo,
     cardano-ledger-shelley-ma-test,
@@ -88,6 +89,7 @@ test-suite tests
   build-depends:
     base >=4.14 && <4.15,
     bytestring,
+    base16-bytestring,
     cardano-binary,
     cardano-ledger-alonzo,
     cardano-ledger-shelley-ma-test,

alonzo/impl/src/Cardano/Ledger/Alonzo/Data.hs

@@ -19,7 +19,7 @@ module Cardano.Ledger.Alonzo.Data
   )
 where
 
-import Cardano.Binary (FromCBOR (..), ToCBOR (..))
+import Cardano.Binary (FromCBOR (..), ToCBOR (..), encodeInt, decodeInt)
 import qualified Cardano.Crypto.Hash as Hash
 import Cardano.Ledger.Crypto (HASH)
 import qualified Cardano.Ledger.Crypto as CC
@@ -42,15 +42,14 @@ instance NoThunks PlutusData
 -- | TODO appropriate serialisation for the Real Plutus Data
 
 instance ToCBOR (PlutusData) where
-  toCBOR = encode . encodeData
-    where
-      encodeData NotReallyData = Sum NotReallyData 0
+  toCBOR _ = encodeInt 0
 
 instance FromCBOR (PlutusData) where
-  fromCBOR = decode $ Summands "Data" decodeData
-    where
-      decodeData 0 = SumD NotReallyData
-      decodeData n = Invalid n
+  fromCBOR = do
+    i <- decodeInt
+    case i of
+      0 -> pure NotReallyData
+      _ -> fail "oh no"
 
 instance FromCBOR (Annotator PlutusData) where
    fromCBOR = pure <$> fromCBOR

alonzo/impl/src/Cardano/Ledger/Alonzo/TxWitness.hs

@@ -20,7 +20,7 @@
 module Cardano.Ledger.Alonzo.TxWitness
   ( RdmrPtr (..),
     TxWitness (TxWitness, witsVKey, witsBoot, witsScript, witsData, witsRdmr),
-    ScriptData(..),
+    ScriptData(ScriptData),
     EraIndependentScriptData,
     ScriptDataHash (..),
     hashSD,
@@ -320,11 +320,10 @@ decodeSplitMap :: Ord dom =>
      -> Decoder s (Annotator rngLeft)
      -> Decoder s rngRight
      -> Decoder s (Annotator (Map dom (rngLeft, rngRight)))
-decodeSplitMap a b c = decodeMapTraverse (pure <$> a) (decodeSplitPair b c)
-
-decodeSplitPair :: Monad m => m (Annotator left) -> m right -> m (Annotator (left, right))
-decodeSplitPair a b = do x <- a; y <- b; pure(liftA2 (,) x (pure y))
+decodeSplitMap a b c = decodeMapTraverse (pure <$> a) (liftPair <$> decodePair b c)
 
+liftPair :: (Annotator a, b) -> Annotator (a,b)
+liftPair (x,y) = liftA2 (,) x (pure y)
 
 deriving via
   (Mem (ScriptDataRaw era))

alonzo/impl/test/lib/Test/Cardano/Ledger/Alonzo/Serialisation/Generators.hs

@@ -62,6 +62,16 @@ instance
       <*> arbitrary
       <*> arbitrary
 
+instance
+  ( Era era,
+    UsesValue era,
+    Mock (Crypto era),
+    Arbitrary (Core.Script era),
+    UsesScript era
+  ) => Arbitrary (ScriptData era)
+  where
+   arbitrary = ScriptData <$> arbitrary <*> arbitrary <*> arbitrary
+
 deriving newtype instance CC.Crypto c => Arbitrary (ScriptDataHash c)
 
 deriving newtype instance CC.Crypto c => Arbitrary (DataHash c)

alonzo/impl/test/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs

@@ -7,14 +7,16 @@ import Cardano.Binary
 import Cardano.Ledger.Alonzo
 import Cardano.Ledger.Alonzo.Tx (Tx)
 import Cardano.Ledger.Alonzo.TxBody (TxBody)
-import Cardano.Ledger.Alonzo.TxWitness (TxWitness)
+import Cardano.Ledger.Alonzo.TxWitness
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import Test.Cardano.Ledger.Alonzo.Serialisation.Generators ()
 import Test.Cardano.Ledger.ShelleyMA.Serialisation.Coders
 import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
 import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes
 import Test.Tasty
 import Test.Tasty.QuickCheck
+import qualified Data.ByteString.Base16.Lazy as Base16
+import Cardano.Ledger.Alonzo.Data
 
 trippingAnn ::
   ( Eq t,
@@ -32,7 +34,10 @@ trippingAnn x = case roundTripAnn x of
       False
   Left stuff ->
     counterexample
-      ("Failed to decode: " <> show stuff)
+      (concat [ "Failed to decode: ", show stuff
+              , "\nbytes: ", show (Base16.encode (serialize x))
+              ]
+      )
       False
 
 tests :: TestTree
@@ -41,6 +46,10 @@ tests =
     "Alonzo CBOR round-trip"
     [ testProperty "alonzo/TxWitness" $
         trippingAnn @(TxWitness (AlonzoEra C_Crypto)),
+      testProperty "alonzo/Data" $
+        trippingAnn @(Data (AlonzoEra C_Crypto)),
+      testProperty "alonzo/ScriptDataRaw" $
+        trippingAnn @(ScriptData (AlonzoEra C_Crypto)),
       testProperty "alonzo/TxBody" $
         trippingAnn @(TxBody (AlonzoEra C_Crypto)),
       testProperty "alonzo/Tx" $

semantics/executable-spec/src/Data/Coders.hs

@@ -45,6 +45,7 @@ module Data.Coders
     decode,
     runE,            -- Used in testing
     decodeList,
+    decodePair,
     decodeSeq,
     decodeStrictSeq,
     decodeSet,
@@ -54,6 +55,7 @@ module Data.Coders
     unusedRequiredKeys,
     duplicateKey,
     wrapCBORArray,
+    encodePair,
     encodeFoldable,
     decodeCollectionWithLen,
     decodeCollection,
@@ -147,6 +149,19 @@ decodeNullMaybe decoder = do
       pure Nothing
     _ -> Just <$> decoder
 
+
+decodePair :: Decoder s a -> Decoder s b -> Decoder s (a,b)
+decodePair first second = decodeRecordNamed "pair" (const 2) $ do
+  a <- first
+  b <- second
+  pure (a,b)
+
+encodePair :: (a -> Encoding) -> (b -> Encoding) -> (a,b) -> Encoding
+encodePair encodeFirst encodeSecond (x,y) = encodeListLen 2
+  <> encodeFirst x
+  <> encodeSecond y
+
+
 invalidKey :: Word -> Decoder s a
 invalidKey k = cborError $ DecoderErrorCustom "not a valid key:" (Text.pack $ show k)