View on GitHub
File Changes
    , AsSMContractError(..)
    , SM.StateMachine(..)
    , SM.StateMachineInstance(..)
-
    , SM.OldState(..)
-
    , SM.NewState(..)
+
    , SM.State(..)
    -- * Constructing the machine instance
    , SM.mkValidator
    , SM.mkStateMachine
    -- * Running the state machine
    , runStep
    , runInitialise
+
    -- * Re-exports
+
    , Void
    ) where

                      
import           Control.Lens
import           Control.Monad.Error.Lens
import           Data.Text                        (Text)
import qualified Data.Text                        as Text
+
import           Data.Void                        (Void)

                      
import           Language.Plutus.Contract
import qualified Language.PlutusTx                as PlutusTx
-
import           Language.PlutusTx.StateMachine   (NewState (..), OldState (..), StateMachine (..),
+
import           Language.PlutusTx.StateMachine   (State (..), StateMachine (..),
                                                   StateMachineInstance (..))
import qualified Language.PlutusTx.StateMachine   as SM
import           Ledger                           (Value)
    -> Contract schema e state
runStep smc input = do
    let StateMachineInstance{stateMachine} = scInstance smc
-
    (NewState{newData=s, newValue=v, newConstraints}, inp, lookups) <- mkStep smc input
+
    (newConstraints, State{stateData=s, stateValue=v}, inp, lookups) <- mkStep smc input
    pk <- ownPubKey
    let lookups' = lookups { Constraints.slOwnPubkey = Just $ pubKeyHash pk }
        txConstraints =
            if smFinal stateMachine s
-
                then TxConstraints{ txConstraints = newConstraints, txOwnInputs = [inp], txOwnOutputs = [] }
+
                then newConstraints { txOwnInputs = [inp], txOwnOutputs = [] }
                else
                    let output = OutputConstraint{ocData = s, ocValue = v}
-
                    in  TxConstraints{ txConstraints = newConstraints, txOwnInputs = [inp], txOwnOutputs = [output] }
+
                    in  newConstraints { txOwnInputs = [inp], txOwnOutputs = [output] }
    utx <- either (throwing _ConstraintResolutionError) pure (Constraints.mkTx lookups' txConstraints)
    submitTxConfirmed utx
    pure s
    submitTxConfirmed utx
    pure initialState

                      
-
type StateMachineTypedTx state input = (NewState state, InputConstraint input, ScriptLookups (StateMachine state input))
+
type StateMachineTypedTx state input = (TxConstraints Void Void, State state, InputConstraint input, ScriptLookups (StateMachine state input))

                      
mkStep ::
    forall e state schema input.
    let StateMachineInstance{stateMachine=StateMachine{smTransition}, validatorInstance} = scInstance
    (onChainState, utxo) <- getOnChainState client
    let (TypedScriptTxOut{tyTxOutData=currentState, tyTxOutTxOut}, txOutRef) = onChainState
-
        oldState = OldState{oldData = currentState, oldValue = Ledger.txOutValue tyTxOutTxOut}
+
        oldState = State{stateData = currentState, stateValue = Ledger.txOutValue tyTxOutTxOut}

                      
    case smTransition oldState input of
-
        Just newState  ->
+
        Just (newConstraints, newState)  ->
            let lookups = (Constraints.scriptLookups validatorInstance) { Constraints.slTxOutputs = utxo }

                      
-
            in pure (newState, InputConstraint{icRedeemer=input, icTxOutRef = Typed.tyTxOutRefRef txOutRef }, lookups)
+
            in pure (newConstraints, newState, InputConstraint{icRedeemer=input, icTxOutRef = Typed.tyTxOutRefRef txOutRef }, lookups)
        Nothing -> throwing _InvalidTransition (currentState, input)
                -- we don't need to add a pubkey output for 'vestingOwner' here
                -- because this will be done by the wallet when it balances the
                -- transaction.
-
        lookups = (scriptLookups inst) { slTxOutputs =  unspentOutputs }
-
    void $ submitTxConstraintsWith lookups tx
+
    in
+
    void $ submitConstraintsUtxo inst unspentOutputs lookups tx
    return liveness

                      
endpoints :: Contract VestingSchema T.Text ()
import           GHC.Generics                   (Generic)
import           Language.Plutus.Contract
import qualified Ledger.Constraints  as Constraints
-
import Ledger.Constraints.TxConstraints (TxConstraint(..))
+
import           Ledger.Constraints.TxConstraints (TxConstraints)
import           Language.Plutus.Contract.Util  (loopM)
import qualified Language.PlutusTx              as PlutusTx
import           Language.PlutusTx.Prelude
import qualified Language.PlutusTx.Coordination.Contracts.Escrow as Escrow
import qualified Language.PlutusTx.Coordination.Contracts.TokenAccount as TokenAccount
import Language.PlutusTx.Coordination.Contracts.TokenAccount (Account(..))
-
import           Language.Plutus.Contract.StateMachine (AsSMContractError, StateMachine(..), NewState(..), OldState(..))
+
import           Language.Plutus.Contract.StateMachine (AsSMContractError, StateMachine(..), State(..), Void)
import qualified Language.Plutus.Contract.StateMachine as SM

                      
import qualified Prelude as Haskell
validator ft fos = Scripts.validatorScript (scriptInstance ft fos)

                      
{-# INLINABLE verifyOracle #-}
-
verifyOracle :: PlutusTx.IsData a => PubKey -> SignedMessage a -> Maybe (a, TxConstraint)
+
verifyOracle :: PlutusTx.IsData a => PubKey -> SignedMessage a -> Maybe (a, TxConstraints Void Void)
verifyOracle pubKey sm =
    either (const Nothing) pure 
    $ Oracle.verifySignedMessageConstraints pubKey sm
        Right Observation{obsValue, obsSlot} -> Just (obsSlot, obsValue)

                      
{-# INLINABLE transition #-}
-
transition :: Future -> FutureAccounts -> OldState FutureState -> FutureAction -> Maybe (NewState FutureState)
-
transition future owners OldState{oldData=s, oldValue=currentValue} i = 
-
    let Future{ftDeliveryDate, ftPriceOracle} = future in
-
        case (s, i) of
-
            (Running accounts, AdjustMargin role topUp) ->
-
                Just NewState
-
                        { newData = Running (adjustMargin role topUp accounts)
-
                        , newValue = topUp + totalMargin accounts
-
                        , newConstraints = []
-
                        }
-
            (Running accounts, Settle ov)
-
                | Just (Observation{obsValue=spotPrice, obsSlot=oracleDate}, constraint) <- verifyOracle ftPriceOracle ov, ftDeliveryDate == oracleDate ->
-
                    let payment = payouts future accounts spotPrice in
-
                    Just NewState
-
                            { newData = Finished
-
                            , newValue = mempty
-
                            , newConstraints = 
-
                                (Constraints.MustValidateIn (Interval.from ftDeliveryDate)
-
                                : constraint
-
                                : payoutsTx payment owners)
+
transition :: Future -> FutureAccounts -> State FutureState -> FutureAction -> Maybe (TxConstraints Void Void, State FutureState)
+
transition [email protected]{ftDeliveryDate, ftPriceOracle} owners State{stateData=s, stateValue=currentValue} i =
+
    case (s, i) of
+
        (Running accounts, AdjustMargin role topUp) ->
+
            Just ( mempty
+
                    , State
+
                    { stateData = Running (adjustMargin role topUp accounts)
+
                    , stateValue = topUp + totalMargin accounts
+
                    }
+
                    )
+
        (Running accounts, Settle ov)
+
            | Just (Observation{obsValue=spotPrice, obsSlot=oracleDate}, oracleConstraints) <- verifyOracle ftPriceOracle ov, ftDeliveryDate == oracleDate ->
+
                let payment = payouts future accounts spotPrice
+
                    constraints = 
+
                        Constraints.mustValidateIn (Interval.from ftDeliveryDate)
+
                        <> oracleConstraints
+
                        <> payoutsTx payment owners
+
                in Just ( constraints
+
                        , State
+
                            { stateData = Finished
+
                            , stateValue = mempty
                            }
-
            (Running accounts, SettleEarly ov)
-
                | Just (Observation{obsValue=spotPrice, obsSlot=oracleDate}, constraint) <- verifyOracle ftPriceOracle ov, Just vRole <- violatingRole future accounts spotPrice, ftDeliveryDate > oracleDate ->
-
                    let
-
                        total = totalMargin accounts
-
                        FutureAccounts{ftoLongAccount, ftoShortAccount} = owners
-
                        payment = case vRole of
-
                                    Short -> Constraints.MustPayToOtherScript ftoLongAccount unitData total
-
                                    Long -> Constraints.MustPayToOtherScript ftoShortAccount unitData total
-
                    in Just NewState
-
                        { newData = Finished
-
                        , newValue = mempty
-
                        , newConstraints = [payment, constraint]
-
                        }
-
            _ -> Nothing
+
                        )
+
        (Running accounts, SettleEarly ov)
+
            | Just (Observation{obsValue=spotPrice, obsSlot=oracleDate}, oracleConstraints) <- verifyOracle ftPriceOracle ov, Just vRole <- violatingRole future accounts spotPrice, ftDeliveryDate > oracleDate ->
+
                let
+
                    total = totalMargin accounts
+
                    FutureAccounts{ftoLongAccount, ftoShortAccount} = owners
+
                    payment = case vRole of
+
                                Short -> Constraints.mustPayToOtherScript ftoLongAccount unitData total
+
                                Long -> Constraints.mustPayToOtherScript ftoShortAccount unitData total
+
                    constraints = payment <> oracleConstraints
+
                in Just ( constraints 
+
                        , State
+
                            { stateData = Finished
+
                            , stateValue = mempty
+
                            }
+
                        )
+
        _ -> Nothing

                      
data Payouts =
    Payouts
payoutsTx
    :: Payouts
    -> FutureAccounts
-
    -> [TxConstraint]
+
    -> TxConstraints Void Void
payoutsTx 
    Payouts{payoutsShort, payoutsLong}
    FutureAccounts{ftoLongAccount, ftoShortAccount} =
-
        [ Constraints.MustPayToOtherScript ftoLongAccount unitData payoutsLong
-
        , Constraints.MustPayToOtherScript ftoShortAccount unitData payoutsShort
-
        ]
+
        Constraints.mustPayToOtherScript ftoLongAccount unitData payoutsLong
+
        <> Constraints.mustPayToOtherScript ftoShortAccount unitData payoutsShort

                      
{-# INLINABLE payouts #-}
-- | Compute the payouts for each role given the future data,
import qualified Language.PlutusTx            as PlutusTx
import           Language.PlutusTx.Prelude    hiding (check, Applicative (..))
import           Ledger                       hiding (to)
+
import           Ledger.Constraints (TxConstraints)
import qualified Ledger.Constraints           as Constraints
import qualified Ledger.Value                 as V
import qualified Ledger.Typed.Scripts         as Scripts

                      
import qualified Data.ByteString.Lazy.Char8   as C

                      
-
import           Language.Plutus.Contract.StateMachine (AsSMContractError, NewState(..), OldState(..))
+
import           Language.Plutus.Contract.StateMachine (AsSMContractError, State(..), Void)
import qualified Language.Plutus.Contract.StateMachine as SM

                      
import           Language.Plutus.Contract
    deriving (Show)

                      
{-# INLINABLE transition #-}
-
transition :: OldState GameState -> GameInput -> Maybe (NewState GameState)
-
transition OldState{oldData, oldValue} input = case (oldData, input) of
+
transition :: State GameState -> GameInput -> Maybe (TxConstraints Void Void, State GameState)
+
transition State{stateData=oldData, stateValue=oldValue} input = case (oldData, input) of
    (Initialised mph tn s, ForgeToken) -> 
-
        Just NewState
-
                { newData = Locked mph tn s
-
                , newValue = oldValue
-
                , newConstraints = [Constraints.MustForgeValue mph tn 1]
+
        let constraints = Constraints.mustForgeValue mph tn 1 in
+
        Just ( constraints
+
             , State
+
                { stateData = Locked mph tn s
+
                , stateValue = oldValue
                }
+
             )
    (Locked mph tn currentSecret, Guess theGuess nextSecret takenOut)
        | checkGuess currentSecret theGuess ->
-
        Just NewState
-
                { newData = Locked mph tn nextSecret
-
                , newValue = oldValue - takenOut
-
                , newConstraints = 
-
                    [ Constraints.MustSpendValue (token mph tn)
-
                    , Constraints.MustForgeValue mph tn 0
-
                    ]
+
        let constraints = Constraints.mustSpendValue (token mph tn) <> Constraints.mustForgeValue mph tn 0 in
+
        Just ( constraints
+
             , State
+
                { stateData = Locked mph tn nextSecret
+
                , stateValue = oldValue - takenOut
                }
+
             )
    _ -> Nothing

                      
{-# INLINABLE machine #-}
import           Control.Monad                (void)
import           Language.Plutus.Contract
import qualified Ledger.Constraints           as Constraints
-
import Ledger.Constraints.OffChain (scriptLookups)
import qualified Language.Plutus.Contract.Typed.Tx  as Tx
import           Language.PlutusTx.Prelude    hiding (Semigroup(..), foldMap)
import qualified Language.PlutusTx            as PlutusTx
    (ms, vl) <- endpoint @"lock"
    let tx = Constraints.mustPayToScript () vl
    let inst = scriptInstance ms
-
    void $ submitTxConstraintsWith (scriptLookups inst) tx
+
    void $ submitTxConstraints inst tx

                      
-- | The @"unlock"@ endpoint, unlocking some funds with a list
--   of signatures.
    ) where

                      
import           Control.Lens                 (makeClassyPrisms)
+
import           Ledger.Constraints           (TxConstraints)
import qualified Ledger.Constraints           as Constraints
import qualified Ledger.Interval              as Interval
import           Ledger.Validation            (PendingTx, PendingTx'(..))

                      
import qualified Language.PlutusTx            as PlutusTx
import           Language.Plutus.Contract
-
import           Language.Plutus.Contract.StateMachine (AsSMContractError, StateMachine(..), OldState(..), NewState(..))
+
import           Language.Plutus.Contract.StateMachine (AsSMContractError, StateMachine(..), State(..), Void)
import qualified Language.Plutus.Contract.StateMachine as SM
import           Language.PlutusTx.Prelude         hiding (Applicative (..))

                      
    }

                      
-- | State of the multisig contract.
-
data State =
+
data MSState =
    Holding
    -- ^ Money is locked, anyone can make a proposal for a payment. If there is
    -- no value here then this is a final state and the machine will terminate.
    -- ^ A payment has been proposed and is awaiting signatures.
    deriving (Show)

                      
-
instance Eq State where
+
instance Eq MSState where
    {-# INLINABLE (==) #-}
    Holding == Holding = True
    (CollectingSignatures pmt pks) == (CollectingSignatures pmt' pks') =

                      
data MultiSigError =
    MSContractError ContractError
-
    | MSStateMachineError (SM.SMContractError State Input)
+
    | MSStateMachineError (SM.SMContractError MSState Input)
    deriving Show
makeClassyPrisms ''MultiSigError

                      
instance AsContractError MultiSigError where
    _ContractError = _MSContractError

                      
-
instance AsSMContractError MultiSigError State Input where
+
instance AsSMContractError MultiSigError MSState Input where
    _SMContractError = _MSStateMachineError

                      
type MultiSigSchema =
valuePaid (Payment vl pk _) ptx = vl == (Validation.valuePaidTo ptx pk)

                      
{-# INLINABLE transition #-}
-
transition :: Params -> OldState State -> Input -> Maybe (NewState State)   
-
transition params OldState{ oldData =s, oldValue=currentValue} i = case (s, i) of
+
transition :: Params -> State MSState -> Input -> Maybe (TxConstraints Void Void, State MSState)
+
transition params State{ stateData =s, stateValue=currentValue} i = case (s, i) of
    (Holding, ProposePayment pmt)
        | isValidProposal currentValue pmt ->
-
            Just NewState
-
                    { newData = CollectingSignatures pmt []
-
                    , newValue = currentValue
-
                    , newConstraints = []
+
            Just ( mempty
+
                 , State
+
                    { stateData = CollectingSignatures pmt []
+
                    , stateValue = currentValue
                    }
+
                 )
    (CollectingSignatures pmt pks, AddSignature pk)
        | isSignatory pk params && not (containsPk pk pks) ->
-
            Just NewState
-
                    { newData = CollectingSignatures pmt (pk:pks)
-
                    , newValue = currentValue
-
                    , newConstraints = [Constraints.MustBeSignedBy pk]
+
            let constraints = Constraints.mustBeSignedBy pk in
+
            Just ( constraints
+
                 , State
+
                    { stateData = CollectingSignatures pmt (pk:pks)
+
                    , stateValue = currentValue
                    }
+
                 )
    (CollectingSignatures payment _, Cancel) ->
-
        Just NewState
-
                { newData = Holding
-
                , newValue = currentValue
-
                , newConstraints = [Constraints.MustValidateIn (Interval.from (paymentDeadline payment))]
+
        let constraints = Constraints.mustValidateIn (Interval.from (paymentDeadline payment)) in
+
        Just ( constraints
+
             , State
+
                { stateData = Holding
+
                , stateValue = currentValue
                }
+
             )
    (CollectingSignatures payment pkh, Pay)
        | proposalAccepted params pkh ->
            let Payment{paymentAmount, paymentRecipient, paymentDeadline} = payment
-
            in Just NewState
-
                        { newData = Holding
-
                        , newValue = currentValue - paymentAmount
-
                        , newConstraints = 
-
                            [ Constraints.MustValidateIn (Interval.to paymentDeadline)
-
                            , Constraints.MustPayToPubKey paymentRecipient paymentAmount
-
                            ]
+
                constraints =
+
                    Constraints.mustValidateIn (Interval.to paymentDeadline)
+
                    <> Constraints.mustPayToPubKey paymentRecipient paymentAmount
+
            in Just ( constraints
+
                    , State
+
                        { stateData = Holding
+
                        , stateValue = currentValue - paymentAmount
                        }
+
                    )
    _ -> Nothing

                      
{-# INLINABLE mkValidator #-}
validatorCode :: Params -> PlutusTx.CompiledCode (Scripts.ValidatorType MultiSigSym)
validatorCode params = $$(PlutusTx.compile [|| mkValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode params

                      
-
type MultiSigSym = StateMachine State Input
+
type MultiSigSym = StateMachine MSState Input

                      
scriptInstance :: Params -> Scripts.ScriptInstance MultiSigSym
scriptInstance params = Scripts.validator @MultiSigSym
    (validatorCode params)
    $$(PlutusTx.compile [|| wrap ||])
    where
-
        wrap = Scripts.wrapValidator @State @Input
+
        wrap = Scripts.wrapValidator @MSState @Input

                      
-
machineInstance :: Params -> SM.StateMachineInstance State Input
+
machineInstance :: Params -> SM.StateMachineInstance MSState Input
machineInstance params =
    SM.StateMachineInstance
    (SM.mkStateMachine (transition params) (const False))
    (scriptInstance params)

                      
-
client :: Params -> SM.StateMachineClient State Input
+
client :: Params -> SM.StateMachineClient MSState Input
client p = SM.mkStateMachineClient (machineInstance p)

                      
contract ::
    ( AsContractError e
-
    , AsSMContractError e State Input
+
    , AsSMContractError e MSState Input
    )
    => Params
    -> Contract MultiSigSchema e ()

                      
PlutusTx.makeIsData ''Payment
PlutusTx.makeLift ''Payment
-
PlutusTx.makeIsData ''State
-
PlutusTx.makeLift ''State
+
PlutusTx.makeIsData ''MSState
+
PlutusTx.makeLift ''MSState
PlutusTx.makeLift ''Params
PlutusTx.makeIsData ''Input
PlutusTx.makeLift ''Input

                      
import           Language.Plutus.Contract     as Contract
import qualified Ledger.Constraints           as Constraints
-
import           Ledger.Constraints.OffChain  (scriptLookups)

                      
mkValidator :: PubKeyHash -> () -> () -> PendingTx -> Bool
mkValidator pk' _ _ p = V.txSignedBy p pk'
        address = Scripts.scriptAddress inst
        tx = Constraints.mustPayToScript () vl
        
-
    tid <- submitTxConstraintsWith (scriptLookups inst) tx
+
    tid <- submitTxConstraints inst tx

                      
    ledgerTx <- awaitTransactionConfirmed address tid
    let output = Map.toList
    => Scripts.ScriptInstance TokenAccount
    -> Value
    -> Contract s e TxId
-
pay inst = submitTxConstraintsWith (Constraints.scriptLookups inst) . payTx
+
pay inst = submitTxConstraints inst . payTx

                      
-- | Create a transaction that spends all outputs belonging to the 'Account'.
redeemTx
import           Language.PlutusTx.Prelude    hiding (Semigroup(..), fold)
import qualified Language.PlutusTx            as PlutusTx
import Ledger.Constraints (TxConstraints, mustPayToScript, mustValidateIn, mustBeSignedBy)
-
import Ledger.Constraints.OffChain (scriptLookups, ScriptLookups(..))
import           Ledger                       (Address, Slot(..), PubKeyHash (..), Validator)
import qualified Ledger.Interval              as Interval
import qualified Ledger.Slot                  as Slot
    -> Contract s T.Text ()
vestFundsC vesting = do
    let tx = payIntoContract (totalAmount vesting)
-
        lookups = scriptLookups (scriptInstance vesting)
-
    void $ submitTxConstraintsWith lookups tx
+
    void $ submitTxConstraints (scriptInstance vesting) tx

                      
data Liveness = Alive | Dead

                      
                -- we don't need to add a pubkey output for 'vestingOwner' here
                -- because this will be done by the wallet when it balances the
                -- transaction.
-
        lookups = (scriptLookups inst) { slTxOutputs =  unspentOutputs }
-
    void $ submitTxConstraintsWith lookups tx
+
    void $ submitTxConstraintsUtxo inst unspentOutputs tx
    return liveness

                      
    , Lib.goldenPir "test/Spec/future.pir" $$(PlutusTx.compile [|| F.futureStateMachine ||])

                      
-
    , HUnit.testCase "script size is reasonable" (Lib.reasonable (F.validator theFuture accounts) 54000)
+
    , HUnit.testCase "script size is reasonable" (Lib.reasonable (F.validator theFuture accounts) 56000)

                      
    ]

                      

                      
makeLensesFor [("cpsUnbalancedTx", "unbalancedTx"), ("cpsValueSpentActual", "valueSpentActual"), ("cpsValueSpentRequired", "valueSpentRequired")] ''ConstraintProcessingState

                      
-
-- | Turn a 'ConstraintsWithScripts a' value into a transaction that can be submitted
-
--   to the ledger, by adding all the right inputs and outputs
+
-- | Turn a 'TxConstraints' value into an unbalanced transaction that satisfies
+
--   the constraints
mkTx
    :: ( IsData (DataType a)
       , IsData (RedeemerType a))
{-# INLINABLE never #-}
-- | An 'Interval' that is empty.
never :: Interval a
-
never = Interval (LowerBound NegInf True) (UpperBound PosInf True) :: Interval a
+
never = Interval (LowerBound PosInf True) (UpperBound NegInf True)

                      
{-# INLINABLE member #-}
-- | Check whether a value is in an interval.
+
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE NoImplicitPrelude #-}
  , signObservation
  ) where

                      
-
import qualified Data.ByteString.Lazy        as BSL
-
import           GHC.Generics                (Generic)
+
import qualified Data.ByteString.Lazy       as BSL
+
import           GHC.Generics               (Generic)

                      
import           Language.PlutusTx
import           Language.PlutusTx.Prelude

                      
-
import           Ledger.Constraints          (TxConstraint)
-
import qualified Ledger.Constraints          as Constraints
-
import qualified Ledger.Constraints.OnChain  as Constraints
-
import           Ledger.Crypto               (PrivateKey, PubKey (..), Signature (..))
-
import qualified Ledger.Crypto               as Crypto
-
import           Ledger.Scripts              (DataValue (..), DataValueHash (..))
-
import qualified Ledger.Scripts              as Scripts
-
import           Ledger.Slot                 (Slot)
-
import           Ledger.Validation           (PendingTx)
+
import           Ledger.Constraints         (TxConstraints)
+
import qualified Ledger.Constraints         as Constraints
+
import           Ledger.Crypto              (PrivateKey, PubKey (..), Signature (..))
+
import qualified Ledger.Crypto              as Crypto
+
import           Ledger.Scripts             (DataValue (..), DataValueHash (..))
+
import qualified Ledger.Scripts             as Scripts
+
import           Ledger.Slot                (Slot)
+
import           Ledger.Validation          (PendingTx)
import           LedgerBytes

                      
-
import qualified Prelude                     as Haskell
+
import qualified Prelude                    as Haskell

                      
-- $oracles
-- This module provides a way to verify signed messages, and a type for
    ( IsData a )
    => SignedMessage a
    -- ^ The signed message
-
    -> Either SignedMessageCheckError (a, TxConstraint)
+
    -> Either SignedMessageCheckError (a, TxConstraints i o)
checkHashConstraints SignedMessage{osmMessageHash, osmData=DataValue dt} =
    maybe
        (traceH "DecodingError" $ Left DecodingError)
-
        (\a -> pure (a, Constraints.MustHashDataValue osmMessageHash (DataValue dt)))
+
        (\a -> pure (a, Constraints.mustHashDataValue osmMessageHash (DataValue dt)))
        (fromData dt)

                      
{-# INLINABLE verifySignedMessageConstraints #-}
    ( IsData a)
    => PubKey
    -> SignedMessage a
-
    -> Either SignedMessageCheckError (a, TxConstraint)
+
    -> Either SignedMessageCheckError (a, TxConstraints i o)
verifySignedMessageConstraints pk [email protected]{osmSignature, osmMessageHash} =
    checkSignature osmMessageHash pk osmSignature
    >> checkHashConstraints s
    -> Either SignedMessageCheckError a
verifySignedMessageOnChain ptx pk [email protected]{osmSignature, osmMessageHash} = do
    checkSignature osmMessageHash pk osmSignature
-
    (a, constraint) <- checkHashConstraints s
-
    unless (Constraints.checkTxConstraint ptx constraint)
+
    (a, constraints) <- checkHashConstraints s
+
    unless (Constraints.checkPendingTx @() @() constraints ptx)
        (Left $ DataValueMissing osmMessageHash)
    pure a

                      
                ]
            txid = txId t
        in nest 2 $ vsep ["Tx" <+> pretty txid <> colon, braces (vsep lines')]
-
        -- FIXME: pretty forge?

                      
instance Semigroup Tx where
    tx1 <> tx2 = Tx {
    , ValidatorType
    , WrappedValidatorType
    , WrappedMonetaryPolicyType
-
    , TypedValidatorHash
-
    , untypedHash
    , fromValidator
    , Any
    ) where

                      
import           Data.Aeson                      (FromJSON, ToJSON)
import           Data.Kind
-
import           Data.Text.Prettyprint.Doc
import           GHC.Generics                    (Generic)
import           Ledger.Typed.Scripts.Validators

                      
-
-- | Validator hash with a phantom type
-
newtype TypedValidatorHash (h :: Type) = TypedValidatorHash { unTypedValidatorHash :: ValidatorHash }
-
    deriving (Eq, Generic)
-
    deriving newtype (ToJSON, FromJSON, Pretty)
-

                      
-- | A typed validator script with its 'ValidatorScript' and 'Address'.
data ScriptInstance (a :: Type) =
    Validator
        { instanceScript  :: Validator
-
        , instanceHash    :: TypedValidatorHash a
+
        , instanceHash    :: ValidatorHash
        , instanceMPSHash :: MonetaryPolicyHash
        -- ^ The hash of the monetary policy that checks whether the validator
        --   is run in this transaction
    -> ScriptInstance a
validator vc wrapper =
    let val = mkValidatorScript $ wrapper `applyCode` vc
-
        hsh = TypedValidatorHash $ validatorHash val
-
        mps = mkMonetaryPolicy (untypedHash hsh)
+
        hsh = validatorHash val
+
        mps = mkMonetaryPolicy hsh
    in Validator
        { instanceScript  = val
-
        , instanceHash    = TypedValidatorHash $ validatorHash val
+
        , instanceHash    = hsh
        , instanceMPS     = mps
        , instanceMPSHash = Ledger.Scripts.monetaryPolicyHash mps
        }

                      
-
-- | Get the typed validator hash for a script instance.
-
scriptHash :: ScriptInstance a -> TypedValidatorHash a
+
-- | The script's 'ValidatorHash'
+
scriptHash :: ScriptInstance a -> ValidatorHash
scriptHash = instanceHash

                      
-
-- | The untyped 'ValidatorHash'
-
untypedHash :: TypedValidatorHash a -> ValidatorHash
-
untypedHash = unTypedValidatorHash
-

                      
-- | Get the address for a script instance.
scriptAddress :: ScriptInstance a -> Addr.Address
-
scriptAddress = Addr.scriptHashAddress . unTypedValidatorHash . scriptHash
+
scriptAddress = Addr.scriptHashAddress . scriptHash

                      
-- | Get the validator script for a script instance.
validatorScript :: ScriptInstance a -> Validator
    in
    Validator
        { instanceScript  = vl
-
        , instanceHash    = TypedValidatorHash vh
+
        , instanceHash    = vh
        , instanceMPS     = mps
        , instanceMPSHash = Ledger.Scripts.monetaryPolicyHash mps
        }
module Language.PlutusTx.StateMachine(
      StateMachine(..)
    , StateMachineInstance (..)
-
    , OldState(..)
-
    , NewState(..)
+
    , State(..)
    , mkStateMachine
    , machineAddress
    , mkValidator
    ) where

                      
+
import Data.Void (Void)
+

                      
import qualified Language.PlutusTx                as PlutusTx
import           Language.PlutusTx.Prelude        hiding (check)
import           Ledger.Constraints
                                                   PendingTxIn' (pendingTxInValue))
import           Ledger.Value                     (isZero)

                      
-
data OldState s = OldState { oldData :: s, oldValue :: Value }
-
data NewState s = NewState { newData :: s, newValue :: Value, newConstraints :: [TxConstraint] }
+
data State s = State { stateData :: s, stateValue :: Value }

                      
-- | Specification of a state machine, consisting of a transition function that determines the
-- next state from the current state and an input, and a checking function that checks the validity
-- of the transition in the context of the current transaction.
data StateMachine s i = StateMachine {
      -- | The transition function of the state machine. 'Nothing' indicates an invalid transition from the current state.
-
      smTransition :: OldState s -> i -> Maybe (NewState s),
+
      smTransition :: State s -> i -> Maybe (TxConstraints Void Void, State s),

                      
      -- | Check whether a state is the final state
      smFinal      :: s -> Bool,
-- | A state machine that does not perform any additional checks on the
--   'PendingTx' (beyond enforcing the constraints)
mkStateMachine
-
    :: (OldState s -> i -> Maybe (NewState s))
+
    :: (State s -> i -> Maybe (TxConstraints Void Void, State s))
    -> (s -> Bool)
    -> StateMachine s i
mkStateMachine transition final =
mkValidator (StateMachine step isFinal check) currentState input ptx =
    let vl = pendingTxInValue (pendingTxItem ptx)
        checkOk = traceIfFalseH "State transition invalid - checks failed" (check currentState input ptx)
-
        oldState = OldState{oldData=currentState, oldValue=vl}
+
        oldState = State{stateData=currentState, stateValue=vl}
        stateAndOutputsOk = case step oldState input of
-
            Just (NewState{newData, newValue, newConstraints})
+
            Just (newConstraints, State{stateData=newData, stateValue=newValue})
                | isFinal newData ->
-
                    let txc = mempty {txConstraints=newConstraints} in
                    traceIfFalseH "Non-zero value allocated in final state" (isZero newValue)
-
                    && traceIfFalseH "State transition invalid - constraints not satisfied by PendingTx" (checkPendingTx @i @s txc ptx)
+
                    && traceIfFalseH "State transition invalid - constraints not satisfied by PendingTx" (checkPendingTx newConstraints ptx)
                | otherwise ->
                    let txc = 
-
                            TxConstraints
-
                                { txConstraints=newConstraints
-
                                , txOwnOutputs=
+
                            newConstraints
+
                                { txOwnOutputs=
                                    [ OutputConstraint{ocData=newData, ocValue= newValue} ]
-
                                , txOwnInputs=[]
                                }
-
                    in traceIfFalseH "State transition invalid - constraints not satisfied by PendingTx" (checkPendingTx @i @s txc ptx)
+
                    in traceIfFalseH "State transition invalid - constraints not satisfied by PendingTx" (checkPendingTx @_ @s txc ptx)
            Nothing -> traceH "State transition invalid - input is not a valid transition at the current state" False
    in checkOk && stateAndOutputsOk