{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Shelley.MultiSigExamples (
  applyTxWithScript,
  aliceOnly,
  bobOnly,
  aliceAndBob,
  aliceOrBob,
  aliceAndBobOrCarl,
  aliceAndBobOrCarlAndDaria,
  aliceAndBobOrCarlOrDaria,
) where

import qualified Cardano.Crypto.Hash as Hash
import Cardano.Ledger.Address (Addr (Addr))
import Cardano.Ledger.BaseTypes (
  Network (..),
  StrictMaybe (..),
  maybeToStrictMaybe,
  mkTxIxPartial,
 )
import Cardano.Ledger.Coin
import Cardano.Ledger.Credential (
  pattern KeyHashObj,
  pattern ScriptHashObj,
  pattern StakeRefBase,
 )
import Cardano.Ledger.Keys (asWitness)
import Cardano.Ledger.Shelley (ShelleyEra)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState (
  LedgerState (..),
  UTxOState,
  genesisState,
 )
import Cardano.Ledger.Shelley.Rules (ShelleyUTXOW, UtxoEnv (..))
import Cardano.Ledger.Shelley.Scripts (
  MultiSig,
  ShelleyEraScript,
  pattern RequireAllOf,
  pattern RequireAnyOf,
  pattern RequireMOf,
  pattern RequireSignature,
 )
import Cardano.Ledger.Shelley.Tx (ShelleyTx (..))
import Cardano.Ledger.Shelley.TxAuxData (ShelleyTxAuxData)
import Cardano.Ledger.Shelley.TxBody (ShelleyTxBody (..))
import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits (..))
import Cardano.Ledger.Slot (SlotNo (..))
import Cardano.Ledger.TxIn (TxId, TxIn (..))
import qualified Cardano.Ledger.Val as Val
import Control.State.Transition
import Data.Default (Default (def))
import Data.Foldable (fold)
import Data.List.NonEmpty (NonEmpty)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map (empty, fromList)
import Data.Sequence.Strict (StrictSeq (..))
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set (fromList)
import Lens.Micro
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessesVKey)
import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
import Test.Cardano.Ledger.Shelley.Generator.Core (genesisCoins)
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Utils

-- Multi-Signature tests

-- This compile-time test asserts that the script hash and key hash use the
-- same hash size and indeed hash function. We do this by checking we can
-- type-check the following code that converts between them by using the hash
-- casting function which changes what the hash is of, without changing the
-- hashing algorithm.
--
_assertScriptHashSizeMatchesAddrHashSize :: ScriptHash -> KeyHash r
_assertScriptHashSizeMatchesAddrHashSize :: forall (r :: KeyRole). ScriptHash -> KeyHash r
_assertScriptHashSizeMatchesAddrHashSize (ScriptHash Hash ADDRHASH EraIndependentScript
h) = forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (forall h a b. Hash h a -> Hash h b
Hash.castHash Hash ADDRHASH EraIndependentScript
h)

-- Multi-signature scripts
singleKeyOnly :: ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly :: forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly (Addr Network
_ (KeyHashObj KeyHash 'Payment
pk) StakeReference
_) = forall era.
ShelleyEraScript era =>
KeyHash 'Witness -> NativeScript era
RequireSignature forall a b. (a -> b) -> a -> b
$ forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness KeyHash 'Payment
pk
singleKeyOnly Addr
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"use VKey address"

aliceOnly :: ShelleyEraScript era => NativeScript era
aliceOnly :: forall era. ShelleyEraScript era => NativeScript era
aliceOnly = forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.aliceAddr

bobOnly :: ShelleyEraScript era => NativeScript era
bobOnly :: forall era. ShelleyEraScript era => NativeScript era
bobOnly = forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.bobAddr

aliceOrBob :: ShelleyEraScript era => NativeScript era
aliceOrBob :: forall era. ShelleyEraScript era => NativeScript era
aliceOrBob = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. ShelleyEraScript era => NativeScript era
aliceOnly, forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.bobAddr])

aliceAndBob :: ShelleyEraScript era => NativeScript era
aliceAndBob :: forall era. ShelleyEraScript era => NativeScript era
aliceAndBob = forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. ShelleyEraScript era => NativeScript era
aliceOnly, forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.bobAddr])

aliceAndBobOrCarl :: ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl :: forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarl = forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf Int
1 (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. ShelleyEraScript era => NativeScript era
aliceAndBob, forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.carlAddr])

aliceAndBobOrCarlAndDaria :: ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria :: forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlAndDaria =
  forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf forall a b. (a -> b) -> a -> b
$
    forall a. [a] -> StrictSeq a
StrictSeq.fromList
      [ forall era. ShelleyEraScript era => NativeScript era
aliceAndBob
      , forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAllOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.carlAddr, forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.dariaAddr])
      ]

aliceAndBobOrCarlOrDaria ::
  ShelleyEraScript era =>
  NativeScript era
aliceAndBobOrCarlOrDaria :: forall era. ShelleyEraScript era => NativeScript era
aliceAndBobOrCarlOrDaria =
  forall era.
ShelleyEraScript era =>
Int -> StrictSeq (NativeScript era) -> NativeScript era
RequireMOf
    Int
1
    forall a b. (a -> b) -> a -> b
$ forall a. [a] -> StrictSeq a
StrictSeq.fromList
      [ forall era. ShelleyEraScript era => NativeScript era
aliceAndBob
      , forall era.
ShelleyEraScript era =>
StrictSeq (NativeScript era) -> NativeScript era
RequireAnyOf (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.carlAddr, forall era. ShelleyEraScript era => Addr -> NativeScript era
singleKeyOnly Addr
Cast.dariaAddr])
      ]

initTxBody ::
  ( EraTxOut era
  , EraTxCert era
  ) =>
  [(Addr, Value era)] ->
  ShelleyTxBody era
initTxBody :: forall era.
(EraTxOut era, EraTxCert era) =>
[(Addr, Value era)] -> ShelleyTxBody era
initTxBody [(Addr, Value era)]
addrs =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [TxId -> TxIx -> TxIn
TxIn TxId
genesisId forall a. Bounded a => a
minBound, TxId -> TxIx -> TxIn
TxIn TxId
genesisId (HasCallStack => Integer -> TxIx
mkTxIxPartial Integer
1)])
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut) [(Addr, Value era)]
addrs)
    forall a. StrictSeq a
Empty
    (Map RewardAccount Coin -> Withdrawals
Withdrawals forall k a. Map k a
Map.empty)
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
0)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

makeTxBody ::
  ( EraTxOut era
  , EraTxCert era
  ) =>
  [TxIn] ->
  [(Addr, Value era)] ->
  Withdrawals ->
  ShelleyTxBody era
makeTxBody :: forall era.
(EraTxOut era, EraTxCert era) =>
[TxIn] -> [(Addr, Value era)] -> Withdrawals -> ShelleyTxBody era
makeTxBody [TxIn]
inp [(Addr, Value era)]
addrCs Withdrawals
wdrl =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set TxIn
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe TxAuxDataHash
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [TxIn]
inp)
    (forall a. [a] -> StrictSeq a
StrictSeq.fromList [forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut (Addr, Value era)
addrC | (Addr, Value era)
addrC <- [(Addr, Value era)]
addrCs])
    forall a. StrictSeq a
Empty
    Withdrawals
wdrl
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
10)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

makeTx ::
  TxBody ShelleyEra ->
  [KeyPair 'Witness] ->
  Map ScriptHash (MultiSig ShelleyEra) ->
  Maybe (ShelleyTxAuxData ShelleyEra) ->
  ShelleyTx ShelleyEra
makeTx :: TxBody ShelleyEra
-> [KeyPair 'Witness]
-> Map ScriptHash (MultiSig ShelleyEra)
-> Maybe (ShelleyTxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
makeTx TxBody ShelleyEra
txBody [KeyPair 'Witness]
keyPairs Map ScriptHash (MultiSig ShelleyEra)
msigs = forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody ShelleyEra
txBody ShelleyTxWits ShelleyEra
txWits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
  where
    txWits :: ShelleyTxWits ShelleyEra
    txWits :: ShelleyTxWits ShelleyEra
txWits =
      forall era. EraTxWits era => TxWits era
mkBasicTxWits
        forall a b. a -> (a -> b) -> b
& forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey 'Witness))
addrTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
mkWitnessesVKey (forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody ShelleyEra
txBody) [KeyPair 'Witness]
keyPairs
        forall a b. a -> (a -> b) -> b
& forall era.
EraTxWits era =>
Lens' (TxWits era) (Map ScriptHash (Script era))
scriptTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map ScriptHash (MultiSig ShelleyEra)
msigs

aliceInitCoin :: Coin
aliceInitCoin :: Coin
aliceInitCoin = Integer -> Coin
Coin Integer
10000

bobInitCoin :: Coin
bobInitCoin :: Coin
bobInitCoin = Integer -> Coin
Coin Integer
1000

genesis ::
  forall era.
  ( EraTxOut era
  , EraGov era
  ) =>
  LedgerState era
genesis :: forall era. (EraTxOut era, EraGov era) => LedgerState era
genesis = forall era.
EraGov era =>
Map (KeyHash 'Genesis) GenDelegPair -> UTxO era -> LedgerState era
genesisState forall k a. Map k a
genDelegs0 UTxO era
utxo0
  where
    genDelegs0 :: Map k a
genDelegs0 = forall k a. Map k a
Map.empty
    utxo0 :: UTxO era
utxo0 =
      forall era. TxId -> [TxOut era] -> UTxO era
genesisCoins @era
        TxId
genesisId
        [ forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin)
        , forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
mkBasicTxOut Addr
Cast.bobAddr (forall t s. Inject t s => t -> s
Val.inject Coin
bobInitCoin)
        ]

initPParams :: EraPParams era => PParams era
initPParams :: forall era. EraPParams era => PParams era
initPParams =
  forall era. EraPParams era => PParams era
emptyPParams
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxTxSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
1000

-- | Create an initial UTxO state where Alice has 'aliceInitCoin' and Bob
-- 'bobInitCoin' to spend. Then create and apply a transaction which, if
-- 'aliceKeep' is greater than 0, gives that amount to Alice and creates outputs
-- locked by a script for each pair of script, coin value in 'msigs'.
initialUTxOState ::
  Coin ->
  [(MultiSig ShelleyEra, Coin)] ->
  ( TxId
  , Either
      (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
      (UTxOState ShelleyEra)
  )
initialUTxOState :: Coin
-> [(MultiSig ShelleyEra, Coin)]
-> (TxId,
    Either
      (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
      (UTxOState ShelleyEra))
initialUTxOState Coin
aliceKeep [(MultiSig ShelleyEra, Coin)]
msigs =
  let addresses :: [(Addr, Coin)]
addresses =
        [(Addr
Cast.aliceAddr, Coin
aliceKeep) | forall t. Val t => (Integer -> Integer -> Bool) -> t -> t -> Bool
Val.pointwise forall a. Ord a => a -> a -> Bool
(>) Coin
aliceKeep forall a. Monoid a => a
mempty]
          forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map
            ( \(MultiSig ShelleyEra
msig, Coin
era) ->
                ( Network -> Credential 'Payment -> StakeReference -> Addr
Addr
                    Network
Testnet
                    (forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra MultiSig ShelleyEra
msig)
                    (StakeCredential -> StakeReference
StakeRefBase forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole). ScriptHash -> Credential kr
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra MultiSig ShelleyEra
msig)
                , Coin
era
                )
            )
            [(MultiSig ShelleyEra, Coin)]
msigs
   in let tx :: ShelleyTx ShelleyEra
tx =
            TxBody ShelleyEra
-> [KeyPair 'Witness]
-> Map ScriptHash (MultiSig ShelleyEra)
-> Maybe (ShelleyTxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
makeTx
              (forall era.
(EraTxOut era, EraTxCert era) =>
[(Addr, Value era)] -> ShelleyTxBody era
initTxBody [(Addr, Coin)]
addresses)
              (forall (a :: KeyRole -> *) (r :: KeyRole).
HasKeyRole a =>
a r -> a 'Witness
asWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [KeyPair 'Payment
Cast.alicePay, KeyPair 'Payment
Cast.bobPay])
              forall k a. Map k a
Map.empty
              forall a. Maybe a
Nothing
       in ( forall era. EraTx era => Tx era -> TxId
txIdTx ShelleyTx ShelleyEra
tx
          , forall a. ShelleyBase a -> a
runShelleyBase forall a b. (a -> b) -> a -> b
$
              forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTSTest @(ShelleyUTXOW ShelleyEra)
                ( forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
                    ( forall era. SlotNo -> PParams era -> CertState era -> UtxoEnv era
UtxoEnv
                        (Word64 -> SlotNo
SlotNo Word64
0)
                        forall era. EraPParams era => PParams era
initPParams
                        forall a. Default a => a
def
                    , forall era. LedgerState era -> UTxOState era
lsUTxOState forall era. (EraTxOut era, EraGov era) => LedgerState era
genesis
                    , ShelleyTx ShelleyEra
tx
                    )
                )
          )

-- | Start from genesis, consume Alice's and Bob's coins, create an output
-- spendable by Alice if 'aliceKeep' is greater than 0. For each pair of script
-- and coin value in 'lockScripts' create an output of that value locked by the
-- script. Sign the transaction with keys in 'signers'. Then create an
-- transaction that uses the scripts in 'unlockScripts' (and the output for
-- 'aliceKeep' in the case of it being non-zero) to spend all funds back to
-- Alice. Return resulting UTxO state or collected errors
applyTxWithScript ::
  [(MultiSig ShelleyEra, Coin)] ->
  [MultiSig ShelleyEra] ->
  Withdrawals ->
  Coin ->
  [KeyPair 'Witness] ->
  Either (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra))) (UTxOState ShelleyEra)
applyTxWithScript :: [(MultiSig ShelleyEra, Coin)]
-> [MultiSig ShelleyEra]
-> Withdrawals
-> Coin
-> [KeyPair 'Witness]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
     (UTxOState ShelleyEra)
applyTxWithScript [(MultiSig ShelleyEra, Coin)]
lockScripts [MultiSig ShelleyEra]
unlockScripts Withdrawals
wdrl Coin
aliceKeep [KeyPair 'Witness]
signers = Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt'
  where
    (TxId
txId, Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
initUtxo) = Coin
-> [(MultiSig ShelleyEra, Coin)]
-> (TxId,
    Either
      (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
      (UTxOState ShelleyEra))
initialUTxOState Coin
aliceKeep [(MultiSig ShelleyEra, Coin)]
lockScripts
    utxoSt :: UTxOState ShelleyEra
utxoSt = case Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
initUtxo of
      Right UTxOState ShelleyEra
utxoSt'' -> UTxOState ShelleyEra
utxoSt''
      Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
_ -> forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"must fail test before: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW ShelleyEra)))
  (UTxOState ShelleyEra)
initUtxo
    txbody :: ShelleyTxBody ShelleyEra
txbody =
      forall era.
(EraTxOut era, EraTxCert era) =>
[TxIn] -> [(Addr, Value era)] -> Withdrawals -> ShelleyTxBody era
makeTxBody
        [TxIn]
inputs'
        [(Addr
Cast.aliceAddr, forall t s. Inject t s => t -> s
Val.inject forall a b. (a -> b) -> a -> b
$ Coin
aliceInitCoin forall a. Semigroup a => a -> a -> a
<> Coin
bobInitCoin forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (Withdrawals -> Map RewardAccount Coin
unWithdrawals Withdrawals
wdrl))]
        Withdrawals
wdrl
    inputs' :: [TxIn]
inputs' =
      [ TxId -> TxIx -> TxIn
TxIn TxId
txId (HasCallStack => Integer -> TxIx
mkTxIxPartial (forall a. Integral a => a -> Integer
toInteger Int
n))
      | Int
n <-
          [Int
0 .. forall (t :: * -> *) a. Foldable t => t a -> Int
length [(MultiSig ShelleyEra, Coin)]
lockScripts forall a. Num a => a -> a -> a
- if forall t. Val t => (Integer -> Integer -> Bool) -> t -> t -> Bool
Val.pointwise forall a. Ord a => a -> a -> Bool
(>) Coin
aliceKeep forall a. Monoid a => a
mempty then Int
0 else Int
1]
      ]
    -- alice? + scripts
    tx :: ShelleyTx ShelleyEra
tx =
      TxBody ShelleyEra
-> [KeyPair 'Witness]
-> Map ScriptHash (MultiSig ShelleyEra)
-> Maybe (ShelleyTxAuxData ShelleyEra)
-> ShelleyTx ShelleyEra
makeTx
        ShelleyTxBody ShelleyEra
txbody
        [KeyPair 'Witness]
signers
        (forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\MultiSig ShelleyEra
scr -> (forall era. EraScript era => Script era -> ScriptHash
hashScript @ShelleyEra MultiSig ShelleyEra
scr, MultiSig ShelleyEra
scr)) [MultiSig ShelleyEra]
unlockScripts)
        forall a. Maybe a
Nothing
    utxoSt' :: Either
  (NonEmpty (ShelleyUtxowPredFailure ShelleyEra))
  (UTxOState ShelleyEra)
utxoSt' =
      forall a. ShelleyBase a -> a
runShelleyBase forall a b. (a -> b) -> a -> b
$
        forall s (m :: * -> *) (rtype :: RuleType).
(STS s, RuleTypeRep rtype, m ~ BaseM s) =>
RuleContext rtype s
-> m (Either (NonEmpty (PredicateFailure s)) (State s))
applySTSTest @(ShelleyUTXOW ShelleyEra)
          ( forall sts. (Environment sts, State sts, Signal sts) -> TRC sts
TRC
              ( forall era. SlotNo -> PParams era -> CertState era -> UtxoEnv era
UtxoEnv
                  (Word64 -> SlotNo
SlotNo Word64
0)
                  forall era. EraPParams era => PParams era
initPParams
                  forall a. Default a => a
def
              , UTxOState ShelleyEra
utxoSt
              , ShelleyTx ShelleyEra
tx
              )
          )