Derived serialise

IntersectMBO · Oct 28, 2020 · b6a608e · b6a608e
1 parent bbc4fde
commit b6a608e
Show file tree

Hide file tree

Showing 5 changed files with 41 additions and 120 deletions.
diff --git a/plutus-tx/src/Language/PlutusTx/Data.hs b/plutus-tx/src/Language/PlutusTx/Data.hs
@@ -1,24 +1,16 @@
 {-# LANGUAGE BangPatterns       #-}
+{-# LANGUAGE DeriveAnyClass     #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase         #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE ViewPatterns       #-}
 module Language.PlutusTx.Data (Data (..)) where
 
-import           Prelude                   hiding (fail)
-
-import           Control.Monad.Fail
+import           Codec.Serialise           (Serialise)
 import qualified Data.ByteString           as BS
-
-import           Codec.CBOR.Decoding       (Decoder)
-import qualified Codec.CBOR.Decoding       as CBOR
-import           Codec.CBOR.Encoding       (Encoding)
-import qualified Codec.CBOR.Encoding       as CBOR
-import qualified Codec.Serialise           as Serialise
-
 import           Data.Text.Prettyprint.Doc
-
 import           GHC.Generics
+import           Prelude
 
 -- | A generic "data" type.
 --
@@ -33,6 +25,7 @@ data Data =
     | I Integer
     | B BS.ByteString
     deriving stock (Show, Eq, Ord, Generic)
+    deriving anyclass Serialise
 
 instance Pretty Data where
     pretty = \case
@@ -41,75 +34,3 @@ instance Pretty Data where
         List ds -> brackets (sep (punctuate comma (fmap pretty ds)))
         I i -> pretty i
         B b -> viaShow b
-
-{- Note [Permissive decoding]
-We're using a canonical representation of lists, maps, bytes, and integers. However,
-the CBOR library does not guarantee that a TInteger gets encoded as a big integer,
-so we can't rely on getting back our canonical version when we decode (see
-https://github.com/well-typed/cborg/issues/222). So we need to be permissive
-when we decode.
--}
-
-{- Note [Encoding of Data]
-
-All constructors of 'Data' map directly to CBOR primitives, *except* for the
-'Constr' constructor. So to encode a 'Data' value we first write a 'Bool'
-indicating whether the value is a 'Constr' or something else.
-
-When decoding 'Data', if the leading bit is true we know that we are looking at
-a 'Constr', so we can read the two arguments. If it is something else, we
-look at the CBOR token type.
-
--}
-
--- | Check whether this is using the 'Constr' constructor
-isConstr :: Data -> Bool
-isConstr = \case
-    Constr _ _ -> True
-    _ -> False
-
-encodeData :: Data -> Encoding
-encodeData dt = CBOR.encodeBool (isConstr dt) <> encodeRest where
-    encodeRest = case dt of
-            I i -> Serialise.encode i
-            B b -> Serialise.encode b
-            Map entries ->
-                CBOR.encodeMapLenIndef
-                    <> mconcat [ encodeData k <> encodeData v | (k, v) <- entries ]
-                    <> CBOR.encodeBreak
-            List ts -> Serialise.encode ts
-            Constr i entries -> Serialise.encode i <> Serialise.encode entries
-
-decodeData :: Decoder s Data
-decodeData = do
-    constr <- CBOR.decodeBool
-    if constr
-        then Constr <$> Serialise.decode <*> Serialise.decode
-        else do
-            tkty <- CBOR.peekTokenType
-            case tkty of
-                CBOR.TypeUInt -> I <$> Serialise.decode
-                CBOR.TypeUInt64 -> I <$> Serialise.decode
-                CBOR.TypeNInt   -> I <$> Serialise.decode
-                CBOR.TypeNInt64 -> I <$> Serialise.decode
-                CBOR.TypeInteger -> I <$> Serialise.decode
-                CBOR.TypeBytes -> B <$> Serialise.decode
-                CBOR.TypeMapLenIndef -> do
-                    CBOR.decodeMapLenIndef
-                    Map <$> decodeMapIndefLen []
-                CBOR.TypeMapLen -> Map <$> Serialise.decode
-                CBOR.TypeListLenIndef -> List <$> Serialise.decode
-                CBOR.TypeListLen -> List <$> Serialise.decode
-                _ -> fail "Invalid encoding"
-
--- from https://hackage.haskell.org/package/cborg-0.2.4.0/docs/src/Codec.CBOR.Term.html#decodeMapIndefLen
-decodeMapIndefLen :: [(Data, Data)] -> Decoder s [(Data, Data)]
-decodeMapIndefLen acc = do
-    stop <- CBOR.decodeBreakOr
-    if stop then return $ reverse acc
-            else do !tm  <- decodeData
-                    !tm' <- decodeData
-                    decodeMapIndefLen ((tm, tm') : acc)
-instance Serialise.Serialise Data where
-    encode = encodeData
-    decode = decodeData
diff --git a/plutus-use-cases/test/Spec/crowdfundingTestOutput.txt b/plutus-use-cases/test/Spec/crowdfundingTestOutput.txt
@@ -26,20 +26,20 @@ Events by wallet:
         ( 4
         , {utxo-at:
            Utxo at ScriptAddress: d0b2549a3cff9ef9e2b93b273a84ff7cb08a06eebe536f9ca3279825dde20e4f =
-             863ff6d648ff40831b64abae07e412e78212f6cf126ce5a9e53ce7f732d9f776!1: PayToScript: 2534f24dda0b8d91028eb868a5d3ecb8fedb87eac025285bbd3ee7fc2cc8d034 Value {getValue = Map {unMap = [(,Map {unMap = [(,10)]})]}}
-             a23339d22e3ed99ff81d1a34dbf70aa2a675d73b2a943bf97071a2b09093edd8!1: PayToScript: caa62e08af036de1828fa9d1e3e94d364050e5ab0a8f7b0e549ac49d365eb77b Value {getValue = Map {unMap = [(,Map {unMap = [(,1)]})]}}
-             ed6a603ff6dfaa734b9bb40f532133c1e319df7a729c31243a55a88650747233!1: PayToScript: 51bf71749f097890745bda290bec66c9ab1eb9a439fe1f90aca70fa3759d4a81 Value {getValue = Map {unMap = [(,Map {unMap = [(,10)]})]}}} )
+             b7fe813de2ef41d639abae64ab4e4b3a8717a339c20095891c80f7fd4bcb09ae!1: PayToScript: 4027db8b6fa1406b9af7a40cc636d7a0524b96690fb11ca690a27c903bd3d9ba Value {getValue = Map {unMap = [(,Map {unMap = [(,10)]})]}}
+             ccce46a66de4daa3ffab3ded947cf1618d8ad7c710dafda1b26484eff1f934b1!1: PayToScript: 4154c4f434653f72e126e72829bcda1d19ddc76bb4f7ed7695e38edf8a17d381 Value {getValue = Map {unMap = [(,Map {unMap = [(,10)]})]}}
+             e37d4cbe64e4d85512988e45f96a8266bacbd0b63c320abdbc424aca57f5b949!1: PayToScript: 1c26902e0eedb408b592e476fffb0815678ef869c7a2c2a17c81f089d0033a94 Value {getValue = Map {unMap = [(,Map {unMap = [(,1)]})]}}} )
     - Iteration: 4
     Requests:
         5: {tx:
             Tx:
-              Tx 6be862825034b3ebee5a694844165f7d139d8e9faca37ce9abe080e82c9c4ad1:
+              Tx 5fb9f19e7393983ca9726b08327ca8458b74d6cf1ca49bf692c82783a734a068:
                 {inputs:
-                   - 863ff6d648ff40831b64abae07e412e78212f6cf126ce5a9e53ce7f732d9f776!1
+                   - b7fe813de2ef41d639abae64ab4e4b3a8717a339c20095891c80f7fd4bcb09ae!1
                      Redeemer: <>
-                   - a23339d22e3ed99ff81d1a34dbf70aa2a675d73b2a943bf97071a2b09093edd8!1
+                   - ccce46a66de4daa3ffab3ded947cf1618d8ad7c710dafda1b26484eff1f934b1!1
                      Redeemer: <>
-                   - ed6a603ff6dfaa734b9bb40f532133c1e319df7a729c31243a55a88650747233!1
+                   - e37d4cbe64e4d85512988e45f96a8266bacbd0b63c320abdbc424aca57f5b949!1
                      Redeemer: <>
                 outputs:
                 forge: Value {getValue = Map {unMap = []}}
@@ -52,7 +52,7 @@ Events by wallet:
       Response:
         ( 5
         , {tx:
-           WriteTxSuccess: c84168c31b69a16f0d491f3d37e7eae9e4935092145ddedc43c3513e8961e131} )
+           WriteTxSuccess: 2992dad53bb5503526a378ba9d9ae497a3f3e5bcb141190351f4a2dd053f6cc0} )
   Events for W2:
     - Iteration: 1
     Requests:
@@ -78,7 +78,7 @@ Events by wallet:
     Requests:
         3: {tx:
             Tx:
-              Tx 86054630c7fbf6aebd898f524cde630a190f375ee183389062e86512ec0aa814:
+              Tx 9ecf80dcbee5aa647a0f0ddd1cedf8a1f3c97e209625430867e1f417962afd7d:
                 {inputs:
                 outputs:
                   - Value {getValue = Map {unMap = [(,Map {unMap = [(,10)]})]}} addressed to
@@ -94,7 +94,7 @@ Events by wallet:
       Response:
         ( 3
         , {tx:
-           WriteTxSuccess: ed6a603ff6dfaa734b9bb40f532133c1e319df7a729c31243a55a88650747233} )
+           WriteTxSuccess: b7fe813de2ef41d639abae64ab4e4b3a8717a339c20095891c80f7fd4bcb09ae} )
   Events for W3:
     - Iteration: 1
     Requests:
@@ -120,7 +120,7 @@ Events by wallet:
     Requests:
         3: {tx:
             Tx:
-              Tx b09ffd2cb55e8d1e59497ec3ce01246852d832cc6aeff69f4aab0103d5ef45c0:
+              Tx 69273142f3e8192c3f77285072efd23e7261ac819c7d0e3659a22b380a914dfc:
                 {inputs:
                 outputs:
                   - Value {getValue = Map {unMap = [(,Map {unMap = [(,10)]})]}} addressed to
@@ -136,7 +136,7 @@ Events by wallet:
       Response:
         ( 3
         , {tx:
-           WriteTxSuccess: 863ff6d648ff40831b64abae07e412e78212f6cf126ce5a9e53ce7f732d9f776} )
+           WriteTxSuccess: ccce46a66de4daa3ffab3ded947cf1618d8ad7c710dafda1b26484eff1f934b1} )
   Events for W4:
     - Iteration: 1
     Requests:
@@ -162,7 +162,7 @@ Events by wallet:
     Requests:
         3: {tx:
             Tx:
-              Tx cefd0c7ac75018af633e240758234ec5e62ebf47f03a7d4f95670daae5d1a249:
+              Tx c3f89dd395b9b6087d032842ad97b8658898cc054149066e179718fca0ef8c95:
                 {inputs:
                 outputs:
                   - Value {getValue = Map {unMap = [(,Map {unMap = [(,1)]})]}} addressed to
@@ -178,7 +178,7 @@ Events by wallet:
       Response:
         ( 3
         , {tx:
-           WriteTxSuccess: a23339d22e3ed99ff81d1a34dbf70aa2a675d73b2a943bf97071a2b09093edd8} )
+           WriteTxSuccess: e37d4cbe64e4d85512988e45f96a8266bacbd0b63c320abdbc424aca57f5b949} )
 Contract result by wallet:
     Wallet: W1
       Done

diff --git a/plutus-use-cases/test/Spec/renderCrowdfunding.txt b/plutus-use-cases/test/Spec/renderCrowdfunding.txt
@@ -101,11 +101,11 @@ Balances Carried Forward:
     Ada:      Lovelace:  10000
 
 ==== Slot #1, Tx #0 ====
-TxId:       ed6a603ff6dfaa734b9bb40f532133c1e319df7a729c31243a55a88650747233
+TxId:       b7fe813de2ef41d639abae64ab4e4b3a8717a339c20095891c80f7fd4bcb09ae
 Fee:        -
 Forge:      -
 Signatures  PubKey: fc51cd8e6218a1a38da47ed00230f0580816ed13...
-              Signature: 58407a8badbf2690167f0e074c983b7253e2e30b...
+              Signature: 58408b0b9032d9fe25b13baf216646e148e7b05a...
 Inputs:
   ---- Input 0 ----
   Destination:  PubKeyHash: 227dcb91dd714098bb921f237637d8480b485eb0... (Wallet 2)
@@ -175,11 +175,11 @@ Balances Carried Forward:
     Ada:      Lovelace:  10
 
 ==== Slot #2, Tx #0 ====
-TxId:       863ff6d648ff40831b64abae07e412e78212f6cf126ce5a9e53ce7f732d9f776
+TxId:       ccce46a66de4daa3ffab3ded947cf1618d8ad7c710dafda1b26484eff1f934b1
 Fee:        -
 Forge:      -
 Signatures  PubKey: 98a5e3a36e67aaba89888bf093de1ad963e77401...
-              Signature: 5840369537a601fe4edb979fa2a56c01cfb021e8...
+              Signature: 584058f5339976be12ea7576ed583089552f87f6...
 Inputs:
   ---- Input 0 ----
   Destination:  PubKeyHash: b2b258b1fa834d58fdb05316ca5ec0b753e62b55... (Wallet 3)
@@ -249,11 +249,11 @@ Balances Carried Forward:
     Ada:      Lovelace:  20
 
 ==== Slot #3, Tx #0 ====
-TxId:       a23339d22e3ed99ff81d1a34dbf70aa2a675d73b2a943bf97071a2b09093edd8
+TxId:       e37d4cbe64e4d85512988e45f96a8266bacbd0b63c320abdbc424aca57f5b949
 Fee:        -
 Forge:      -
 Signatures  PubKey: f81fb54a825fced95eb033afcd64314075abfb0a...
-              Signature: 5840baba32ca9070a7806871ca7c8f1466661914...
+              Signature: 58400f78eb874ed6d78d7588072e81aef401fdc6...
 Inputs:
   ---- Input 0 ----
   Destination:  PubKeyHash: d70d1fbd2ea532b07804a35bf63c019290a89731... (Wallet 4)
@@ -323,36 +323,36 @@ Balances Carried Forward:
     Ada:      Lovelace:  21
 
 ==== Slot #20, Tx #0 ====
-TxId:       c84168c31b69a16f0d491f3d37e7eae9e4935092145ddedc43c3513e8961e131
+TxId:       2992dad53bb5503526a378ba9d9ae497a3f3e5bcb141190351f4a2dd053f6cc0
 Fee:        -
 Forge:      -
 Signatures  PubKey: 3d4017c3e843895a92b70aa74d1b7ebc9c982ccf...
-              Signature: 584000323c052b87eedaaff092527ad2adc83b5b...
+              Signature: 5840b8187423488f9f81147bd26f010347542bea...
 Inputs:
   ---- Input 0 ----
   Destination:  Script: d0b2549a3cff9ef9e2b93b273a84ff7cb08a06eebe536f9ca3279825dde20e4f
   Value:
     Ada:      Lovelace:  10
   Source:
-    Tx:     863ff6d648ff40831b64abae07e412e78212f6cf126ce5a9e53ce7f732d9f776
+    Tx:     b7fe813de2ef41d639abae64ab4e4b3a8717a339c20095891c80f7fd4bcb09ae
     Output #1
     Script: 0100000303020003030305010200020002000303...
 
   ---- Input 1 ----
   Destination:  Script: d0b2549a3cff9ef9e2b93b273a84ff7cb08a06eebe536f9ca3279825dde20e4f
   Value:
-    Ada:      Lovelace:  1
+    Ada:      Lovelace:  10
   Source:
-    Tx:     a23339d22e3ed99ff81d1a34dbf70aa2a675d73b2a943bf97071a2b09093edd8
+    Tx:     ccce46a66de4daa3ffab3ded947cf1618d8ad7c710dafda1b26484eff1f934b1
     Output #1
     Script: 0100000303020003030305010200020002000303...
 
   ---- Input 2 ----
   Destination:  Script: d0b2549a3cff9ef9e2b93b273a84ff7cb08a06eebe536f9ca3279825dde20e4f
   Value:
-    Ada:      Lovelace:  10
+    Ada:      Lovelace:  1
   Source:
-    Tx:     ed6a603ff6dfaa734b9bb40f532133c1e319df7a729c31243a55a88650747233
+    Tx:     e37d4cbe64e4d85512988e45f96a8266bacbd0b63c320abdbc424aca57f5b949
     Output #1
     Script: 0100000303020003030305010200020002000303...
 

diff --git a/plutus-use-cases/test/Spec/renderGuess.txt b/plutus-use-cases/test/Spec/renderGuess.txt
@@ -101,11 +101,11 @@ Balances Carried Forward:
     Ada:      Lovelace:  10000
 
 ==== Slot #1, Tx #0 ====
-TxId:       002faa6641bebdb24a0e683107534d1f71ab2e8f720af7df9686ac434cfacf16
+TxId:       0e28d14c3f10c45d9089e18deaac0450d5be88898594d7a9a3a811f8562c7719
 Fee:        -
 Forge:      -
 Signatures  PubKey: 3d4017c3e843895a92b70aa74d1b7ebc9c982ccf...
-              Signature: 5840f0a422b8cf949a794a06794b15f12c4d8788...
+              Signature: 58407cf9b436944bba50d39bdc15a7bdb7974781...
 Inputs:
   ---- Input 0 ----
   Destination:  PubKeyHash: 4ecde0775d081e45f06141416cbc3afed4c44a08... (Wallet 1)
@@ -175,18 +175,18 @@ Balances Carried Forward:
     Ada:      Lovelace:  10
 
 ==== Slot #2, Tx #0 ====
-TxId:       ecd48d21a9b1631b19a79b65093da5d64a7e3e82ccfa808aaca2c3ceaf661b05
+TxId:       81140600334d4232e4486208ec2781ee67d6c9fbdc091d3226f01832ea6c7d5d
 Fee:        -
 Forge:      -
 Signatures  PubKey: fc51cd8e6218a1a38da47ed00230f0580816ed13...
-              Signature: 58406da9ceff421a829e6944f92f36e7c21b9d97...
+              Signature: 584001ca44e1557887e3e9008c06b6f28641cc8b...
 Inputs:
   ---- Input 0 ----
   Destination:  Script: c5925b540defe5b4db30d245e69c52f91369d4e4b35c838a1f1cb9c04bacb49a
   Value:
     Ada:      Lovelace:  10
   Source:
-    Tx:     002faa6641bebdb24a0e683107534d1f71ab2e8f720af7df9686ac434cfacf16
+    Tx:     0e28d14c3f10c45d9089e18deaac0450d5be88898594d7a9a3a811f8562c7719
     Output #1
     Script: 0100000303020003030501020002000303050102...
 

diff --git a/plutus-use-cases/test/Spec/renderVesting.txt b/plutus-use-cases/test/Spec/renderVesting.txt
@@ -101,11 +101,11 @@ Balances Carried Forward:
     Ada:      Lovelace:  10000
 
 ==== Slot #1, Tx #0 ====
-TxId:       73446549be8573292d217b2277d5dc0dfbb03541bd451be398433878f5ff5273
+TxId:       be73bfa581ac7daf26cba8c83d69b5d6cd171cd161d4bd1e29eb662ba07c8fac
 Fee:        -
 Forge:      -
 Signatures  PubKey: fc51cd8e6218a1a38da47ed00230f0580816ed13...
-              Signature: 58400b6b07b1f2a855cff60c6f0fa4ddfcf9e4f9...
+              Signature: 5840e274f1735a7efa448a65758657b8816f72cc...
 Inputs:
   ---- Input 0 ----
   Destination:  PubKeyHash: 227dcb91dd714098bb921f237637d8480b485eb0... (Wallet 2)
@@ -175,18 +175,18 @@ Balances Carried Forward:
     Ada:      Lovelace:  60
 
 ==== Slot #12, Tx #0 ====
-TxId:       d8500f2fb1b34c9d5e872e983df3cef51a846833c2907ca9749f76055798f718
+TxId:       666bfb316450b015980c6d2f68c4a16aa5bc90acafa54f4f00e1baf5c74f481e
 Fee:        -
 Forge:      -
 Signatures  PubKey: 3d4017c3e843895a92b70aa74d1b7ebc9c982ccf...
-              Signature: 5840fd72b6984b750980479cf8b6c0493ece6345...
+              Signature: 5840a333d9e01ce7c919659ff6f9f041a9b677e9...
 Inputs:
   ---- Input 0 ----
   Destination:  Script: 837a7b277972291274d3443c3cee9cb0aa06a5961bc4cfede476b01b16d76959
   Value:
     Ada:      Lovelace:  60
   Source:
-    Tx:     73446549be8573292d217b2277d5dc0dfbb03541bd451be398433878f5ff5273
+    Tx:     be73bfa581ac7daf26cba8c83d69b5d6cd171cd161d4bd1e29eb662ba07c8fac
     Output #1
     Script: 0100000303020003030305010200020002000302...