Merge #3318

3318: Implement certifying and withdrawing Plutus script tests r=Jimbo4350 a=Jimbo4350



Co-authored-by: Jordan Millar <jordan.millar@iohk.io>

bench/tx-generator/src/Cardano/Benchmarking/Script/Aeson.hs

@@ -1,35 +1,35 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 module Cardano.Benchmarking.Script.Aeson
 where
 
-import           Prelude
-import           System.Exit
-import           Data.Functor.Identity
-import           Data.Text (Text)
-import qualified Data.Text as Text
-import           Data.Dependent.Sum
-import qualified Data.HashMap.Strict as HashMap (toList, lookup)
-import qualified Data.ByteString.Lazy as BSL
-import qualified Data.ByteString as BS
-import qualified Data.ByteString.Char8 as BS (lines)
 import           Data.Aeson
-import           Data.Aeson.Types
 import           Data.Aeson.Encode.Pretty
+import           Data.Aeson.Types
 import qualified Data.Attoparsec.ByteString as Atto
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS (lines)
+import qualified Data.ByteString.Lazy as BSL
+import           Data.Dependent.Sum
+import           Data.Functor.Identity
+import qualified Data.HashMap.Strict as HashMap (lookup, toList)
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import           Prelude
+import           System.Exit
 
-import           Cardano.Api (AnyCardanoEra(..), CardanoEra(..), ScriptData, ScriptDataJsonSchema(..), scriptDataFromJson, scriptDataToJson)
-import           Cardano.CLI.Types (SigningKeyFile(..))
+import           Cardano.Api (ScriptData, ScriptDataJsonSchema (..), scriptDataFromJson,
+                   scriptDataToJson)
+import           Cardano.CLI.Types (SigningKeyFile (..))
 
 import           Cardano.Benchmarking.Script.Env
 import           Cardano.Benchmarking.Script.Setters
 import           Cardano.Benchmarking.Script.Store
 import           Cardano.Benchmarking.Script.Types
-import           Cardano.Benchmarking.Types (NumberOfTxs(..), TPSRate(..))
+import           Cardano.Benchmarking.Types (NumberOfTxs (..), TPSRate (..))
 
 testJSONRoundTrip :: [Action] -> Maybe String
 testJSONRoundTrip l = case fromJSON $ toJSON l of
@@ -47,15 +47,6 @@ prettyPrint = encodePretty' conf
     , "runBenchmark", "asyncBenchmark", "waitBenchmark", "cancelBenchmark"
     , "reserved" ]
 
-instance FromJSON AnyCardanoEra where
-  parseJSON = withText "AnyCardanoEra" $ \case
-    "Byron"   -> return $ AnyCardanoEra ByronEra
-    "Shelley" -> return $ AnyCardanoEra ShelleyEra
-    "Allegra" -> return $ AnyCardanoEra AllegraEra
-    "Mary"    -> return $ AnyCardanoEra MaryEra
-    "Alonzo"    -> return $ AnyCardanoEra AlonzoEra
-    era -> parseFail ("Error: Cannot parse JSON value '" <> Text.unpack era <> "' to AnyCardanoEra.")
-
 jsonOptionsUnTaggedSum :: Options
 jsonOptionsUnTaggedSum = defaultOptions { sumEncoding = ObjectWithSingleField }
 
@@ -111,7 +102,7 @@ actionToJSON a = case a of
   Delay t -> object ["delay" .= t ]
   PrepareTxList (TxListName name) (KeyName key) (FundListName fund)
     -> object ["prepareTxList" .= name, "newKey" .= key, "fundList" .= fund ]
-  AsyncBenchmark (ThreadName t) (TxListName txs) (TPSRate tps) 
+  AsyncBenchmark (ThreadName t) (TxListName txs) (TPSRate tps)
     -> object ["asyncBenchmark" .= t, "txList" .= txs, "tps" .= tps]
   ImportGenesisFund submitMode (KeyName genesisKey) (KeyName fundKey)
     -> object ["importGenesisFund" .= genesisKey, "submitMode" .= submitMode, "fundKey" .= fundKey ]
@@ -203,7 +194,7 @@ objectToAction obj = case obj of
   parseAsyncBenchmark v = AsyncBenchmark
     <$> ( ThreadName <$> parseJSON v )
     <*> ( TxListName <$> parseField obj "txList" )
-    <*> ( TPSRate <$> parseField obj "tps" )   
+    <*> ( TPSRate <$> parseField obj "tps" )
 
   parseRunBenchmark v = RunBenchmark
     <$> parseField obj "submitMode"

cardano-api/gen/Gen/Cardano/Api/Typed.hs

@@ -39,6 +39,7 @@ module Gen.Cardano.Api.Typed
   , genStakeAddress
   , genTx
   , genTxBody
+  , genLovelace
   , genValue
   , genValueDefault
   , genVerificationKey

cardano-api/src/Cardano/Api/Address.hs

@@ -507,6 +507,15 @@ instance SerialiseAddress StakeAddress where
       either (const Nothing) Just $
       deserialiseFromBech32 AsStakeAddress t
 
+instance ToJSON StakeAddress where
+  toJSON s = Aeson.String $ serialiseAddress s
+
+instance FromJSON StakeAddress where
+  parseJSON = withText "StakeAddress" $ \str ->
+    case deserialiseAddress AsStakeAddress str of
+      Nothing ->
+        fail $ "Error while deserialising StakeAddress: " <> Text.unpack str
+      Just sAddr -> pure sAddr
 
 makeStakeAddress :: NetworkId
                  -> StakeCredential

cardano-api/src/Cardano/Api/Block.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
@@ -46,7 +47,7 @@ module Cardano.Api.Block (
 
 import           Prelude
 
-import           Data.Aeson (ToJSON (..), object, (.=))
+import           Data.Aeson (FromJSON (..), ToJSON (..), object, (.=))
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Short as SBS
@@ -69,15 +70,16 @@ import qualified Ouroboros.Network.Block as Consensus
 
 import qualified Cardano.Chain.Block as Byron
 import qualified Cardano.Chain.UTxO as Byron
+import qualified Cardano.Ledger.Block as Ledger
 import qualified Cardano.Ledger.Era as Ledger
 import qualified Cardano.Protocol.TPraos.BHeader as TPraos
-import qualified Cardano.Ledger.Block as Ledger
 
 import           Cardano.Api.Eras
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Hash
 import           Cardano.Api.Modes
 import           Cardano.Api.SerialiseRaw
+import           Cardano.Api.SerialiseUsing
 import           Cardano.Api.Tx
 
 {- HLINT ignore "Use lambda" -}
@@ -237,6 +239,9 @@ data BlockHeader = BlockHeader !SlotNo
 -- representation.
 newtype instance Hash BlockHeader = HeaderHash SBS.ShortByteString
   deriving (Eq, Ord, Show)
+  deriving (ToJSON, FromJSON) via UsingRawBytesHex (Hash BlockHeader)
+
+
 
 instance SerialiseAsRawBytes (Hash BlockHeader) where
     serialiseToRawBytes (HeaderHash bs) = SBS.fromShort bs

cardano-api/src/Cardano/Api/Eras.hs

@@ -46,7 +46,8 @@ module Cardano.Api.Eras
 
 import           Prelude
 
-import           Data.Aeson (ToJSON, toJSON)
+import           Data.Aeson (FromJSON (..), ToJSON, toJSON, withText)
+import qualified Data.Text as Text
 import           Data.Type.Equality (TestEquality (..), (:~:) (Refl))
 
 import           Ouroboros.Consensus.Shelley.Eras as Ledger (StandardAllegra, StandardAlonzo,
@@ -229,6 +230,17 @@ instance Enum AnyCardanoEra where
 instance ToJSON AnyCardanoEra where
    toJSON (AnyCardanoEra era) = toJSON era
 
+instance FromJSON AnyCardanoEra where
+   parseJSON = withText "AnyCardanoEra"
+     $ \case
+        "Byron" -> pure $ AnyCardanoEra ByronEra
+        "Shelley" -> pure $ AnyCardanoEra ShelleyEra
+        "Allegra" -> pure $ AnyCardanoEra AllegraEra
+        "Mary" -> pure $ AnyCardanoEra MaryEra
+        "Alonzo" -> pure $ AnyCardanoEra AlonzoEra
+        wrong -> fail $ "Failed to parse unknown era: " <> Text.unpack wrong
+
+
 -- | Like the 'AnyCardanoEra' constructor but does not demand a 'IsCardanoEra'
 -- class constraint.
 --

cardano-api/src/Cardano/Api/KeysShelley.hs

@@ -37,11 +37,12 @@ module Cardano.Api.KeysShelley (
 
 import           Prelude
 
-import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText)
+import           Data.Aeson.Types (ToJSONKey (..), toJSONKeyText, withText)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import           Data.Maybe
 import           Data.String (IsString (..))
+import qualified Data.Text as Text
 
 import qualified Cardano.Crypto.DSIGN.Class as Crypto
 import qualified Cardano.Crypto.Hash.Class as Crypto
@@ -52,6 +53,7 @@ import qualified Cardano.Ledger.Keys as Shelley
 
 import           Cardano.Ledger.Crypto (StandardCrypto)
 
+import           Cardano.Api.Error
 import           Cardano.Api.Hash
 import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Key
@@ -62,7 +64,6 @@ import           Cardano.Api.SerialiseRaw
 import           Cardano.Api.SerialiseTextEnvelope
 import           Cardano.Api.SerialiseUsing
 
-
 --
 -- Shelley payment keys
 --
@@ -1205,6 +1206,14 @@ instance ToJSON (Hash StakePoolKey) where
 instance ToJSONKey (Hash StakePoolKey) where
   toJSONKey = toJSONKeyText serialiseToBech32
 
+instance FromJSON (Hash StakePoolKey) where
+  parseJSON = withText "PoolId" $ \str ->
+    case deserialiseFromBech32 (AsHash AsStakePoolKey) str of
+      Left err ->
+        fail $ "Error deserialising Hash StakePoolKey: " <> Text.unpack str <>
+               " Error: " <> displayError err
+      Right h -> pure h
+
 instance HasTextEnvelope (VerificationKey StakePoolKey) where
     textEnvelopeType _ = "StakePoolVerificationKey_"
                       <> fromString (Crypto.algorithmNameDSIGN proxy)

cardano-cli/cardano-cli.cabal

@@ -176,6 +176,7 @@ test-suite cardano-cli-test
                       , cardano-node
                       , cardano-prelude
                       , cardano-slotting
+                      , containers
                       , directory
                       , exceptions
                       , filepath
@@ -189,6 +190,7 @@ test-suite cardano-cli-test
   other-modules:        Test.Config.Mainnet
                         Test.Cli.FilePermissions
                         Test.Cli.ITN
+                        Test.Cli.JSON
                         Test.Cli.MultiAssetParsing
                         Test.Cli.Pioneers.Exercise1
                         Test.Cli.Pioneers.Exercise2

cardano-cli/src/Cardano/CLI/Shelley/Commands.hs

@@ -39,7 +39,6 @@ module Cardano.CLI.Shelley.Commands
   , VerificationKeyBase64 (..)
   , GenesisKeyFile (..)
   , MetadataFile (..)
-  , PoolId (..)
   , PoolMetadataFile (..)
   , PrivKeyFile (..)
   , BlockId (..)
@@ -50,7 +49,7 @@ module Cardano.CLI.Shelley.Commands
 import           Data.Text (Text)
 import           Prelude
 
-import           Cardano.Api.Shelley hiding (PoolId)
+import           Cardano.Api.Shelley
 
 import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
 
@@ -467,10 +466,6 @@ newtype OutputFile
   = OutputFile FilePath
   deriving Show
 
-newtype PoolId
-  = PoolId String -- Probably not a String
-  deriving Show
-
 newtype PoolMetadataFile = PoolMetadataFile
   { unPoolMetadataFile :: FilePath }
   deriving Show

cardano-cli/src/Cardano/CLI/Shelley/Orphans.hs

@@ -38,9 +38,9 @@ import qualified Cardano.Ledger.Credential as Ledger
 import qualified Cardano.Ledger.Shelley.API.Protocol as Ledger
 import qualified Cardano.Ledger.Shelley.EpochBoundary as Ledger
 import qualified Cardano.Ledger.Shelley.Rewards as Ledger
+import           Cardano.Ledger.TxIn (TxId (..))
 import qualified Cardano.Protocol.TPraos.Rules.Prtcl as Ledger
 import qualified Cardano.Protocol.TPraos.Rules.Tickn as Ledger
-import           Cardano.Ledger.TxIn (TxId (..))
 
 import qualified Cardano.Ledger.Mary.Value as Ledger.Mary
 
@@ -64,8 +64,8 @@ instance ToJSON (HeaderHash blk) => ToJSON (Tip blk) where
       , "blockNo"    .= blockNo
       ]
 
--- This instance is temporarily duplicated in cardano-config
 deriving newtype instance ToJSON BlockNo
+deriving newtype instance FromJSON BlockNo
 
 --
 -- Simple newtype wrappers JSON conversion

cardano-cli/src/Cardano/CLI/Shelley/Output.hs

@@ -7,17 +7,15 @@ module Cardano.CLI.Shelley.Output
   ) where
 
 import           Cardano.Api
+import           Prelude
+
+import           Data.Aeson (FromJSON (..), KeyValue, ToJSON (..), object, pairs, withObject, (.:?),
+                   (.=))
+import           Data.Text (Text)
 
 import           Cardano.CLI.Shelley.Orphans ()
-import           Cardano.Prelude (Text)
-import           Cardano.Slotting.Time (SystemStart (..))
-import           Data.Aeson (KeyValue, ToJSON (..), (.=))
-import           Data.Function (id, ($), (.))
-import           Data.Maybe ( Maybe(..) )
-import           Data.Monoid (mconcat)
 import           Cardano.Ledger.Shelley.Scripts ()
-
-import qualified Data.Aeson as J
+import           Cardano.Slotting.Time (SystemStart (..))
 
 data QueryTipLocalState mode = QueryTipLocalState
   { era :: AnyCardanoEra
@@ -31,7 +29,7 @@ data QueryTipLocalStateOutput = QueryTipLocalStateOutput
   , mEra :: Maybe AnyCardanoEra
   , mEpoch :: Maybe EpochNo
   , mSyncProgress :: Maybe Text
-  }
+  } deriving Show
 
 -- | A key-value pair difference list for encoding a JSON object.
 (..=) :: (KeyValue kv, ToJSON v) => Text -> v -> [kv] -> [kv]
@@ -46,13 +44,13 @@ data QueryTipLocalStateOutput = QueryTipLocalStateOutput
 instance ToJSON QueryTipLocalStateOutput where
   toJSON a = case localStateChainTip a of
     ChainTipAtGenesis ->
-      J.object $
+      object $
         ( ("era" ..=? mEra a)
         . ("epoch" ..=? mEpoch a)
         . ("syncProgress" ..=? mSyncProgress a)
         ) []
     ChainTip slotNo blockHeader blockNo ->
-      J.object $
+      object $
         ( ("slot" ..= slotNo)
         . ("hash" ..= serialiseToRawBytesHexText blockHeader)
         . ("block" ..= blockNo)
@@ -62,17 +60,45 @@ instance ToJSON QueryTipLocalStateOutput where
         ) []
   toEncoding a = case localStateChainTip a of
     ChainTipAtGenesis ->
-      J.pairs $ mconcat $
+      pairs $ mconcat $
         ( ("era" ..=? mEra a)
         . ("epoch" ..=? mEpoch a)
         . ("syncProgress" ..=? mSyncProgress a)
         ) []
     ChainTip slotNo blockHeader blockNo ->
-      J.pairs $ mconcat $
+      pairs $ mconcat $
         ( ("slot" ..= slotNo)
         . ("hash" ..= serialiseToRawBytesHexText blockHeader)
         . ("block" ..= blockNo)
         . ("era" ..=? mEra a)
         . ("epoch" ..=? mEpoch a)
         . ("syncProgress" ..=? mSyncProgress a)
         ) []
+
+instance FromJSON QueryTipLocalStateOutput where
+  parseJSON = withObject "QueryTipLocalStateOutput" $ \o -> do
+    mEra' <- o .:? "era"
+    mEpoch' <- o .:? "epoch"
+    mSyncProgress' <- o .:? "syncProgress"
+
+    mSlot <- o .:? "slot"
+    mHash <- o .:? "hash"
+    mBlock <- o .:? "block"
+    case (mSlot, mHash, mBlock) of
+      (Nothing, Nothing, Nothing) ->
+        pure $ QueryTipLocalStateOutput
+                 ChainTipAtGenesis
+                 mEra'
+                 mEpoch'
+                 mSyncProgress'
+      (Just slot, Just hash, Just block) ->
+        pure $ QueryTipLocalStateOutput
+                 (ChainTip slot hash block)
+                 mEra'
+                 mEpoch'
+                 mSyncProgress'
+      (_,_,_) -> fail "QueryTipLocalStateOutput was incorrectly JSON encoded.\
+                      \ Expected slot, header hash and block number (ChainTip)\
+                      \ or none (ChainTipAtGenesis)"
+
+