{-# 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 (
  KeyHash (..),
  KeyRole (..),
  asWitness,
 )
import Cardano.Ledger.SafeHash (hashAnnotated)
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.Class (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 Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (
  Mock,
 )
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 c ->
  KeyHash r c
_assertScriptHashSizeMatchesAddrHashSize :: forall c (r :: KeyRole). ScriptHash c -> KeyHash r c
_assertScriptHashSizeMatchesAddrHashSize (ScriptHash Hash (ADDRHASH c) EraIndependentScript
h) =
  forall (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator c
KeyHash (forall h a b. Hash h a -> Hash h b
Hash.castHash Hash (ADDRHASH c) EraIndependentScript
h)

-- Multi-signature scripts
singleKeyOnly :: ShelleyEraScript era => Addr (EraCrypto era) -> NativeScript era
singleKeyOnly :: forall era.
ShelleyEraScript era =>
Addr (EraCrypto era) -> NativeScript era
singleKeyOnly (Addr Network
_ (KeyHashObj KeyHash 'Payment (EraCrypto era)
pk) StakeReference (EraCrypto era)
_) = forall era.
ShelleyEraScript era =>
KeyHash 'Witness (EraCrypto era) -> NativeScript era
RequireSignature forall a b. (a -> b) -> a -> b
$ forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness KeyHash 'Payment (EraCrypto era)
pk
singleKeyOnly Addr (EraCrypto era)
_ = 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 (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
Cast.aliceAddr

bobOnly :: ShelleyEraScript era => NativeScript era
bobOnly :: forall era. ShelleyEraScript era => NativeScript era
bobOnly = forall era.
ShelleyEraScript era =>
Addr (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
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 (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
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 (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
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 (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
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 (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
Cast.carlAddr, forall era.
ShelleyEraScript era =>
Addr (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
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 (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
Cast.carlAddr, forall era.
ShelleyEraScript era =>
Addr (EraCrypto era) -> NativeScript era
singleKeyOnly forall c. Crypto c => Addr c
Cast.dariaAddr])
      ]

initTxBody ::
  ( EraTxOut era
  , EraTxCert era
  ) =>
  [(Addr (EraCrypto era), Value era)] ->
  ShelleyTxBody era
initTxBody :: forall era.
(EraTxOut era, EraTxCert era) =>
[(Addr (EraCrypto era), Value era)] -> ShelleyTxBody era
initTxBody [(Addr (EraCrypto era), Value era)]
addrs =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [forall c. TxId c -> TxIx -> TxIn c
TxIn forall c. HashAlgorithm (HASH c) => TxId c
genesisId forall a. Bounded a => a
minBound, forall c. TxId c -> TxIx -> TxIn c
TxIn forall c. HashAlgorithm (HASH c) => TxId c
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 (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut) [(Addr (EraCrypto era), Value era)]
addrs)
    forall a. StrictSeq a
Empty
    (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
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 (EraCrypto era)] ->
  [(Addr (EraCrypto era), Value era)] ->
  Withdrawals (EraCrypto era) ->
  ShelleyTxBody era
makeTxBody :: forall era.
(EraTxOut era, EraTxCert era) =>
[TxIn (EraCrypto era)]
-> [(Addr (EraCrypto era), Value era)]
-> Withdrawals (EraCrypto era)
-> ShelleyTxBody era
makeTxBody [TxIn (EraCrypto era)]
inp [(Addr (EraCrypto era), Value era)]
addrCs Withdrawals (EraCrypto era)
wdrl =
  forall era.
(EraTxOut era, EncCBOR (TxCert era)) =>
Set (TxIn (EraCrypto era))
-> StrictSeq (TxOut era)
-> StrictSeq (TxCert era)
-> Withdrawals (EraCrypto era)
-> Coin
-> SlotNo
-> StrictMaybe (Update era)
-> StrictMaybe (AuxiliaryDataHash (EraCrypto era))
-> ShelleyTxBody era
ShelleyTxBody
    (forall a. Ord a => [a] -> Set a
Set.fromList [TxIn (EraCrypto era)]
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 (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut (Addr (EraCrypto era), Value era)
addrC | (Addr (EraCrypto era), Value era)
addrC <- [(Addr (EraCrypto era), Value era)]
addrCs])
    forall a. StrictSeq a
Empty
    Withdrawals (EraCrypto era)
wdrl
    (Integer -> Coin
Coin Integer
0)
    (Word64 -> SlotNo
SlotNo Word64
10)
    forall a. StrictMaybe a
SNothing
    forall a. StrictMaybe a
SNothing

makeTx ::
  forall c.
  Mock c =>
  TxBody (ShelleyEra c) ->
  [KeyPair 'Witness c] ->
  Map (ScriptHash c) (MultiSig (ShelleyEra c)) ->
  Maybe (ShelleyTxAuxData (ShelleyEra c)) ->
  ShelleyTx (ShelleyEra c)
makeTx :: forall c.
Mock c =>
TxBody (ShelleyEra c)
-> [KeyPair 'Witness c]
-> Map (ScriptHash c) (MultiSig (ShelleyEra c))
-> Maybe (ShelleyTxAuxData (ShelleyEra c))
-> ShelleyTx (ShelleyEra c)
makeTx TxBody (ShelleyEra c)
txBody [KeyPair 'Witness c]
keyPairs Map (ScriptHash c) (MultiSig (ShelleyEra c))
msigs = forall era.
EraTx era =>
TxBody era
-> TxWits era -> StrictMaybe (TxAuxData era) -> ShelleyTx era
ShelleyTx TxBody (ShelleyEra c)
txBody ShelleyTxWits (ShelleyEra c)
txWits forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe
  where
    txWits :: ShelleyTxWits (ShelleyEra c)
    txWits :: ShelleyTxWits (ShelleyEra c)
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 (EraCrypto era)))
addrTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> [KeyPair kr c] -> Set (WitVKey 'Witness c)
mkWitnessesVKey (forall x index c.
(HashAnnotated x index c, HashAlgorithm (HASH c)) =>
x -> SafeHash c index
hashAnnotated TxBody (ShelleyEra c)
txBody) [KeyPair 'Witness c]
keyPairs
        forall a b. a -> (a -> b) -> b
& forall era.
EraTxWits era =>
Lens' (TxWits era) (Map (ScriptHash (EraCrypto era)) (Script era))
scriptTxWitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Map (ScriptHash c) (MultiSig (ShelleyEra c))
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 (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> 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 (EraCrypto era) -> [TxOut era] -> UTxO era
genesisCoins @era
        forall c. HashAlgorithm (HASH c) => TxId c
genesisId
        [ forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut forall c. Crypto c => Addr c
Cast.aliceAddr (forall t s. Inject t s => t -> s
Val.inject Coin
aliceInitCoin)
        , forall era.
(EraTxOut era, HasCallStack) =>
Addr (EraCrypto era) -> Value era -> TxOut era
mkBasicTxOut forall c. Crypto c => Addr c
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 ::
  forall c.
  Mock c =>
  Coin ->
  [(MultiSig (ShelleyEra c), Coin)] ->
  ( TxId c
  , Either
      (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
      (UTxOState (ShelleyEra c))
  )
initialUTxOState :: forall c.
Mock c =>
Coin
-> [(MultiSig (ShelleyEra c), Coin)]
-> (TxId c,
    Either
      (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
      (UTxOState (ShelleyEra c)))
initialUTxOState Coin
aliceKeep [(MultiSig (ShelleyEra c), Coin)]
msigs =
  let addresses :: [(Addr c, Coin)]
addresses =
        [(forall c. Crypto c => Addr c
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 c)
msig, Coin
era) ->
                ( forall c.
Network -> PaymentCredential c -> StakeReference c -> Addr c
Addr
                    Network
Testnet
                    (forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(ShelleyEra c) MultiSig (ShelleyEra c)
msig)
                    (forall c. StakeCredential c -> StakeReference c
StakeRefBase forall a b. (a -> b) -> a -> b
$ forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall a b. (a -> b) -> a -> b
$ forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(ShelleyEra c) MultiSig (ShelleyEra c)
msig)
                , Coin
era
                )
            )
            [(MultiSig (ShelleyEra c), Coin)]
msigs
   in let tx :: ShelleyTx (ShelleyEra c)
tx =
            forall c.
Mock c =>
TxBody (ShelleyEra c)
-> [KeyPair 'Witness c]
-> Map (ScriptHash c) (MultiSig (ShelleyEra c))
-> Maybe (ShelleyTxAuxData (ShelleyEra c))
-> ShelleyTx (ShelleyEra c)
makeTx
              (forall era.
(EraTxOut era, EraTxCert era) =>
[(Addr (EraCrypto era), Value era)] -> ShelleyTxBody era
initTxBody [(Addr c, Coin)]
addresses)
              (forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
asWitness forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [forall c. Crypto c => KeyPair 'Payment c
Cast.alicePay, forall c. Crypto c => KeyPair 'Payment c
Cast.bobPay])
              forall k a. Map k a
Map.empty
              forall a. Maybe a
Nothing
       in ( forall era. EraTx era => Tx era -> TxId (EraCrypto era)
txIdTx ShelleyTx (ShelleyEra c)
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 c))
                ( 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 c)
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 ::
  forall c.
  Mock c =>
  [(MultiSig (ShelleyEra c), Coin)] ->
  [MultiSig (ShelleyEra c)] ->
  Withdrawals c ->
  Coin ->
  [KeyPair 'Witness c] ->
  Either (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c)))) (UTxOState (ShelleyEra c))
applyTxWithScript :: forall c.
Mock c =>
[(MultiSig (ShelleyEra c), Coin)]
-> [MultiSig (ShelleyEra c)]
-> Withdrawals c
-> Coin
-> [KeyPair 'Witness c]
-> Either
     (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
     (UTxOState (ShelleyEra c))
applyTxWithScript [(MultiSig (ShelleyEra c), Coin)]
lockScripts [MultiSig (ShelleyEra c)]
unlockScripts Withdrawals c
wdrl Coin
aliceKeep [KeyPair 'Witness c]
signers = Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra c)))
  (UTxOState (ShelleyEra c))
utxoSt'
  where
    (TxId c
txId, Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
  (UTxOState (ShelleyEra c))
initUtxo) = forall c.
Mock c =>
Coin
-> [(MultiSig (ShelleyEra c), Coin)]
-> (TxId c,
    Either
      (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
      (UTxOState (ShelleyEra c)))
initialUTxOState Coin
aliceKeep [(MultiSig (ShelleyEra c), Coin)]
lockScripts
    utxoSt :: UTxOState (ShelleyEra c)
utxoSt = case Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
  (UTxOState (ShelleyEra c))
initUtxo of
      Right UTxOState (ShelleyEra c)
utxoSt'' -> UTxOState (ShelleyEra c)
utxoSt''
      Either
  (NonEmpty (PredicateFailure (ShelleyUTXOW (ShelleyEra c))))
  (UTxOState (ShelleyEra c))
_ -> 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 c))))
  (UTxOState (ShelleyEra c))
initUtxo
    txbody :: ShelleyTxBody (ShelleyEra c)
txbody =
      forall era.
(EraTxOut era, EraTxCert era) =>
[TxIn (EraCrypto era)]
-> [(Addr (EraCrypto era), Value era)]
-> Withdrawals (EraCrypto era)
-> ShelleyTxBody era
makeTxBody
        [TxIn c]
inputs'
        [(forall c. Crypto c => Addr c
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 (forall c. Withdrawals c -> Map (RewardAcnt c) Coin
unWithdrawals Withdrawals c
wdrl))]
        Withdrawals c
wdrl
    inputs' :: [TxIn c]
inputs' =
      [ forall c. TxId c -> TxIx -> TxIn c
TxIn TxId c
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 c), 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 c)
tx =
      forall c.
Mock c =>
TxBody (ShelleyEra c)
-> [KeyPair 'Witness c]
-> Map (ScriptHash c) (MultiSig (ShelleyEra c))
-> Maybe (ShelleyTxAuxData (ShelleyEra c))
-> ShelleyTx (ShelleyEra c)
makeTx
        ShelleyTxBody (ShelleyEra c)
txbody
        [KeyPair 'Witness c]
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 c)
scr -> (forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @(ShelleyEra c) MultiSig (ShelleyEra c)
scr, MultiSig (ShelleyEra c)
scr)) [MultiSig (ShelleyEra c)]
unlockScripts)
        forall a. Maybe a
Nothing
    utxoSt' :: Either
  (NonEmpty (ShelleyUtxowPredFailure (ShelleyEra c)))
  (UTxOState (ShelleyEra c))
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 c))
          ( 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 c)
utxoSt
              , ShelleyTx (ShelleyEra c)
tx
              )
          )