{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NoImplicitPrelude  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE TypeOperators      #-}
-- | Two sample that unlock some funds by presenting the credentials.
--   * 'subscribeSTO' uses the credential to participate in an STO
--   * 'unlockExchange' uses the credential to take ownership of funds that
--     were locked by an exchange.
module Plutus.Contracts.Prism.Unlock(
    -- * STO
    STOSubscriber(..)
    , STOSubscriberSchema
    , subscribeSTO
    -- * Exchange
    , UnlockExchangeSchema
    , unlockExchange
    -- * Errors etc.
    , UnlockError(..)
    ) where

import Control.Lens (makeClassyPrisms)
import Control.Monad (forever)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Ledger.Address (PaymentPubKeyHash)
import Ledger.Tx (getCardanoTxId)
import Ledger.Tx.Constraints (ScriptLookups, SomeLookupsAndConstraints (..), TxConstraints (..))
import Ledger.Tx.Constraints qualified as Constraints
import Plutus.Contract
import Plutus.Contract.StateMachine (InvalidTransition, SMContractError, StateMachine, StateMachineTransition (..))
import Plutus.Contract.StateMachine qualified as SM
import Plutus.Contracts.Prism.Credential (Credential)
import Plutus.Contracts.Prism.Credential qualified as Credential
import Plutus.Contracts.Prism.STO (STOData (..))
import Plutus.Contracts.Prism.STO qualified as STO
import Plutus.Contracts.Prism.StateMachine (IDAction (PresentCredential), IDState, UserCredential (..))
import Plutus.Contracts.Prism.StateMachine qualified as StateMachine
import Plutus.Contracts.TokenAccount (TokenAccountError)
import Plutus.Contracts.TokenAccount qualified as TokenAccount
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.Value (TokenName)
import Prelude as Haskell

data STOSubscriber =
    STOSubscriber
        { STOSubscriber -> Credential
wCredential   :: Credential
        , STOSubscriber -> PaymentPubKeyHash
wSTOIssuer    :: PaymentPubKeyHash
        , STOSubscriber -> TokenName
wSTOTokenName :: TokenName
        , STOSubscriber -> Integer
wSTOAmount    :: Integer
        }
    deriving stock ((forall x. STOSubscriber -> Rep STOSubscriber x)
-> (forall x. Rep STOSubscriber x -> STOSubscriber)
-> Generic STOSubscriber
forall x. Rep STOSubscriber x -> STOSubscriber
forall x. STOSubscriber -> Rep STOSubscriber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep STOSubscriber x -> STOSubscriber
$cfrom :: forall x. STOSubscriber -> Rep STOSubscriber x
Generic, STOSubscriber -> STOSubscriber -> Bool
(STOSubscriber -> STOSubscriber -> Bool)
-> (STOSubscriber -> STOSubscriber -> Bool) -> Eq STOSubscriber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: STOSubscriber -> STOSubscriber -> Bool
$c/= :: STOSubscriber -> STOSubscriber -> Bool
== :: STOSubscriber -> STOSubscriber -> Bool
$c== :: STOSubscriber -> STOSubscriber -> Bool
Haskell.Eq, Int -> STOSubscriber -> ShowS
[STOSubscriber] -> ShowS
STOSubscriber -> String
(Int -> STOSubscriber -> ShowS)
-> (STOSubscriber -> String)
-> ([STOSubscriber] -> ShowS)
-> Show STOSubscriber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [STOSubscriber] -> ShowS
$cshowList :: [STOSubscriber] -> ShowS
show :: STOSubscriber -> String
$cshow :: STOSubscriber -> String
showsPrec :: Int -> STOSubscriber -> ShowS
$cshowsPrec :: Int -> STOSubscriber -> ShowS
Haskell.Show)
    deriving anyclass ([STOSubscriber] -> Encoding
[STOSubscriber] -> Value
STOSubscriber -> Encoding
STOSubscriber -> Value
(STOSubscriber -> Value)
-> (STOSubscriber -> Encoding)
-> ([STOSubscriber] -> Value)
-> ([STOSubscriber] -> Encoding)
-> ToJSON STOSubscriber
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [STOSubscriber] -> Encoding
$ctoEncodingList :: [STOSubscriber] -> Encoding
toJSONList :: [STOSubscriber] -> Value
$ctoJSONList :: [STOSubscriber] -> Value
toEncoding :: STOSubscriber -> Encoding
$ctoEncoding :: STOSubscriber -> Encoding
toJSON :: STOSubscriber -> Value
$ctoJSON :: STOSubscriber -> Value
ToJSON, Value -> Parser [STOSubscriber]
Value -> Parser STOSubscriber
(Value -> Parser STOSubscriber)
-> (Value -> Parser [STOSubscriber]) -> FromJSON STOSubscriber
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [STOSubscriber]
$cparseJSONList :: Value -> Parser [STOSubscriber]
parseJSON :: Value -> Parser STOSubscriber
$cparseJSON :: Value -> Parser STOSubscriber
FromJSON)

type STOSubscriberSchema = Endpoint "sto" STOSubscriber

-- | Obtain a token from the credential manager app,
--   then participate in the STO
subscribeSTO :: forall w s.
    ( HasEndpoint "sto" STOSubscriber s
    )
    => Contract w s UnlockError ()
subscribeSTO :: Contract w s UnlockError ()
subscribeSTO = Contract w s UnlockError () -> Contract w s UnlockError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Contract w s UnlockError () -> Contract w s UnlockError ())
-> Contract w s UnlockError () -> Contract w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ (UnlockError -> Contract w s UnlockError ())
-> Contract w s UnlockError () -> Contract w s UnlockError ()
forall w (s :: Row *) e e' a.
(e -> Contract w s e' a) -> Contract w s e a -> Contract w s e' a
handleError (Contract w s UnlockError ()
-> UnlockError -> Contract w s UnlockError ()
forall a b. a -> b -> a
const (Contract w s UnlockError ()
 -> UnlockError -> Contract w s UnlockError ())
-> Contract w s UnlockError ()
-> UnlockError
-> Contract w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ () -> Contract w s UnlockError ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Contract w s UnlockError () -> Contract w s UnlockError ())
-> Contract w s UnlockError () -> Contract w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ Promise w s UnlockError () -> Contract w s UnlockError ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise (Promise w s UnlockError () -> Contract w s UnlockError ())
-> Promise w s UnlockError () -> Contract w s UnlockError ()
forall a b. (a -> b) -> a -> b
$
    forall a w (s :: Row *) e b.
(HasEndpoint "sto" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"sto" ((STOSubscriber -> Contract w s UnlockError ())
 -> Promise w s UnlockError ())
-> (STOSubscriber -> Contract w s UnlockError ())
-> Promise w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ \STOSubscriber{Credential
wCredential :: Credential
wCredential :: STOSubscriber -> Credential
wCredential, PaymentPubKeyHash
wSTOIssuer :: PaymentPubKeyHash
wSTOIssuer :: STOSubscriber -> PaymentPubKeyHash
wSTOIssuer, TokenName
wSTOTokenName :: TokenName
wSTOTokenName :: STOSubscriber -> TokenName
wSTOTokenName, Integer
wSTOAmount :: Integer
wSTOAmount :: STOSubscriber -> Integer
wSTOAmount} -> do
        (TxConstraints IDAction IDState
credConstraints, ScriptLookups (StateMachine IDState IDAction)
credLookups) <- Credential
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
forall w (s :: Row *).
Credential
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
obtainCredentialTokenData Credential
wCredential
        let stoData :: STOData
stoData =
                STOData :: PaymentPubKeyHash -> TokenName -> Value -> STOData
STOData
                    { stoIssuer :: PaymentPubKeyHash
stoIssuer = PaymentPubKeyHash
wSTOIssuer
                    , stoTokenName :: TokenName
stoTokenName = TokenName
wSTOTokenName
                    , stoCredentialToken :: Value
stoCredentialToken = Credential -> Value
Credential.token Credential
wCredential
                    }
            stoCoins :: Value
stoCoins = STOData -> Integer -> Value
STO.coins STOData
stoData Integer
wSTOAmount
            constraints :: TxConstraints IDAction IDState
constraints =
                Value -> TxConstraints IDAction IDState
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue Value
stoCoins
                TxConstraints IDAction IDState
-> TxConstraints IDAction IDState -> TxConstraints IDAction IDState
forall a. Semigroup a => a -> a -> a
<> PaymentPubKeyHash -> Value -> TxConstraints IDAction IDState
forall i o. PaymentPubKeyHash -> Value -> TxConstraints i o
Constraints.mustPayToPubKey PaymentPubKeyHash
wSTOIssuer (Integer -> Value
Ada.lovelaceValueOf Integer
wSTOAmount)
                TxConstraints IDAction IDState
-> TxConstraints IDAction IDState -> TxConstraints IDAction IDState
forall a. Semigroup a => a -> a -> a
<> TxConstraints IDAction IDState
credConstraints
            lookups :: ScriptLookups (StateMachine IDState IDAction)
lookups =
                MintingPolicy -> ScriptLookups (StateMachine IDState IDAction)
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy (STOData -> MintingPolicy
STO.policy STOData
stoData)
                ScriptLookups (StateMachine IDState IDAction)
-> ScriptLookups (StateMachine IDState IDAction)
-> ScriptLookups (StateMachine IDState IDAction)
forall a. Semigroup a => a -> a -> a
<> ScriptLookups (StateMachine IDState IDAction)
credLookups
        (ContractError -> UnlockError)
-> Contract w s ContractError () -> Contract w s UnlockError ()
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError ContractError -> UnlockError
WithdrawTxError
            (Contract w s ContractError () -> Contract w s UnlockError ())
-> Contract w s ContractError () -> Contract w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ ScriptLookups (StateMachine IDState IDAction)
-> TxConstraints
     (RedeemerType (StateMachine IDState IDAction))
     (DatumType (StateMachine IDState IDAction))
-> Contract w s ContractError CardanoTx
forall a w (s :: Row *) e.
(ToData (RedeemerType a), FromData (DatumType a),
 ToData (DatumType a), AsContractError e) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> Contract w s e CardanoTx
submitTxConstraintsWith ScriptLookups (StateMachine IDState IDAction)
lookups TxConstraints
  (RedeemerType (StateMachine IDState IDAction))
  (DatumType (StateMachine IDState IDAction))
TxConstraints IDAction IDState
constraints Contract w s ContractError CardanoTx
-> (CardanoTx -> Contract w s ContractError ())
-> Contract w s ContractError ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxId -> Contract w s ContractError ()
forall w (s :: Row *) e.
AsContractError e =>
TxId -> Contract w s e ()
awaitTxConfirmed (TxId -> Contract w s ContractError ())
-> (CardanoTx -> TxId)
-> CardanoTx
-> Contract w s ContractError ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CardanoTx -> TxId
getCardanoTxId

type UnlockExchangeSchema = Endpoint "unlock from exchange" Credential

-- | Obtain a token from the credential manager app,
--   then use it to unlock funds that were locked by an exchange.
unlockExchange :: forall w s.
    ( HasEndpoint "unlock from exchange" Credential s
    )
    => Contract w s UnlockError ()
unlockExchange :: Contract w s UnlockError ()
unlockExchange = Promise w s UnlockError () -> Contract w s UnlockError ()
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise (Promise w s UnlockError () -> Contract w s UnlockError ())
-> Promise w s UnlockError () -> Contract w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ forall a w (s :: Row *) e b.
(HasEndpoint "unlock from exchange" a s, AsContractError e,
 FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"unlock from exchange" ((Credential -> Contract w s UnlockError ())
 -> Promise w s UnlockError ())
-> (Credential -> Contract w s UnlockError ())
-> Promise w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ \Credential
credential -> do
    CardanoAddress
ownAddr <- (ContractError -> UnlockError)
-> Contract w s ContractError CardanoAddress
-> Contract w s UnlockError CardanoAddress
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError ContractError -> UnlockError
WithdrawPkError Contract w s ContractError CardanoAddress
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e CardanoAddress
ownAddress
    (TxConstraints IDAction IDState
credConstraints, ScriptLookups (StateMachine IDState IDAction)
credLookups) <- Credential
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
forall w (s :: Row *).
Credential
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
obtainCredentialTokenData Credential
credential
    (TxConstraints () ()
accConstraints, ScriptLookups TokenAccount
accLookups) <-
        (TokenAccountError -> UnlockError)
-> Contract
     w
     s
     TokenAccountError
     (TxConstraints () (), ScriptLookups TokenAccount)
-> Contract
     w s UnlockError (TxConstraints () (), ScriptLookups TokenAccount)
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError TokenAccountError -> UnlockError
UnlockExchangeTokenAccError
        (Contract
   w
   s
   TokenAccountError
   (TxConstraints () (), ScriptLookups TokenAccount)
 -> Contract
      w s UnlockError (TxConstraints () (), ScriptLookups TokenAccount))
-> Contract
     w
     s
     TokenAccountError
     (TxConstraints () (), ScriptLookups TokenAccount)
-> Contract
     w s UnlockError (TxConstraints () (), ScriptLookups TokenAccount)
forall a b. (a -> b) -> a -> b
$ Account
-> CardanoAddress
-> Contract
     w
     s
     TokenAccountError
     (TxConstraints () (), ScriptLookups TokenAccount)
forall w (s :: Row *) e.
AsTokenAccountError e =>
Account
-> CardanoAddress
-> Contract w s e (TxConstraints () (), ScriptLookups TokenAccount)
TokenAccount.redeemTx (Credential -> Account
Credential.tokenAccount Credential
credential) CardanoAddress
ownAddr
    Params
params <- Contract w s UnlockError Params
forall w (s :: Row *) e. AsContractError e => Contract w s e Params
getParams
    case Params
-> [SomeLookupsAndConstraints] -> Either MkTxError UnbalancedTx
Constraints.mkSomeTx Params
params [ScriptLookups (StateMachine IDState IDAction)
-> TxConstraints
     (RedeemerType (StateMachine IDState IDAction))
     (DatumType (StateMachine IDState IDAction))
-> SomeLookupsAndConstraints
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> SomeLookupsAndConstraints
SomeLookupsAndConstraints ScriptLookups (StateMachine IDState IDAction)
credLookups TxConstraints
  (RedeemerType (StateMachine IDState IDAction))
  (DatumType (StateMachine IDState IDAction))
TxConstraints IDAction IDState
credConstraints, ScriptLookups TokenAccount
-> TxConstraints
     (RedeemerType TokenAccount) (DatumType TokenAccount)
-> SomeLookupsAndConstraints
forall a.
(FromData (DatumType a), ToData (DatumType a),
 ToData (RedeemerType a)) =>
ScriptLookups a
-> TxConstraints (RedeemerType a) (DatumType a)
-> SomeLookupsAndConstraints
SomeLookupsAndConstraints ScriptLookups TokenAccount
accLookups TxConstraints () ()
TxConstraints (RedeemerType TokenAccount) (DatumType TokenAccount)
accConstraints] of
        Left MkTxError
mkTxErr -> UnlockError -> Contract w s UnlockError ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (MkTxError -> UnlockError
UnlockMkTxError MkTxError
mkTxErr)
        Right UnbalancedTx
utx -> (ContractError -> UnlockError)
-> Contract w s ContractError () -> Contract w s UnlockError ()
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError ContractError -> UnlockError
WithdrawTxError (Contract w s ContractError () -> Contract w s UnlockError ())
-> Contract w s ContractError () -> Contract w s UnlockError ()
forall a b. (a -> b) -> a -> b
$ do
            CardanoTx
tx <- UnbalancedTx -> Contract w s ContractError CardanoTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e CardanoTx
submitUnbalancedTx UnbalancedTx
utx
            TxId -> Contract w s ContractError ()
forall w (s :: Row *) e.
AsContractError e =>
TxId -> Contract w s e ()
awaitTxConfirmed (CardanoTx -> TxId
getCardanoTxId CardanoTx
tx)

-- | Get the constraints and script lookups that are needed to construct a
--   transaction that presents the 'Credential'
obtainCredentialTokenData :: forall w s.
    Credential
    -> Contract w s UnlockError (TxConstraints IDAction IDState, ScriptLookups (StateMachine IDState IDAction))
obtainCredentialTokenData :: Credential
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
obtainCredentialTokenData Credential
credential = do
    -- credentialManager <- mapError WithdrawEndpointError $ endpoint @"credential manager"
    UserCredential
userCredential <- (ContractError -> UnlockError)
-> Contract w s ContractError UserCredential
-> Contract w s UnlockError UserCredential
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError ContractError -> UnlockError
WithdrawPkError (Contract w s ContractError UserCredential
 -> Contract w s UnlockError UserCredential)
-> Contract w s ContractError UserCredential
-> Contract w s UnlockError UserCredential
forall a b. (a -> b) -> a -> b
$
        PaymentPubKeyHash -> Credential -> Value -> UserCredential
UserCredential
            (PaymentPubKeyHash -> Credential -> Value -> UserCredential)
-> Contract w s ContractError PaymentPubKeyHash
-> Contract
     w s ContractError (Credential -> Value -> UserCredential)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Contract w s ContractError PaymentPubKeyHash
forall w (s :: Row *) e.
AsContractError e =>
Contract w s e PaymentPubKeyHash
ownFirstPaymentPubKeyHash
            Contract w s ContractError (Credential -> Value -> UserCredential)
-> Contract w s ContractError Credential
-> Contract w s ContractError (Value -> UserCredential)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Credential -> Contract w s ContractError Credential
forall (f :: * -> *) a. Applicative f => a -> f a
pure Credential
credential
            Contract w s ContractError (Value -> UserCredential)
-> Contract w s ContractError Value
-> Contract w s ContractError UserCredential
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Contract w s ContractError Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Credential -> Value
Credential.token Credential
credential)

    -- Calls the 'PresentCredential' step on the state machine instance and returns the constraints
    -- needed to construct a transaction that presents the token.
    let theClient :: StateMachineClient IDState IDAction
theClient = TypedValidator (StateMachine IDState IDAction)
-> UserCredential -> StateMachineClient IDState IDAction
StateMachine.machineClient (UserCredential -> TypedValidator (StateMachine IDState IDAction)
StateMachine.typedValidator UserCredential
userCredential) UserCredential
userCredential
    Either
  (InvalidTransition IDState IDAction)
  (StateMachineTransition IDState IDAction)
t <- (SMContractError -> UnlockError)
-> Contract
     w
     s
     SMContractError
     (Either
        (InvalidTransition IDState IDAction)
        (StateMachineTransition IDState IDAction))
-> Contract
     w
     s
     UnlockError
     (Either
        (InvalidTransition IDState IDAction)
        (StateMachineTransition IDState IDAction))
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError SMContractError -> UnlockError
GetCredentialStateMachineError (Contract
   w
   s
   SMContractError
   (Either
      (InvalidTransition IDState IDAction)
      (StateMachineTransition IDState IDAction))
 -> Contract
      w
      s
      UnlockError
      (Either
         (InvalidTransition IDState IDAction)
         (StateMachineTransition IDState IDAction)))
-> Contract
     w
     s
     SMContractError
     (Either
        (InvalidTransition IDState IDAction)
        (StateMachineTransition IDState IDAction))
-> Contract
     w
     s
     UnlockError
     (Either
        (InvalidTransition IDState IDAction)
        (StateMachineTransition IDState IDAction))
forall a b. (a -> b) -> a -> b
$ StateMachineClient IDState IDAction
-> IDAction
-> Contract
     w
     s
     SMContractError
     (Either
        (InvalidTransition IDState IDAction)
        (StateMachineTransition IDState IDAction))
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state) =>
StateMachineClient state input
-> input
-> Contract
     w
     schema
     e
     (Either
        (InvalidTransition state input)
        (StateMachineTransition state input))
SM.mkStep StateMachineClient IDState IDAction
theClient IDAction
PresentCredential
    case Either
  (InvalidTransition IDState IDAction)
  (StateMachineTransition IDState IDAction)
t of
        Left InvalidTransition IDState IDAction
e -> UnlockError
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (UnlockError
 -> Contract
      w
      s
      UnlockError
      (TxConstraints IDAction IDState,
       ScriptLookups (StateMachine IDState IDAction)))
-> UnlockError
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
forall a b. (a -> b) -> a -> b
$ InvalidTransition IDState IDAction -> UnlockError
GetCredentialTransitionError InvalidTransition IDState IDAction
e
        Right StateMachineTransition{smtConstraints :: forall state input.
StateMachineTransition state input -> TxConstraints input state
smtConstraints=TxConstraints IDAction IDState
cons, smtLookups :: forall state input.
StateMachineTransition state input
-> ScriptLookups (StateMachine state input)
smtLookups=ScriptLookups (StateMachine IDState IDAction)
lookups} ->
            (TxConstraints IDAction IDState,
 ScriptLookups (StateMachine IDState IDAction))
-> Contract
     w
     s
     UnlockError
     (TxConstraints IDAction IDState,
      ScriptLookups (StateMachine IDState IDAction))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxConstraints IDAction IDState
cons, ScriptLookups (StateMachine IDState IDAction)
lookups)

---
-- logs / error
---

data UnlockError =
    WithdrawEndpointError ContractError
    | WithdrawTxError ContractError
    | WithdrawPkError ContractError
    | GetCredentialStateMachineError SMContractError
    | GetCredentialTransitionError (InvalidTransition IDState IDAction)
    | UnlockExchangeTokenAccError TokenAccountError
    | UnlockMkTxError Constraints.MkTxError
    deriving stock ((forall x. UnlockError -> Rep UnlockError x)
-> (forall x. Rep UnlockError x -> UnlockError)
-> Generic UnlockError
forall x. Rep UnlockError x -> UnlockError
forall x. UnlockError -> Rep UnlockError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UnlockError x -> UnlockError
$cfrom :: forall x. UnlockError -> Rep UnlockError x
Generic, UnlockError -> UnlockError -> Bool
(UnlockError -> UnlockError -> Bool)
-> (UnlockError -> UnlockError -> Bool) -> Eq UnlockError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnlockError -> UnlockError -> Bool
$c/= :: UnlockError -> UnlockError -> Bool
== :: UnlockError -> UnlockError -> Bool
$c== :: UnlockError -> UnlockError -> Bool
Haskell.Eq, Int -> UnlockError -> ShowS
[UnlockError] -> ShowS
UnlockError -> String
(Int -> UnlockError -> ShowS)
-> (UnlockError -> String)
-> ([UnlockError] -> ShowS)
-> Show UnlockError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnlockError] -> ShowS
$cshowList :: [UnlockError] -> ShowS
show :: UnlockError -> String
$cshow :: UnlockError -> String
showsPrec :: Int -> UnlockError -> ShowS
$cshowsPrec :: Int -> UnlockError -> ShowS
Haskell.Show)
    deriving anyclass ([UnlockError] -> Encoding
[UnlockError] -> Value
UnlockError -> Encoding
UnlockError -> Value
(UnlockError -> Value)
-> (UnlockError -> Encoding)
-> ([UnlockError] -> Value)
-> ([UnlockError] -> Encoding)
-> ToJSON UnlockError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UnlockError] -> Encoding
$ctoEncodingList :: [UnlockError] -> Encoding
toJSONList :: [UnlockError] -> Value
$ctoJSONList :: [UnlockError] -> Value
toEncoding :: UnlockError -> Encoding
$ctoEncoding :: UnlockError -> Encoding
toJSON :: UnlockError -> Value
$ctoJSON :: UnlockError -> Value
ToJSON, Value -> Parser [UnlockError]
Value -> Parser UnlockError
(Value -> Parser UnlockError)
-> (Value -> Parser [UnlockError]) -> FromJSON UnlockError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UnlockError]
$cparseJSONList :: Value -> Parser [UnlockError]
parseJSON :: Value -> Parser UnlockError
$cparseJSON :: Value -> Parser UnlockError
FromJSON)

makeClassyPrisms ''UnlockError

instance AsContractError UnlockError where
    _ContractError :: p ContractError (f ContractError) -> p UnlockError (f UnlockError)
_ContractError = p ContractError (f ContractError) -> p UnlockError (f UnlockError)
forall r. AsUnlockError r => Prism' r ContractError
_WithdrawEndpointError (p ContractError (f ContractError)
 -> p UnlockError (f UnlockError))
-> (p ContractError (f ContractError)
    -> p ContractError (f ContractError))
-> p ContractError (f ContractError)
-> p UnlockError (f UnlockError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ContractError (f ContractError)
-> p ContractError (f ContractError)
forall r. AsContractError r => Prism' r ContractError
_ContractError