{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE TypeOperators      #-}
-- | The Atala Mirror application that initialises the state machine
module Plutus.Contracts.Prism.Mirror(
    MirrorSchema
    , CredentialOwnerReference(..)
    , MirrorError(..)
    , mirror
    ) where

import Control.Lens
import Control.Monad (forever, void)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Ledger.Address (PaymentPubKeyHash)
import Ledger.Tx.Constraints qualified as Constraints
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract
import Plutus.Contract.StateMachine (AsSMContractError (..), SMContractError, StateMachineTransition (..))
import Plutus.Contract.StateMachine qualified as SM
import Plutus.Contracts.Prism.Credential (Credential (..), CredentialAuthority (..))
import Plutus.Contracts.Prism.Credential qualified as Credential
import Plutus.Contracts.Prism.StateMachine as StateMachine
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.Value (TokenName)
import Wallet.Emulator (mockWalletPaymentPubKeyHash)
import Wallet.Emulator.Wallet (Wallet)

-- | Reference to a credential tied to a specific owner (public key address).
--   From this, and the public key of the Mirror instance, we can compute the
--   address of the state machine script that locks the token for the owner.
data CredentialOwnerReference =
    CredentialOwnerReference
        { CredentialOwnerReference -> TokenName
coTokenName :: TokenName
        , CredentialOwnerReference -> Wallet
coOwner     :: Wallet
        }
    deriving stock ((forall x.
 CredentialOwnerReference -> Rep CredentialOwnerReference x)
-> (forall x.
    Rep CredentialOwnerReference x -> CredentialOwnerReference)
-> Generic CredentialOwnerReference
forall x.
Rep CredentialOwnerReference x -> CredentialOwnerReference
forall x.
CredentialOwnerReference -> Rep CredentialOwnerReference x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CredentialOwnerReference x -> CredentialOwnerReference
$cfrom :: forall x.
CredentialOwnerReference -> Rep CredentialOwnerReference x
Generic, CredentialOwnerReference -> CredentialOwnerReference -> Bool
(CredentialOwnerReference -> CredentialOwnerReference -> Bool)
-> (CredentialOwnerReference -> CredentialOwnerReference -> Bool)
-> Eq CredentialOwnerReference
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
$c/= :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
== :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
$c== :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
Eq, Int -> CredentialOwnerReference -> ShowS
[CredentialOwnerReference] -> ShowS
CredentialOwnerReference -> String
(Int -> CredentialOwnerReference -> ShowS)
-> (CredentialOwnerReference -> String)
-> ([CredentialOwnerReference] -> ShowS)
-> Show CredentialOwnerReference
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CredentialOwnerReference] -> ShowS
$cshowList :: [CredentialOwnerReference] -> ShowS
show :: CredentialOwnerReference -> String
$cshow :: CredentialOwnerReference -> String
showsPrec :: Int -> CredentialOwnerReference -> ShowS
$cshowsPrec :: Int -> CredentialOwnerReference -> ShowS
Show, Eq CredentialOwnerReference
Eq CredentialOwnerReference
-> (CredentialOwnerReference
    -> CredentialOwnerReference -> Ordering)
-> (CredentialOwnerReference -> CredentialOwnerReference -> Bool)
-> (CredentialOwnerReference -> CredentialOwnerReference -> Bool)
-> (CredentialOwnerReference -> CredentialOwnerReference -> Bool)
-> (CredentialOwnerReference -> CredentialOwnerReference -> Bool)
-> (CredentialOwnerReference
    -> CredentialOwnerReference -> CredentialOwnerReference)
-> (CredentialOwnerReference
    -> CredentialOwnerReference -> CredentialOwnerReference)
-> Ord CredentialOwnerReference
CredentialOwnerReference -> CredentialOwnerReference -> Bool
CredentialOwnerReference -> CredentialOwnerReference -> Ordering
CredentialOwnerReference
-> CredentialOwnerReference -> CredentialOwnerReference
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CredentialOwnerReference
-> CredentialOwnerReference -> CredentialOwnerReference
$cmin :: CredentialOwnerReference
-> CredentialOwnerReference -> CredentialOwnerReference
max :: CredentialOwnerReference
-> CredentialOwnerReference -> CredentialOwnerReference
$cmax :: CredentialOwnerReference
-> CredentialOwnerReference -> CredentialOwnerReference
>= :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
$c>= :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
> :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
$c> :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
<= :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
$c<= :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
< :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
$c< :: CredentialOwnerReference -> CredentialOwnerReference -> Bool
compare :: CredentialOwnerReference -> CredentialOwnerReference -> Ordering
$ccompare :: CredentialOwnerReference -> CredentialOwnerReference -> Ordering
$cp1Ord :: Eq CredentialOwnerReference
Ord)
    deriving anyclass ([CredentialOwnerReference] -> Encoding
[CredentialOwnerReference] -> Value
CredentialOwnerReference -> Encoding
CredentialOwnerReference -> Value
(CredentialOwnerReference -> Value)
-> (CredentialOwnerReference -> Encoding)
-> ([CredentialOwnerReference] -> Value)
-> ([CredentialOwnerReference] -> Encoding)
-> ToJSON CredentialOwnerReference
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [CredentialOwnerReference] -> Encoding
$ctoEncodingList :: [CredentialOwnerReference] -> Encoding
toJSONList :: [CredentialOwnerReference] -> Value
$ctoJSONList :: [CredentialOwnerReference] -> Value
toEncoding :: CredentialOwnerReference -> Encoding
$ctoEncoding :: CredentialOwnerReference -> Encoding
toJSON :: CredentialOwnerReference -> Value
$ctoJSON :: CredentialOwnerReference -> Value
ToJSON, Value -> Parser [CredentialOwnerReference]
Value -> Parser CredentialOwnerReference
(Value -> Parser CredentialOwnerReference)
-> (Value -> Parser [CredentialOwnerReference])
-> FromJSON CredentialOwnerReference
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [CredentialOwnerReference]
$cparseJSONList :: Value -> Parser [CredentialOwnerReference]
parseJSON :: Value -> Parser CredentialOwnerReference
$cparseJSON :: Value -> Parser CredentialOwnerReference
FromJSON)

type MirrorSchema =
        Endpoint "issue" CredentialOwnerReference -- lock a single credential token in a state machine tied to the credential token owner
        .\/ Endpoint "revoke" CredentialOwnerReference -- revoke a credential token token from its owner by calling 'Revoke' on the state machine instance

mirror ::
    ( HasEndpoint "revoke" CredentialOwnerReference s
    , HasEndpoint "issue" CredentialOwnerReference s
    )
    => Contract w s MirrorError ()
mirror :: Contract w s MirrorError ()
mirror = do
    String -> Contract w s MirrorError ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @String String
"mirror started"
    CredentialAuthority
authority <- (ContractError -> MirrorError)
-> Contract w s ContractError CredentialAuthority
-> Contract w s MirrorError CredentialAuthority
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError ContractError -> MirrorError
SetupError (Contract w s ContractError CredentialAuthority
 -> Contract w s MirrorError CredentialAuthority)
-> Contract w s ContractError CredentialAuthority
-> Contract w s MirrorError CredentialAuthority
forall a b. (a -> b) -> a -> b
$ PaymentPubKeyHash -> CredentialAuthority
CredentialAuthority (PaymentPubKeyHash -> CredentialAuthority)
-> Contract w s ContractError PaymentPubKeyHash
-> Contract w s ContractError CredentialAuthority
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 MirrorError () -> Contract w s MirrorError ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Contract w s MirrorError () -> Contract w s MirrorError ())
-> Contract w s MirrorError () -> Contract w s MirrorError ()
forall a b. (a -> b) -> a -> b
$ do
        String -> Contract w s MirrorError ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @String String
"waiting for 'issue' call"
        [Promise w s MirrorError ()] -> Contract w s MirrorError ()
forall w (s :: Row *) e a. [Promise w s e a] -> Contract w s e a
selectList [CredentialAuthority -> Promise w s MirrorError ()
forall (s :: Row *) w.
HasEndpoint "issue" CredentialOwnerReference s =>
CredentialAuthority -> Promise w s MirrorError ()
createTokens CredentialAuthority
authority, CredentialAuthority -> Promise w s MirrorError ()
forall (s :: Row *) w.
HasEndpoint "revoke" CredentialOwnerReference s =>
CredentialAuthority -> Promise w s MirrorError ()
revokeToken CredentialAuthority
authority]

createTokens ::
    ( HasEndpoint "issue" CredentialOwnerReference s
    )
    => CredentialAuthority
    -> Promise w s MirrorError ()
createTokens :: CredentialAuthority -> Promise w s MirrorError ()
createTokens CredentialAuthority
authority = forall a w (s :: Row *) e b.
(HasEndpoint "issue" 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 @"issue" ((CredentialOwnerReference -> Contract w s MirrorError ())
 -> Promise w s MirrorError ())
-> (CredentialOwnerReference -> Contract w s MirrorError ())
-> Promise w s MirrorError ()
forall a b. (a -> b) -> a -> b
$ \CredentialOwnerReference{TokenName
coTokenName :: TokenName
coTokenName :: CredentialOwnerReference -> TokenName
coTokenName, Wallet
coOwner :: Wallet
coOwner :: CredentialOwnerReference -> Wallet
coOwner} -> do
    String -> Contract w s MirrorError ()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @String String
"Endpoint 'issue' called"
    let pk :: PaymentPubKeyHash
pk      = CredentialAuthority -> PaymentPubKeyHash
Credential.unCredentialAuthority CredentialAuthority
authority
        lookups :: ScriptLookups Any
lookups = MintingPolicy -> ScriptLookups Any
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy (CredentialAuthority -> MintingPolicy
Credential.policy CredentialAuthority
authority)
        theToken :: Value
theToken = Credential -> Value
Credential.token Credential :: CredentialAuthority -> TokenName -> Credential
Credential{credAuthority :: CredentialAuthority
credAuthority=CredentialAuthority
authority,credName :: TokenName
credName=TokenName
coTokenName}
        constraints :: TxConstraints BuiltinData BuiltinData
constraints =
            Value -> TxConstraints BuiltinData BuiltinData
forall i o. Value -> TxConstraints i o
Constraints.mustMintValue Value
theToken
            TxConstraints BuiltinData BuiltinData
-> TxConstraints BuiltinData BuiltinData
-> TxConstraints BuiltinData BuiltinData
forall a. Semigroup a => a -> a -> a
<> PaymentPubKeyHash -> TxConstraints BuiltinData BuiltinData
forall i o. PaymentPubKeyHash -> TxConstraints i o
Constraints.mustBeSignedBy PaymentPubKeyHash
pk
            TxConstraints BuiltinData BuiltinData
-> TxConstraints BuiltinData BuiltinData
-> TxConstraints BuiltinData BuiltinData
forall a. Semigroup a => a -> a -> a
<> PaymentPubKeyHash -> Value -> TxConstraints BuiltinData BuiltinData
forall i o. PaymentPubKeyHash -> Value -> TxConstraints i o
Constraints.mustPayToPubKey PaymentPubKeyHash
pk (Integer -> Value
Ada.lovelaceValueOf Integer
1)   -- Add self-spend to force an input
    ()
_ <- (ContractError -> MirrorError)
-> Contract w s ContractError () -> Contract w s MirrorError ()
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError ContractError -> MirrorError
CreateTokenTxError (Contract w s ContractError () -> Contract w s MirrorError ())
-> Contract w s ContractError () -> Contract w s MirrorError ()
forall a b. (a -> b) -> a -> b
$ do
            ScriptLookups Any
-> TxConstraints (RedeemerType Any) (DatumType Any)
-> Contract w s ContractError UnbalancedTx
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 UnbalancedTx
mkTxConstraints @Scripts.Any ScriptLookups Any
lookups TxConstraints (RedeemerType Any) (DatumType Any)
TxConstraints BuiltinData BuiltinData
constraints
              Contract w s ContractError UnbalancedTx
-> (UnbalancedTx -> Contract w s ContractError UnbalancedTx)
-> Contract w s ContractError UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s ContractError UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s ContractError UnbalancedTx
-> (UnbalancedTx -> Contract w s ContractError ())
-> Contract w s ContractError ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s ContractError ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed
    let stateMachine :: StateMachineClient IDState IDAction
stateMachine = CredentialAuthority
-> PaymentPubKeyHash
-> TokenName
-> StateMachineClient IDState IDAction
StateMachine.mkMachineClient CredentialAuthority
authority (Wallet -> PaymentPubKeyHash
mockWalletPaymentPubKeyHash Wallet
coOwner) TokenName
coTokenName
    Contract w s MirrorError IDState -> Contract w s MirrorError ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Contract w s MirrorError IDState -> Contract w s MirrorError ())
-> Contract w s MirrorError IDState -> Contract w s MirrorError ()
forall a b. (a -> b) -> a -> b
$ (SMContractError -> MirrorError)
-> Contract w s SMContractError IDState
-> Contract w s MirrorError IDState
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError SMContractError -> MirrorError
StateMachineError (Contract w s SMContractError IDState
 -> Contract w s MirrorError IDState)
-> Contract w s SMContractError IDState
-> Contract w s MirrorError IDState
forall a b. (a -> b) -> a -> b
$ StateMachineClient IDState IDAction
-> IDState -> Value -> Contract w s SMContractError IDState
forall w e state (schema :: Row *) input.
(FromData state, ToData state, ToData input,
 AsSMContractError e) =>
StateMachineClient state input
-> state -> Value -> Contract w schema e state
SM.runInitialise StateMachineClient IDState IDAction
stateMachine IDState
Active Value
theToken

revokeToken ::
    ( HasEndpoint "revoke" CredentialOwnerReference s
    )
    => CredentialAuthority
    -> Promise w s MirrorError ()
revokeToken :: CredentialAuthority -> Promise w s MirrorError ()
revokeToken CredentialAuthority
authority = forall a w (s :: Row *) e b.
(HasEndpoint "revoke" 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 @"revoke" ((CredentialOwnerReference -> Contract w s MirrorError ())
 -> Promise w s MirrorError ())
-> (CredentialOwnerReference -> Contract w s MirrorError ())
-> Promise w s MirrorError ()
forall a b. (a -> b) -> a -> b
$ \CredentialOwnerReference{TokenName
coTokenName :: TokenName
coTokenName :: CredentialOwnerReference -> TokenName
coTokenName, Wallet
coOwner :: Wallet
coOwner :: CredentialOwnerReference -> Wallet
coOwner} -> do
    let stateMachine :: StateMachineClient IDState IDAction
stateMachine = CredentialAuthority
-> PaymentPubKeyHash
-> TokenName
-> StateMachineClient IDState IDAction
StateMachine.mkMachineClient CredentialAuthority
authority (Wallet -> PaymentPubKeyHash
mockWalletPaymentPubKeyHash Wallet
coOwner) TokenName
coTokenName
        lookups :: ScriptLookups (StateMachine IDState IDAction)
lookups = MintingPolicy -> ScriptLookups (StateMachine IDState IDAction)
forall a. MintingPolicy -> ScriptLookups a
Constraints.plutusV2MintingPolicy (CredentialAuthority -> MintingPolicy
Credential.policy CredentialAuthority
authority)
    Either
  (InvalidTransition IDState IDAction)
  (StateMachineTransition IDState IDAction)
t <- (SMContractError -> MirrorError)
-> Contract
     w
     s
     SMContractError
     (Either
        (InvalidTransition IDState IDAction)
        (StateMachineTransition IDState IDAction))
-> Contract
     w
     s
     MirrorError
     (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 -> MirrorError
StateMachineError (Contract
   w
   s
   SMContractError
   (Either
      (InvalidTransition IDState IDAction)
      (StateMachineTransition IDState IDAction))
 -> Contract
      w
      s
      MirrorError
      (Either
         (InvalidTransition IDState IDAction)
         (StateMachineTransition IDState IDAction)))
-> Contract
     w
     s
     SMContractError
     (Either
        (InvalidTransition IDState IDAction)
        (StateMachineTransition IDState IDAction))
-> Contract
     w
     s
     MirrorError
     (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
stateMachine IDAction
RevokeCredential
    case Either
  (InvalidTransition IDState IDAction)
  (StateMachineTransition IDState IDAction)
t of
        Left{} -> () -> Contract w s MirrorError ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Ignore invalid transitions
        Right StateMachineTransition{smtConstraints :: forall state input.
StateMachineTransition state input -> TxConstraints input state
smtConstraints=TxConstraints IDAction IDState
constraints, smtLookups :: forall state input.
StateMachineTransition state input
-> ScriptLookups (StateMachine state input)
smtLookups=ScriptLookups (StateMachine IDState IDAction)
lookups'} -> do
            ScriptLookups (StateMachine IDState IDAction)
-> TxConstraints
     (RedeemerType (StateMachine IDState IDAction))
     (DatumType (StateMachine IDState IDAction))
-> Contract w s MirrorError UnbalancedTx
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 UnbalancedTx
mkTxConstraints (ScriptLookups (StateMachine IDState IDAction)
lookups ScriptLookups (StateMachine IDState IDAction)
-> ScriptLookups (StateMachine IDState IDAction)
-> ScriptLookups (StateMachine IDState IDAction)
forall a. Semigroup a => a -> a -> a
<> ScriptLookups (StateMachine IDState IDAction)
lookups') TxConstraints
  (RedeemerType (StateMachine IDState IDAction))
  (DatumType (StateMachine IDState IDAction))
TxConstraints IDAction IDState
constraints
              Contract w s MirrorError UnbalancedTx
-> (UnbalancedTx -> Contract w s MirrorError UnbalancedTx)
-> Contract w s MirrorError UnbalancedTx
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s MirrorError UnbalancedTx
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e UnbalancedTx
adjustUnbalancedTx Contract w s MirrorError UnbalancedTx
-> (UnbalancedTx -> Contract w s MirrorError ())
-> Contract w s MirrorError ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UnbalancedTx -> Contract w s MirrorError ()
forall w (s :: Row *) e.
AsContractError e =>
UnbalancedTx -> Contract w s e ()
submitTxConfirmed

---
-- Errors and Logging
---

data MirrorError =
    StateNotFound TokenName PaymentPubKeyHash
    | SetupError ContractError
    | MirrorEndpointError ContractError
    | CreateTokenTxError ContractError
    | StateMachineError SMContractError
    deriving stock (MirrorError -> MirrorError -> Bool
(MirrorError -> MirrorError -> Bool)
-> (MirrorError -> MirrorError -> Bool) -> Eq MirrorError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MirrorError -> MirrorError -> Bool
$c/= :: MirrorError -> MirrorError -> Bool
== :: MirrorError -> MirrorError -> Bool
$c== :: MirrorError -> MirrorError -> Bool
Eq, Int -> MirrorError -> ShowS
[MirrorError] -> ShowS
MirrorError -> String
(Int -> MirrorError -> ShowS)
-> (MirrorError -> String)
-> ([MirrorError] -> ShowS)
-> Show MirrorError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MirrorError] -> ShowS
$cshowList :: [MirrorError] -> ShowS
show :: MirrorError -> String
$cshow :: MirrorError -> String
showsPrec :: Int -> MirrorError -> ShowS
$cshowsPrec :: Int -> MirrorError -> ShowS
Show, (forall x. MirrorError -> Rep MirrorError x)
-> (forall x. Rep MirrorError x -> MirrorError)
-> Generic MirrorError
forall x. Rep MirrorError x -> MirrorError
forall x. MirrorError -> Rep MirrorError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MirrorError x -> MirrorError
$cfrom :: forall x. MirrorError -> Rep MirrorError x
Generic)
    deriving anyclass ([MirrorError] -> Encoding
[MirrorError] -> Value
MirrorError -> Encoding
MirrorError -> Value
(MirrorError -> Value)
-> (MirrorError -> Encoding)
-> ([MirrorError] -> Value)
-> ([MirrorError] -> Encoding)
-> ToJSON MirrorError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [MirrorError] -> Encoding
$ctoEncodingList :: [MirrorError] -> Encoding
toJSONList :: [MirrorError] -> Value
$ctoJSONList :: [MirrorError] -> Value
toEncoding :: MirrorError -> Encoding
$ctoEncoding :: MirrorError -> Encoding
toJSON :: MirrorError -> Value
$ctoJSON :: MirrorError -> Value
ToJSON, Value -> Parser [MirrorError]
Value -> Parser MirrorError
(Value -> Parser MirrorError)
-> (Value -> Parser [MirrorError]) -> FromJSON MirrorError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [MirrorError]
$cparseJSONList :: Value -> Parser [MirrorError]
parseJSON :: Value -> Parser MirrorError
$cparseJSON :: Value -> Parser MirrorError
FromJSON)

makeClassyPrisms ''MirrorError

instance AsSMContractError MirrorError where
    _SMContractError :: p SMContractError (f SMContractError)
-> p MirrorError (f MirrorError)
_SMContractError = p SMContractError (f SMContractError)
-> p MirrorError (f MirrorError)
forall r. AsMirrorError r => Prism' r SMContractError
_StateMachineError

instance AsContractError MirrorError where
    _ContractError :: p ContractError (f ContractError) -> p MirrorError (f MirrorError)
_ContractError = p ContractError (f ContractError) -> p MirrorError (f MirrorError)
forall r. AsMirrorError r => Prism' r ContractError
_MirrorEndpointError (p ContractError (f ContractError)
 -> p MirrorError (f MirrorError))
-> (p ContractError (f ContractError)
    -> p ContractError (f ContractError))
-> p ContractError (f ContractError)
-> p MirrorError (f MirrorError)
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