{-# LANGUAGE UndecidableInstances #-}

-- | Error types used in the Hydra.HeadLogic module.
module Hydra.HeadLogic.Error where

import Hydra.Prelude

import Hydra.HeadLogic.Input (Input)
import Hydra.HeadLogic.State (HeadState)
import Hydra.Ledger (ValidationError)
import Hydra.Tx (
  HeadId,
  IsTx (TxIdType, UTxOType),
  Party,
  SnapshotNumber,
  SnapshotVersion,
 )
import Hydra.Tx.Crypto (HydraKey, VerificationKey)

data LogicError tx
  = UnhandledInput {forall tx. LogicError tx -> Input tx
input :: Input tx, forall tx. LogicError tx -> HeadState tx
currentHeadState :: HeadState tx}
  | RequireFailed {forall tx. LogicError tx -> RequirementFailure tx
requirementFailure :: RequirementFailure tx}
  | AssertionFailed {forall tx. LogicError tx -> Text
message :: Text}
  | NotOurHead {forall tx. LogicError tx -> HeadId
ourHeadId :: HeadId, forall tx. LogicError tx -> HeadId
otherHeadId :: HeadId}
  | SideLoadSnapshotFailed {forall tx. LogicError tx -> SideLoadRequirementFailure tx
sideLoadRequirementFailure :: SideLoadRequirementFailure tx}
  deriving stock ((forall x. LogicError tx -> Rep (LogicError tx) x)
-> (forall x. Rep (LogicError tx) x -> LogicError tx)
-> Generic (LogicError tx)
forall x. Rep (LogicError tx) x -> LogicError tx
forall x. LogicError tx -> Rep (LogicError tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (LogicError tx) x -> LogicError tx
forall tx x. LogicError tx -> Rep (LogicError tx) x
$cfrom :: forall tx x. LogicError tx -> Rep (LogicError tx) x
from :: forall x. LogicError tx -> Rep (LogicError tx) x
$cto :: forall tx x. Rep (LogicError tx) x -> LogicError tx
to :: forall x. Rep (LogicError tx) x -> LogicError tx
Generic)

deriving stock instance
  ( Eq (HeadState tx)
  , Eq (Input tx)
  , Eq (RequirementFailure tx)
  , Eq (SideLoadRequirementFailure tx)
  ) =>
  Eq (LogicError tx)

deriving stock instance
  ( Show (HeadState tx)
  , Show (Input tx)
  , Show (RequirementFailure tx)
  , Show (SideLoadRequirementFailure tx)
  ) =>
  Show (LogicError tx)

deriving anyclass instance
  ( ToJSON (HeadState tx)
  , ToJSON (Input tx)
  , ToJSON (RequirementFailure tx)
  , ToJSON (SideLoadRequirementFailure tx)
  ) =>
  ToJSON (LogicError tx)

data RequirementFailure tx
  = ReqSnNumberInvalid {forall tx. RequirementFailure tx -> SnapshotNumber
requestedSn :: SnapshotNumber, forall tx. RequirementFailure tx -> SnapshotNumber
lastSeenSn :: SnapshotNumber}
  | ReqSvNumberInvalid {forall tx. RequirementFailure tx -> SnapshotVersion
requestedSv :: SnapshotVersion, forall tx. RequirementFailure tx -> SnapshotVersion
lastSeenSv :: SnapshotVersion}
  | ReqSnNotLeader {requestedSn :: SnapshotNumber, forall tx. RequirementFailure tx -> Party
leader :: Party}
  | ReqSnDecommitNotSettled
  | ReqSnCommitNotSettled
  | -- | A snapshot may settle a commit or a decommit, never both: close and
    -- fanout carry a single incremental action, so a snapshot with both would
    -- leave the head unclosable.
    ReqSnBothCommitAndDecommit {forall tx. RequirementFailure tx -> TxIdType tx
depositTxId :: TxIdType tx, forall tx. RequirementFailure tx -> TxIdType tx
decommitTxId :: TxIdType tx}
  | -- | A decommit that materializes no output cannot be settled: the decrement
    -- validator requires at least one decommit output.
    ReqSnDecommitNoOutputs {decommitTxId :: TxIdType tx}
  | InvalidMultisignature {forall tx. RequirementFailure tx -> Text
multisig :: Text, forall tx. RequirementFailure tx -> [VerificationKey HydraKey]
vkeys :: [VerificationKey HydraKey]}
  | SnapshotAlreadySigned {forall tx. RequirementFailure tx -> [Party]
knownSignatures :: [Party], forall tx. RequirementFailure tx -> Party
receivedSignature :: Party}
  | AckSnNumberInvalid {requestedSn :: SnapshotNumber, lastSeenSn :: SnapshotNumber}
  | SnapshotDoesNotApply {requestedSn :: SnapshotNumber, forall tx. RequirementFailure tx -> TxIdType tx
txid :: TxIdType tx, forall tx. RequirementFailure tx -> ValidationError
error :: ValidationError}
  | NoMatchingDeposit
  | RequestedDepositExpired {depositTxId :: TxIdType tx}
  | RequestedDepositNotFoundLocally {depositTxId :: TxIdType tx}
  | ReqSnUTxOSetTooLarge {forall tx. RequirementFailure tx -> Int
utxoCount :: Int, forall tx. RequirementFailure tx -> Int
maxAllowed :: Int}
  deriving stock ((forall x. RequirementFailure tx -> Rep (RequirementFailure tx) x)
-> (forall x.
    Rep (RequirementFailure tx) x -> RequirementFailure tx)
-> Generic (RequirementFailure tx)
forall x. Rep (RequirementFailure tx) x -> RequirementFailure tx
forall x. RequirementFailure tx -> Rep (RequirementFailure tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (RequirementFailure tx) x -> RequirementFailure tx
forall tx x. RequirementFailure tx -> Rep (RequirementFailure tx) x
$cfrom :: forall tx x. RequirementFailure tx -> Rep (RequirementFailure tx) x
from :: forall x. RequirementFailure tx -> Rep (RequirementFailure tx) x
$cto :: forall tx x. Rep (RequirementFailure tx) x -> RequirementFailure tx
to :: forall x. Rep (RequirementFailure tx) x -> RequirementFailure tx
Generic)

deriving stock instance Eq (TxIdType tx) => Eq (RequirementFailure tx)
deriving stock instance Show (TxIdType tx) => Show (RequirementFailure tx)
deriving anyclass instance ToJSON (TxIdType tx) => ToJSON (RequirementFailure tx)

instance IsTx tx => ToCBOR (RequirementFailure tx) where
  toCBOR :: RequirementFailure tx -> Encoding
toCBOR = RequirementFailure tx -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance IsTx tx => FromCBOR (RequirementFailure tx) where
  fromCBOR :: forall s. Decoder s (RequirementFailure tx)
fromCBOR = Decoder s (RequirementFailure tx)
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR

data SideLoadRequirementFailure tx
  = SideLoadInitialSnapshotMismatch
  | SideLoadSnNumberInvalid {forall tx. SideLoadRequirementFailure tx -> SnapshotNumber
requestedSn :: SnapshotNumber, forall tx. SideLoadRequirementFailure tx -> SnapshotNumber
lastSeenSn :: SnapshotNumber}
  | SideLoadSvNumberInvalid {forall tx. SideLoadRequirementFailure tx -> SnapshotVersion
requestedSv :: SnapshotVersion, forall tx. SideLoadRequirementFailure tx -> SnapshotVersion
lastSeenSv :: SnapshotVersion}
  | SideLoadUTxOToCommitInvalid {forall tx. SideLoadRequirementFailure tx -> Maybe (UTxOType tx)
requestedSc :: Maybe (UTxOType tx), forall tx. SideLoadRequirementFailure tx -> Maybe (UTxOType tx)
lastSeenSc :: Maybe (UTxOType tx)}
  | -- | The side-loaded snapshot commits the same UTxO as the confirmed one, but
    -- from a different deposit. Since the deposit is what identifies a pending
    -- commit, this is a distinct disagreement from 'SideLoadUTxOToCommitInvalid',
    -- whose payload would show two identical UTxO sets here.
    SideLoadDepositTxIdInvalid {forall tx. SideLoadRequirementFailure tx -> Maybe (TxIdType tx)
requestedDeposit :: Maybe (TxIdType tx), forall tx. SideLoadRequirementFailure tx -> Maybe (TxIdType tx)
lastSeenDeposit :: Maybe (TxIdType tx)}
  | SideLoadUTxOToDecommitInvalid {forall tx. SideLoadRequirementFailure tx -> Maybe (UTxOType tx)
requestedSd :: Maybe (UTxOType tx), forall tx. SideLoadRequirementFailure tx -> Maybe (UTxOType tx)
lastSeenSd :: Maybe (UTxOType tx)}
  | SideLoadInvalidMultisignature {forall tx. SideLoadRequirementFailure tx -> Text
multisig :: Text, forall tx.
SideLoadRequirementFailure tx -> [VerificationKey HydraKey]
vkeys :: [VerificationKey HydraKey]}
  deriving stock ((forall x.
 SideLoadRequirementFailure tx
 -> Rep (SideLoadRequirementFailure tx) x)
-> (forall x.
    Rep (SideLoadRequirementFailure tx) x
    -> SideLoadRequirementFailure tx)
-> Generic (SideLoadRequirementFailure tx)
forall x.
Rep (SideLoadRequirementFailure tx) x
-> SideLoadRequirementFailure tx
forall x.
SideLoadRequirementFailure tx
-> Rep (SideLoadRequirementFailure tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x.
Rep (SideLoadRequirementFailure tx) x
-> SideLoadRequirementFailure tx
forall tx x.
SideLoadRequirementFailure tx
-> Rep (SideLoadRequirementFailure tx) x
$cfrom :: forall tx x.
SideLoadRequirementFailure tx
-> Rep (SideLoadRequirementFailure tx) x
from :: forall x.
SideLoadRequirementFailure tx
-> Rep (SideLoadRequirementFailure tx) x
$cto :: forall tx x.
Rep (SideLoadRequirementFailure tx) x
-> SideLoadRequirementFailure tx
to :: forall x.
Rep (SideLoadRequirementFailure tx) x
-> SideLoadRequirementFailure tx
Generic)

deriving stock instance (Eq (UTxOType tx), Eq (TxIdType tx)) => Eq (SideLoadRequirementFailure tx)
deriving stock instance (Show (UTxOType tx), Show (TxIdType tx)) => Show (SideLoadRequirementFailure tx)
deriving anyclass instance (ToJSON (UTxOType tx), ToJSON (TxIdType tx)) => ToJSON (SideLoadRequirementFailure tx)
deriving anyclass instance (FromJSON (UTxOType tx), FromJSON (TxIdType tx)) => FromJSON (SideLoadRequirementFailure tx)

instance IsTx tx => ToCBOR (SideLoadRequirementFailure tx) where
  toCBOR :: SideLoadRequirementFailure tx -> Encoding
toCBOR = SideLoadRequirementFailure tx -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

instance IsTx tx => FromCBOR (SideLoadRequirementFailure tx) where
  fromCBOR :: forall s. Decoder s (SideLoadRequirementFailure tx)
fromCBOR = Decoder s (SideLoadRequirementFailure tx)
forall a s. (Generic a, GFromCBOR (Rep a)) => Decoder s a
genericFromCBOR