Merge pull request #3355 from input-output-hk/mpj/fix-script-serializ…

…ation

Fix the serialization format for scripts.

plutus-ledger-api/src/Plutus/V1/Ledger/Api.hs

@@ -5,7 +5,7 @@
 The interface to Plutus V1 for the ledger.
 -}
 module Plutus.V1.Ledger.Api (
-    Script
+    SerializedScript
     -- * Validating scripts
     , validateScript
     -- * Cost model
@@ -67,25 +67,25 @@ module Plutus.V1.Ledger.Api (
     , EvaluationError (..)
 ) where
 
+import qualified Codec.Serialise                                  as CBOR
 import           Control.Monad.Except
 import           Control.Monad.Writer
 import           Data.Bifunctor
+import           Data.ByteString.Lazy                             (fromStrict)
 import           Data.ByteString.Short
 import           Data.Either
 import           Data.Maybe                                       (isJust)
 import qualified Data.Text                                        as Text
 import           Data.Text.Prettyprint.Doc
 import           Data.Tuple
-import qualified Flat
 import           Plutus.V1.Ledger.Address
 import           Plutus.V1.Ledger.Bytes
 import           Plutus.V1.Ledger.Contexts
 import           Plutus.V1.Ledger.Credential
 import           Plutus.V1.Ledger.Crypto
 import           Plutus.V1.Ledger.DCert
 import           Plutus.V1.Ledger.Interval
-import           Plutus.V1.Ledger.Scripts                         hiding (Script)
-import qualified Plutus.V1.Ledger.Scripts                         as Scripts
+import           Plutus.V1.Ledger.Scripts
 import           Plutus.V1.Ledger.Slot
 import           PlutusCore                                       as PLC
 import qualified PlutusCore.DeBruijn                              as PLC
@@ -122,8 +122,8 @@ anything, we're just going to create new versions.
 
 -- | Check if a 'Script' is "valid". At the moment this just means "deserialises correctly", which in particular
 -- implies that it is (almost certainly) an encoded script and cannot be interpreted as some other kind of encoded data.
-validateScript :: Script -> Bool
-validateScript = isRight . Flat.unflat @Scripts.Script . fromShort
+validateScript :: SerializedScript -> Bool
+validateScript = isRight . CBOR.deserialiseOrFail @Script . fromStrict . fromShort
 
 validateCostModelParams :: CostModelParams -> Bool
 validateCostModelParams = isJust . applyCostModelParams PLC.defaultCekCostModel
@@ -134,13 +134,13 @@ data VerboseMode = Verbose | Quiet
 type LogOutput = [Text.Text]
 
 -- | Scripts to the ledger are serialised bytestrings.
-type Script = ShortByteString
+type SerializedScript = ShortByteString
 
 -- | Errors that can be thrown when evaluating a Plutus script.
 data EvaluationError =
     CekError (UPLC.CekEvaluationException PLC.DefaultUni PLC.DefaultFun) -- ^ An error from the evaluator itself
     | DeBruijnError PLC.FreeVariableError -- ^ An error in the pre-evaluation step of converting from de-Bruijn indices
-    | CodecError Flat.DecodeException -- ^ A serialisation error
+    | CodecError CBOR.DeserialiseFailure -- ^ A serialisation error
     | IncompatibleVersionError (PLC.Version ()) -- ^ An error indicating a version tag that we don't support
     -- TODO: make this error more informative when we have more information about what went wrong
     | CostModelParameterMismatch -- ^ An error indicating that the cost model parameters didn't match what we expected
@@ -153,10 +153,10 @@ instance Pretty EvaluationError where
     pretty (IncompatibleVersionError actual) = "This version of the Plutus Core interface does not support the version indicated by the AST:" <+> pretty actual
     pretty CostModelParameterMismatch = "Cost model parameters were not as we expected"
 
--- | Shared helper for the evaluation functions, deserializes the 'Script' , applies it to its arguments, and un-deBruijn-ifies it.
-mkTermToEvaluate :: (MonadError EvaluationError m) => Script -> [Data] -> m (UPLC.Term UPLC.Name PLC.DefaultUni PLC.DefaultFun ())
+-- | Shared helper for the evaluation functions, deserializes the 'SerializedScript' , applies it to its arguments, and un-deBruijn-ifies it.
+mkTermToEvaluate :: (MonadError EvaluationError m) => SerializedScript -> [Data] -> m (UPLC.Term UPLC.Name PLC.DefaultUni PLC.DefaultFun ())
 mkTermToEvaluate bs args = do
-    (Scripts.Script (UPLC.Program _ v t)) <- liftEither $ first CodecError $ Flat.unflat $ fromShort bs
+    (Script (UPLC.Program _ v t)) <- liftEither $ first CodecError $ CBOR.deserialiseOrFail $ fromStrict $ fromShort bs
     unless (v == PLC.defaultVersion ()) $ throwError $ IncompatibleVersionError v
     let namedTerm = UPLC.termMapNames PLC.fakeNameDeBruijn t
         -- This should go away when Data is a builtin
@@ -173,7 +173,7 @@ evaluateScriptRestricting
     :: VerboseMode     -- ^ Whether to produce log output
     -> CostModelParams -- ^ The cost model to use
     -> ExBudget        -- ^ The resource budget which must not be exceeded during evaluation
-    -> Script          -- ^ The script to evaluate
+    -> SerializedScript          -- ^ The script to evaluate
     -> [Data]          -- ^ The arguments to the script
     -> (LogOutput, Either EvaluationError ())
 evaluateScriptRestricting verbose cmdata budget p args = swap $ runWriter @LogOutput $ runExceptT $ do
@@ -197,7 +197,7 @@ evaluateScriptRestricting verbose cmdata budget p args = swap $ runWriter @LogOu
 evaluateScriptCounting
     :: VerboseMode     -- ^ Whether to produce log output
     -> CostModelParams -- ^ The cost model to use
-    -> Script          -- ^ The script to evaluate
+    -> SerializedScript          -- ^ The script to evaluate
     -> [Data]          -- ^ The arguments to the script
     -> (LogOutput, Either EvaluationError ExBudget)
 evaluateScriptCounting verbose cmdata p args = swap $ runWriter @LogOutput $ runExceptT $ do

plutus-ledger-api/src/Plutus/V1/Ledger/Examples.hs

@@ -4,8 +4,9 @@ This module contains example values to be used for testing. These should NOT be
 -}
 module Plutus.V1.Ledger.Examples where
 
+import           Codec.Serialise
+import           Data.ByteString.Lazy     (toStrict)
 import           Data.ByteString.Short
-import qualified Flat
 import           Numeric.Natural
 import           Plutus.V1.Ledger.Api
 import qualified Plutus.V1.Ledger.Scripts as Scripts
@@ -19,17 +20,17 @@ It seems better therefore to avoid depending on Plutus Tx in any "core" projects
 -}
 
 -- | Creates a script which has N arguments, and always succeeds.
-alwaysSucceedingNAryFunction :: Natural -> Script
-alwaysSucceedingNAryFunction n = toShort $ Flat.flat @Scripts.Script $ Scripts.Script $ UPLC.Program () (PLC.defaultVersion ()) (body n)
+alwaysSucceedingNAryFunction :: Natural -> SerializedScript
+alwaysSucceedingNAryFunction n = toShort $ toStrict $ serialise $ Scripts.Script $ UPLC.Program () (PLC.defaultVersion ()) (body n)
     where
         -- No more arguments! The body can be anything that doesn't fail, so we return `\x . x`
         body i | i == 0 = UPLC.LamAbs() (UPLC.DeBruijn 0) $ UPLC.Var () (UPLC.DeBruijn 1)
         -- We're using de Bruijn indices, so we can use the same binder each time!
         body i = UPLC.LamAbs () (UPLC.DeBruijn 0) $ body (i-1)
 
 -- | Creates a script which has N arguments, and always fails.
-alwaysFailingNAryFunction :: Natural -> Script
-alwaysFailingNAryFunction n = toShort $ Flat.flat @Scripts.Script $ Scripts.Script $ UPLC.Program () (PLC.defaultVersion ()) (body n)
+alwaysFailingNAryFunction :: Natural -> SerializedScript
+alwaysFailingNAryFunction n = toShort $ toStrict $ serialise $ Scripts.Script $ UPLC.Program () (PLC.defaultVersion ()) (body n)
     where
         -- No more arguments! The body should be error.
         body i | i == 0 = UPLC.Error ()

plutus-ledger-api/src/Plutus/V1/Ledger/Scripts.hs

@@ -68,7 +68,7 @@ import           Data.Hashable                    (Hashable)
 import           Data.String
 import           Data.Text.Prettyprint.Doc
 import           Data.Text.Prettyprint.Doc.Extras
-import           Flat                             (Flat, flat, unflat)
+import qualified Flat
 import           GHC.Generics                     (Generic)
 import           Plutus.V1.Ledger.Bytes           (LedgerBytes (..))
 import           Plutus.V1.Ledger.Orphans         ()
@@ -83,7 +83,6 @@ import qualified UntypedPlutusCore                as UPLC
 -- | A script on the chain. This is an opaque type as far as the chain is concerned.
 newtype Script = Script { unScript :: UPLC.Program UPLC.DeBruijn PLC.DefaultUni PLC.DefaultFun () }
   deriving stock Generic
-  deriving newtype (Flat)
 
 {-| Note [Using Flat inside CBOR instance of Script]
 `plutus-ledger` uses CBOR for data serialisation and `plutus-core` uses Flat. The
@@ -100,10 +99,10 @@ data structures that include scripts (for example, transactions) no-longer benef
 for CBOR's ability to self-describe it's format.
 -}
 instance Serialise Script where
-  encode = encode . flat . unScript
+  encode = encode . Flat.flat . unScript
   decode = do
     bs <- decodeBytes
-    case unflat bs of
+    case Flat.unflat bs of
       Left  err    -> Haskell.fail (Haskell.show err)
       Right script -> return $ Script script