Indigo/update plutus apps

flake.nix

@@ -11,21 +11,21 @@
     haskell-nix-extra-hackage.inputs.haskell-nix.follows = "haskell-nix";
     haskell-nix-extra-hackage.inputs.nixpkgs.follows = "nixpkgs";
 
-    cardano-base.url = "github:input-output-hk/cardano-base/631cb6cf1fa01ab346233b610a38b3b4cba6e6ab";
+    cardano-base.url = "github:input-output-hk/cardano-base/0f3a867493059e650cda69e20a5cbf1ace289a57";
     cardano-base.flake = false;
     cardano-crypto.url = "github:input-output-hk/cardano-crypto/f73079303f663e028288f9f4a9e08bcca39a923e";
     cardano-crypto.flake = false;
-    cardano-ledger.url = "github:input-output-hk/cardano-ledger/389b266d6226dedf3d2aec7af640b3ca4984c5ea";
+    cardano-ledger.url = "github:input-output-hk/cardano-ledger/3be8a19083fc13d9261b1640e27dd389b51bb08e";
     cardano-ledger.flake = false;
-    cardano-prelude.url = "github:input-output-hk/cardano-prelude/533aec85c1ca05c7d171da44b89341fb736ecfe5";
+    cardano-prelude.url = "github:input-output-hk/cardano-prelude/bb4ed71ba8e587f672d06edf9d2e376f4b055555";
     cardano-prelude.flake = false;
     flat.url = "github:Quid2/flat/ee59880f47ab835dbd73bea0847dab7869fc20d8";
     flat.flake = false;
     goblins.url = "github:input-output-hk/goblins/cde90a2b27f79187ca8310b6549331e59595e7ba";
     goblins.flake = false;
     weigh.url = "github:fpco/weigh/bfcf4415144d7d2817dfcb91b6f9a6dfd7236de7";
     weigh.flake = false;
-    plutus.url = "github:input-output-hk/plutus/8ab4c3355c5fdf67dcf6acc1f5a14668d5e6f0a9";
+    plutus.url = "github:input-output-hk/plutus/69ab98c384703172f898eb5bcad1078ded521426";
     plutus.flake = false;
     Win32-network.url = "github:input-output-hk/Win32-network/3825d3abf75f83f406c1f7161883c438dac7277d";
     Win32-network.flake = false;

src/Plutus/Model/Contract.hs

@@ -48,14 +48,17 @@ module Plutus.Model.Contract (
   payToKey,
   payToKeyDatum,
   payToScript,
+  payToScriptUntyped,
   loadRefScript,
   loadRefScriptDatum,
   payToRef,
   payFee,
   userSpend,
   spendPubKey,
   spendScript,
+  spendScriptUntyped,
   spendScriptRef,
+  spendScriptRefUntyped,
   spendBox,
   refInputInline,
   refInputHash,
@@ -336,10 +339,10 @@ fromDatumMode = \case
 -- build Tx
 
 -- | Pay to public key with datum
-payToKeyDatum :: ToData a => PubKeyHash -> DatumMode a -> Value -> Tx
+payToKeyDatum :: (ToData a, HasAddress pubKeyHash) => pubKeyHash -> DatumMode a -> Value -> Tx
 payToKeyDatum pkh dat val = toExtra $
   mempty
-    { P.txOutputs = [TxOut (pubKeyHashAddress pkh) val outDatum Nothing]
+    { P.txOutputs = [TxOut (toAddress pkh) val outDatum Nothing]
     , P.txData = datumMap
     }
   where
@@ -365,6 +368,21 @@ payToScript script dat val = toExtra $
   where
     (outDatum, datumMap) = fromDatumMode dat
 
+-- | Pay to the script untyped.
+-- The a type parameter represents the contents of the datum.
+-- Example for datum: `()` and not `Datum $ toBuiltinDatum ()`.
+payToScriptUntyped :: (ToData a, HasAddress script) =>
+  script -> DatumMode a -> Value -> Tx
+payToScriptUntyped script dat val = toExtra $
+  mempty
+    { P.txOutputs = [TxOut (toAddress script) val outDatum Nothing]
+    , P.txData = datumMap
+    }
+  where
+    (outDatum, datumMap) = fromDatumMode dat
+
+
+
 -- | Uploads the reference script to blockchain
 loadRefScript :: (IsValidator script) => script -> Value -> Tx
 loadRefScript script val = loadRefScriptBy script Nothing val
@@ -426,6 +444,21 @@ spendScript tv ref red dat = toExtra $
     { P.txInputs = S.singleton $ Fork.TxIn ref (Just $ Fork.ConsumeScriptAddress (Just $ Versioned (getLanguage tv) (toValidator tv)) (toRedeemer red) (toDatum dat))
     }
 
+-- | Spend script input untyped.
+spendScriptUntyped ::
+  (HasValidator script, HasLanguage script) =>
+  script ->
+  TxOutRef ->
+  Redeemer ->
+  Datum ->
+  Tx
+spendScriptUntyped script ref red dat = toExtra $
+  mempty
+    { P.txInputs = S.singleton $ Fork.TxIn ref (Just $ Fork.ConsumeScriptAddress (Just validator) red dat)
+    }
+  where
+    validator = Versioned (getLanguage script) ( toValidator script)
+
 -- | Spends script that references other script
 spendScriptRef ::
   (IsValidator script) =>
@@ -445,6 +478,25 @@ spendScriptRef refScript script refOut red dat = toExtra $
     sh = scriptHash script
     validator = toVersionedScript script
 
+-- | Spends script that references other script untyped version
+spendScriptRefUntyped :: 
+  (HasValidator script, HasLanguage script) =>
+  TxOutRef -> 
+  script ->
+  TxOutRef -> 
+  Redeemer -> 
+  Datum -> 
+  Tx
+spendScriptRefUntyped refScript script refOut red dat = toExtra $
+  mempty
+    { P.txInputs = S.singleton $ Fork.TxIn refOut (Just $ Fork.ConsumeScriptAddress Nothing red dat)
+    , P.txReferenceInputs = S.singleton $ Fork.TxIn refScript Nothing
+    , P.txScripts = M.singleton sh validator
+    }
+  where
+    sh = scriptHash script
+    validator = Versioned (getLanguage script) (getValidator $ toValidator script)
+
 -- | Reference input with inlined datum
 refInputInline :: TxOutRef -> Tx
 refInputInline ref = toExtra $
@@ -564,25 +616,25 @@ txBoxValue :: TxBox a -> Value
 txBoxValue = txOutValue . txBoxOut
 
 -- | Read UTXOs with datums.
-boxAt :: (IsValidator script) => script -> Run [TxBox script]
+boxAt :: (HasAddress script, HasDatum script) => script -> Run [TxBox script]
 boxAt addr = do
   utxos <- utxoAt (toAddress addr)
   fmap catMaybes $ mapM (\(ref, tout) -> fmap (\dat -> TxBox ref tout dat) <$> datumAt ref) utxos
 
 -- | It expects that Typed validator can have only one UTXO
 -- which is NFT.
-nftAt :: IsValidator script => script -> Run (TxBox script)
+nftAt :: (HasAddress script, HasDatum script) => script -> Run (TxBox script)
 nftAt tv = head <$> boxAt tv
 
 -- | Safe query for single Box
-withBox :: IsValidator script => (TxBox script -> Bool) -> script -> (TxBox script -> Run ()) -> Run ()
+withBox :: (HasAddress script, HasDatum script) => (TxBox script -> Bool) -> script -> (TxBox script -> Run ()) -> Run ()
 withBox isBox script cont =
   withMayBy readMsg (L.find isBox <$> boxAt script) cont
   where
     readMsg = ("No UTxO box for: " <> ) <$> getPrettyAddress (toAddress script)
 
 -- | Reads single box from the list. we expect NFT to be a single UTXO for a given script.
-withNft :: IsValidator script => script -> (TxBox script -> Run ()) -> Run ()
+withNft :: (HasAddress script, HasDatum script) => script -> (TxBox script -> Run ()) -> Run ()
 withNft = withBox (const True)
 
 ----------------------------------------------------------------------
@@ -718,10 +770,11 @@ checkBalanceBy :: (a -> BalanceDiff) -> Run a -> Run a
 checkBalanceBy getDiffs act = do
   beforeSt <- get
   res <- act
+  afterSt <- get
   let BalanceDiff diffs = getDiffs res
       addrs = M.keys diffs
       before =  fmap (`valueAtState` beforeSt) addrs
-  after <- mapM valueAt addrs
+      after = fmap (`valueAtState` afterSt) addrs
   mapM_ (logError . show . vcat <=< mapM ppError) (check addrs diffs before after)
   pure res
   where

src/Plutus/Model/Fork/Cardano/Common.hs

@@ -65,7 +65,7 @@ import Cardano.Ledger.Shelley.API.Types qualified as Shelley (Hash)
 import Cardano.Ledger.TxIn qualified as C
 import Cardano.Ledger.ShelleyMA.Timelocks qualified as C
 import Cardano.Ledger.Keys qualified as C
-import Cardano.Ledger.Keys.WitVKey
+import Cardano.Ledger.Shelley.TxBody (Delegation (Delegation), WitVKey)
 import Cardano.Ledger.Shelley.UTxO qualified as C
 import qualified Cardano.Crypto.Hash.Class as Crypto
 import Cardano.Ledger.Mary.Value qualified as C
@@ -170,7 +170,7 @@ toDCert :: Network -> C.Coin -> C.Coin -> P.DCert -> Either ToCardanoError (C.DC
 toDCert network poolDeposit minPoolCost = \case
   P.DCertDelegRegKey (P.StakingHash stakingCredential) -> C.DCertDeleg . C.RegKey <$> toCredential stakingCredential
   P.DCertDelegDeRegKey (P.StakingHash stakingCredential) -> C.DCertDeleg . C.DeRegKey <$> toCredential stakingCredential
-  P.DCertDelegDelegate (P.StakingHash stakingCredential) pubKeyHash -> C.DCertDeleg . C.Delegate <$> (C.Delegation <$> toCredential stakingCredential <*> toPubKeyHash pubKeyHash)
+  P.DCertDelegDelegate (P.StakingHash stakingCredential) pubKeyHash -> C.DCertDeleg . C.Delegate <$> (Delegation <$> toCredential stakingCredential <*> toPubKeyHash pubKeyHash)
   P.DCertPoolRegister poolKeyHash poolVfr -> C.DCertPool . C.RegPool <$> toPoolParams poolKeyHash poolVfr
   P.DCertPoolRetire pkh n -> C.DCertPool . (\key -> C.RetirePool key (C.EpochNo (fromIntegral n)) ) <$> toPubKeyHash pkh
   P.DCertGenesis -> Left "DCertGenesis is not supported"

src/Plutus/Model/Validator.hs

@@ -12,6 +12,8 @@ module Plutus.Model.Validator(
   IsValidatorHash,
 
   TypedValidator(..),
+  UntypedValidator(..),
+  UntypedValidatorHash(..),
   TypedValidatorHash(..),
   TypedPolicy(..),
   TypedStake(..),
@@ -99,6 +101,32 @@ instance HasValidator (TypedValidator datum redeemer) where
 instance HasAddress (TypedValidator datum redeemer) where
   toAddress = toAddress . toValidatorHash
 
+---------------------------------------------------------------------
+-- untyped validator
+
+newtype UntypedValidator = 
+  UntypedValidator { unUntypedValidator :: Versioned Validator }
+  deriving newtype (HasLanguage)
+
+instance HasValidator UntypedValidator where
+  toValidator (UntypedValidator (Versioned _lang validator)) = validator
+
+instance HasAddress UntypedValidator where
+  toAddress = toAddress . toValidatorHash
+
+---------------------------------------------------------------------
+-- untyped validator hash
+
+newtype UntypedValidatorHash = 
+  UntypedValidatorHash { unTypedValidatorHash :: Versioned ValidatorHash }
+  deriving newtype (HasLanguage)
+
+instance HasValidatorHash UntypedValidatorHash where
+  toValidatorHash (UntypedValidatorHash (Versioned _lang vh)) = vh
+
+instance HasAddress UntypedValidatorHash where
+  toAddress (UntypedValidatorHash (Versioned _lang vh)) = toAddress vh
+
 ---------------------------------------------------------------------
 -- typed validator hash
 

src/Plutus/Model/Validator/V2.hs

@@ -1,7 +1,10 @@
 -- | Creation of typed validators for Plutus V2
 module Plutus.Model.Validator.V2(
   mkTypedValidator,
+  mkTypedValidator',
+  mkUntypedValidator,
   mkTypedPolicy,
+  mkTypedPolicy',
   mkTypedStake,
   toBuiltinValidator,
   toBuiltinPolicy,
@@ -13,13 +16,23 @@ import PlutusTx.Prelude qualified as Plutus
 import Plutus.V2.Ledger.Api
 import PlutusTx.Code (CompiledCode)
 
-import Plutus.Model.Validator (TypedValidator(..), TypedPolicy(..), TypedStake(..))
+import Plutus.Model.Validator (TypedValidator(..), TypedPolicy(..), TypedStake(..), UntypedValidator (UntypedValidator))
 import Plutus.Model.Fork.Ledger.Scripts (toV2)
 
+mkTypedValidator' :: Validator -> TypedValidator datum redeemer
+mkTypedValidator' = TypedValidator . toV2
+
 -- | Create Plutus V2 typed validator
 mkTypedValidator :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> TypedValidator datum redeemer
 mkTypedValidator = TypedValidator . toV2 . mkValidatorScript
 
+-- | Create Plutus V2 untyped validator
+mkUntypedValidator :: CompiledCode (BuiltinData -> BuiltinData -> BuiltinData -> ()) -> UntypedValidator
+mkUntypedValidator = UntypedValidator . toV2 . mkValidatorScript
+
+mkTypedPolicy' :: MintingPolicy -> TypedPolicy redeemer
+mkTypedPolicy' = TypedPolicy . toV2
+
 -- | Create Plutus V2 typed minting policy
 mkTypedPolicy :: CompiledCode (BuiltinData -> BuiltinData -> ()) -> TypedPolicy redeemer
 mkTypedPolicy = TypedPolicy . toV2 . mkMintingPolicyScript