{-# LANGUAGE UndecidableInstances #-}

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

import Hydra.Prelude

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

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}
  | NotOurHead {forall tx. LogicError tx -> HeadId
ourHeadId :: HeadId, forall tx. LogicError tx -> HeadId
otherHeadId :: HeadId}
  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)

instance (Typeable tx, Show (Input tx), Show (HeadState tx), Show (RequirementFailure tx)) => Exception (LogicError tx)

instance (Arbitrary (Input tx), Arbitrary (HeadState tx), Arbitrary (RequirementFailure tx)) => Arbitrary (LogicError tx) where
  arbitrary :: Gen (LogicError tx)
arbitrary = Gen (LogicError tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary
  shrink :: LogicError tx -> [LogicError tx]
shrink = LogicError tx -> [LogicError tx]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

deriving stock instance (Eq (HeadState tx), Eq (Input tx), Eq (RequirementFailure tx)) => Eq (LogicError tx)
deriving stock instance (Show (HeadState tx), Show (Input tx), Show (RequirementFailure tx)) => Show (LogicError tx)
deriving anyclass instance (ToJSON (HeadState tx), ToJSON (Input tx), ToJSON (RequirementFailure tx)) => ToJSON (LogicError tx)
deriving anyclass instance (FromJSON (HeadState tx), FromJSON (Input tx), FromJSON (RequirementFailure tx)) => FromJSON (LogicError tx)

data RequirementFailure tx
  = ReqSnNumberInvalid {forall tx. RequirementFailure tx -> SnapshotNumber
requestedSn :: SnapshotNumber, forall tx. RequirementFailure tx -> SnapshotNumber
lastSeenSn :: SnapshotNumber}
  | ReqSnNotLeader {requestedSn :: SnapshotNumber, forall tx. RequirementFailure tx -> Party
leader :: Party}
  | 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}
  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)
deriving anyclass instance FromJSON (TxIdType tx) => FromJSON (RequirementFailure tx)

instance Arbitrary (TxIdType tx) => Arbitrary (RequirementFailure tx) where
  arbitrary :: Gen (RequirementFailure tx)
arbitrary = Gen (RequirementFailure tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary