-- | This module exposes the errors that can be raised during a mockchain run
module Cooked.MockChain.Error
  ( -- * Mockchain errors
    BalancingError (..),
    MockChainError (..),

    -- * Interpretating effects into `Error MockChainError`
    runToCardanoErrorInMockChainError,
    runFailInMockChainError,
  )
where

import Cooked.Skeleton.User
import Ledger.Index qualified as Ledger
import Ledger.Slot qualified as Ledger
import Ledger.Tx qualified as Ledger
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Error
import Polysemy.Fail

-- | Errors that can be produced during balancing
data BalancingError
  = -- | The balancing user theoretically has enough funds to balancing the
    -- trasaction, but this balancing results in a surplus payment which they
    -- cannot afford ADA-wise.
    NotEnoughFundForExtraMinAda Peer
  | -- | The balancing does not have enough funds to sustain the fee required to
    -- balance the transaction.
    NotEnoughFundForProperFee Peer
  | -- | The balancing wallet does not have enough funds to balance the
    -- transaction
    NotEnoughFund Peer Api.Value
  | -- | The provided of collateral UTxOs does not have enough funds to cover
    -- the potential collateral cost
    NoSuitableCollateral Integer Integer Api.Value
  | -- | The balancing user has not be provided, but the balancing requires it
    MissingBalancingUser
  deriving (Int -> BalancingError -> ShowS
[BalancingError] -> ShowS
BalancingError -> String
(Int -> BalancingError -> ShowS)
-> (BalancingError -> String)
-> ([BalancingError] -> ShowS)
-> Show BalancingError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BalancingError -> ShowS
showsPrec :: Int -> BalancingError -> ShowS
$cshow :: BalancingError -> String
show :: BalancingError -> String
$cshowList :: [BalancingError] -> ShowS
showList :: [BalancingError] -> ShowS
Show, BalancingError -> BalancingError -> Bool
(BalancingError -> BalancingError -> Bool)
-> (BalancingError -> BalancingError -> Bool) -> Eq BalancingError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BalancingError -> BalancingError -> Bool
== :: BalancingError -> BalancingError -> Bool
$c/= :: BalancingError -> BalancingError -> Bool
/= :: BalancingError -> BalancingError -> Bool
Eq)

-- | Errors that can be produced by the blockchain
data MockChainError
  = -- | Validation errors, either in Phase 1 or Phase 2
    MCEValidationError Ledger.ValidationPhase Ledger.ValidationError
  | -- | Balancing errors
    MCEBalancingError BalancingError
  | -- | Translating a skeleton element to its Cardano counterpart failed
    MCEToCardanoError Ledger.ToCardanoError
  | -- | The required reference script is missing from a witness utxo
    MCEWrongReferenceScriptError Api.TxOutRef Api.ScriptHash (Maybe Api.ScriptHash)
  | -- | A UTxO is missing from the mockchain state
    MCEUnknownOutRef Api.TxOutRef
  | -- | A jump in time would result in a past slot
    MCEPastSlot Ledger.Slot Ledger.Slot
  | -- | An attempt to invoke an unsupported feature has been made
    MCEUnsupportedFeature String
  | -- | Used to provide 'MonadFail' instances.
    MCEFailure String
  deriving (Int -> MockChainError -> ShowS
[MockChainError] -> ShowS
MockChainError -> String
(Int -> MockChainError -> ShowS)
-> (MockChainError -> String)
-> ([MockChainError] -> ShowS)
-> Show MockChainError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MockChainError -> ShowS
showsPrec :: Int -> MockChainError -> ShowS
$cshow :: MockChainError -> String
show :: MockChainError -> String
$cshowList :: [MockChainError] -> ShowS
showList :: [MockChainError] -> ShowS
Show, MockChainError -> MockChainError -> Bool
(MockChainError -> MockChainError -> Bool)
-> (MockChainError -> MockChainError -> Bool) -> Eq MockChainError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MockChainError -> MockChainError -> Bool
== :: MockChainError -> MockChainError -> Bool
$c/= :: MockChainError -> MockChainError -> Bool
/= :: MockChainError -> MockChainError -> Bool
Eq)

-- | Interpreting `Ledger.ToCardanoError` in terms of `MockChainError`
runToCardanoErrorInMockChainError ::
  forall effs a.
  (Member (Error MockChainError) effs) =>
  Sem (Error Ledger.ToCardanoError : effs) a ->
  Sem effs a
runToCardanoErrorInMockChainError :: forall (effs :: EffectRow) a.
Member (Error MockChainError) effs =>
Sem (Error ToCardanoError : effs) a -> Sem effs a
runToCardanoErrorInMockChainError = (ToCardanoError -> MockChainError)
-> Sem (Error ToCardanoError : effs) a -> Sem effs a
forall e1 e2 (r :: EffectRow) a.
Member (Error e2) r =>
(e1 -> e2) -> Sem (Error e1 : r) a -> Sem r a
mapError ToCardanoError -> MockChainError
MCEToCardanoError

-- | Interpreting failures in terms of `MockChainError`
runFailInMockChainError ::
  forall effs a.
  (Member (Error MockChainError) effs) =>
  Sem (Fail : effs) a ->
  Sem effs a
runFailInMockChainError :: forall (effs :: EffectRow) a.
Member (Error MockChainError) effs =>
Sem (Fail : effs) a -> Sem effs a
runFailInMockChainError = (forall (rInitial :: EffectRow) x.
 Fail (Sem rInitial) x -> Sem effs x)
-> Sem (Fail : effs) a -> Sem effs a
forall (e :: (* -> *) -> * -> *) (r :: EffectRow) a.
FirstOrder e "interpret" =>
(forall (rInitial :: EffectRow) x. e (Sem rInitial) x -> Sem r x)
-> Sem (e : r) a -> Sem r a
interpret ((forall (rInitial :: EffectRow) x.
  Fail (Sem rInitial) x -> Sem effs x)
 -> Sem (Fail : effs) a -> Sem effs a)
-> (forall (rInitial :: EffectRow) x.
    Fail (Sem rInitial) x -> Sem effs x)
-> Sem (Fail : effs) a
-> Sem effs a
forall a b. (a -> b) -> a -> b
$
  \(Fail String
s) -> MockChainError -> Sem effs x
forall e (r :: EffectRow) a. Member (Error e) r => e -> Sem r a
throw (MockChainError -> Sem effs x) -> MockChainError -> Sem effs x
forall a b. (a -> b) -> a -> b
$ String -> MockChainError
MCEFailure String
s