CBOR support to transaction build and transaction build-raw commands.

stuff Use serialiser from plutus instead Use serialiser from plutus instead
IntersectMBO · Jan 12, 2022 · fa61bb0 · fa61bb0
1 parent 1381119
commit fa61bb0
Show file tree

Hide file tree

Showing 5 changed files with 49 additions and 26 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -139,6 +139,7 @@ library
                       , plutus-ledger-api
                       , prettyprinter
                       , scientific
+                      , serialise
                       , small-steps
                       , cardano-ledger-shelley
                       , small-steps

diff --git a/cardano-api/src/Cardano/Api/ScriptData.hs b/cardano-api/src/Cardano/Api/ScriptData.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Cardano.Api.ScriptData (
@@ -72,18 +73,23 @@ import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Hash
 import           Cardano.Api.KeysShelley
 import           Cardano.Api.SerialiseJSON
+import           Cardano.Api.SerialiseCBOR
 import           Cardano.Api.SerialiseRaw
+import qualified Cardano.Binary as CBOR
+
 import           Cardano.Api.SerialiseUsing
 import           Cardano.Api.TxMetadata (pBytes, pSigned, parseAll)
-
+import           Codec.Serialise.Class (Serialise(..))
 
 -- ----------------------------------------------------------------------------
 -- Script data
 --
 
-data ScriptData = ScriptDataConstructor Integer [ScriptData]
-                | ScriptDataMap         [(ScriptData, ScriptData)]
-                | ScriptDataList        [ScriptData]
+data ScriptData = ScriptDataConstructor
+                                        Integer                     -- ^ Tag for the constructor
+                                        [ScriptData]                -- ^ Constructor arguments
+                | ScriptDataMap         [(ScriptData, ScriptData)]  -- ^ Key value pairs
+                | ScriptDataList        [ScriptData]                -- ^ Elements
                 | ScriptDataNumber      Integer
                 | ScriptDataBytes       BS.ByteString
   deriving (Eq, Ord, Show)
@@ -113,6 +119,16 @@ instance SerialiseAsRawBytes (Hash ScriptData) where
     deserialiseFromRawBytes (AsHash AsScriptData) bs =
       ScriptDataHash . Ledger.unsafeMakeSafeHash <$> Crypto.hashFromBytes bs
 
+instance SerialiseAsCBOR ScriptData where
+    serialiseToCBOR = CBOR.serialize'
+    deserialiseFromCBOR AsScriptData bs = CBOR.decodeFullDecoder "ScriptData" fromCBOR (LBS.fromStrict bs) :: Either CBOR.DecoderError ScriptData
+
+
+instance ToCBOR ScriptData where
+  toCBOR = encode @Plutus.Data . toPlutusData
+
+instance FromCBOR ScriptData where
+  fromCBOR = fromPlutusData <$> decode @Plutus.Data
 
 hashScriptData :: ScriptData -> Hash ScriptData
 hashScriptData = ScriptDataHash

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs b/cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs
@@ -283,18 +283,27 @@ pScriptWitnessFiles witctx autoBalanceExecUnits scriptFlagPrefix scriptFlagPrefi
 
 pScriptDataOrFile :: String -> String -> String -> Parser ScriptDataOrFile
 pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile =
-      ScriptDataFile  <$> pScriptDataFile
-  <|> ScriptDataValue <$> pScriptDataValue
+      pScriptDataCborFile
+  <|> pScriptDataFile
+  <|> pScriptDataValue
   where
-    pScriptDataFile =
+    pScriptDataCborFile = ScriptDataCborFile <$>
+      Opt.strOption
+        (  Opt.long (dataFlagPrefix ++ "-cbor-file")
+        <> Opt.metavar "CBOR FILE"
+        <> Opt.help (helpTextForFile ++ " The file must follow the special \
+                                         \JSON schema for script data.")
+        )
+
+    pScriptDataFile = ScriptDataJsonFile <$>
       Opt.strOption
         (  Opt.long (dataFlagPrefix ++ "-file")
-        <> Opt.metavar "FILE"
+        <> Opt.metavar "JSON FILE"
         <> Opt.help (helpTextForFile ++ " The file must follow the special \
                                          \JSON schema for script data.")
         )
 
-    pScriptDataValue =
+    pScriptDataValue = ScriptDataValue <$>
       Opt.option readerScriptData
         (  Opt.long (dataFlagPrefix ++ "-value")
         <> Opt.metavar "JSON VALUE"
@@ -309,7 +318,6 @@ pScriptDataOrFile dataFlagPrefix helpTextForValue helpTextForFile =
         Left err -> fail (displayError err)
         Right sd -> return sd
 
-
 pStakeAddressCmd :: Parser StakeAddressCmd
 pStakeAddressCmd =
     asum

diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Transaction.hs
@@ -939,20 +939,17 @@ readScriptRedeemerOrFile = readScriptDataOrFile
 readScriptDataOrFile :: ScriptDataOrFile
                      -> ExceptT ShelleyTxCmdError IO ScriptData
 readScriptDataOrFile (ScriptDataValue d) = return d
-readScriptDataOrFile (ScriptDataFile fp) = do
-    bs <- handleIOExceptT (ShelleyTxCmdReadFileError . FileIOError fp) $
-            LBS.readFile fp
-    v  <- firstExceptT (ShelleyTxCmdScriptDataJsonParseError fp) $
-            hoistEither $
-              Aeson.eitherDecode' bs
-    sd <- firstExceptT (ShelleyTxCmdScriptDataConversionError fp) $
-            hoistEither $
-              scriptDataFromJson ScriptDataJsonDetailedSchema v
-    firstExceptT (ShelleyTxCmdScriptDataValidationError fp) $
-      hoistEither $
-        validateScriptData sd
-    return sd
-
+readScriptDataOrFile (ScriptDataJsonFile fp) = do
+  bs <- handleIOExceptT (ShelleyTxCmdReadFileError . FileIOError fp) $ LBS.readFile fp
+  v  <- firstExceptT (ShelleyTxCmdScriptDataJsonParseError fp) $ hoistEither $ Aeson.eitherDecode' bs
+  sd <- firstExceptT (ShelleyTxCmdScriptDataConversionError fp) $ hoistEither $ scriptDataFromJson ScriptDataJsonDetailedSchema v
+  firstExceptT (ShelleyTxCmdScriptDataValidationError fp) $ hoistEither $ validateScriptData sd
+  return sd
+readScriptDataOrFile (ScriptDataCborFile fp) = do
+  bs <- handleIOExceptT (ShelleyTxCmdReadFileError . FileIOError fp) $ BS.readFile fp
+  sd <- firstExceptT (ShelleyTxCmdMetaDecodeError fp) $ hoistEither $ deserialiseFromCBOR AsScriptData bs
+  firstExceptT (ShelleyTxCmdScriptDataValidationError fp) $ hoistEither $ validateScriptData sd
+  return sd
 
 -- ----------------------------------------------------------------------------
 -- Transaction signing

diff --git a/cardano-cli/src/Cardano/CLI/Types.hs b/cardano-cli/src/Cardano/CLI/Types.hs
@@ -149,8 +149,9 @@ newtype VerificationKeyFile
 newtype ScriptFile = ScriptFile { unScriptFile :: FilePath }
                      deriving (Eq, Show)
 
-data ScriptDataOrFile = ScriptDataFile  FilePath   -- ^ By reference to a file
-                      | ScriptDataValue ScriptData -- ^ By value
+data ScriptDataOrFile = ScriptDataCborFile  FilePath   -- ^ By reference to a CBOR file
+                      | ScriptDataJsonFile  FilePath   -- ^ By reference to a JSON file
+                      | ScriptDataValue     ScriptData -- ^ By value
   deriving (Eq, Show)
 
 type ScriptRedeemerOrFile = ScriptDataOrFile