{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeFamilyDependencies #-}

module Hydra.Ledger where

import Hydra.Prelude

import Hydra.Chain.ChainState (ChainSlot (..))
import Hydra.Tx.IsTx (IsTx (..))

-- | An abstract interface for a 'Ledger'. Allows to define mock / simpler
-- implementation for testing as well as limiting feature-envy from the business
-- logic by forcing a closed interface.
data Ledger tx = Ledger
  { forall tx.
Ledger tx
-> ChainSlot
-> UTxOType tx
-> [tx]
-> Either (tx, ValidationError) (UTxOType tx)
applyTransactions ::
      ChainSlot ->
      UTxOType tx ->
      [tx] ->
      Either (tx, ValidationError) (UTxOType tx)
  -- ^ Apply a set of transaction to a given UTxO set. Returns the new UTxO or
  -- validation failures returned from the ledger.
  -- TODO: 'ValidationError' should also include the UTxO, which is not
  -- necessarily the same as the given UTxO after some transactions
  , forall tx.
Ledger tx
-> ChainSlot
-> UTxOType tx
-> [tx]
-> Either (tx, ValidationError) (UTxOType tx)
reapplyTransactions ::
      ChainSlot ->
      UTxOType tx ->
      [tx] ->
      Either (tx, ValidationError) (UTxOType tx)
  -- ^ Like 'applyTransactions', but only for transactions that were already
  -- accepted by 'applyTransactions' earlier (possibly against a different UTxO).
  -- It skips the expensive *static* checks — Plutus script evaluation and
  -- witness cryptography — while still running the state-dependent checks
  -- (inputs present, value preserved), so it fails exactly like
  -- 'applyTransactions' when a transaction no longer applies.
  --
  -- Callers MUST only pass previously-validated transactions; passing an
  -- unvalidated transaction is unsound (its scripts/signatures are not checked).
  }

-- | Either valid or an error which we get from the ledger-specs tx validation.
data ValidationResult
  = Valid
  | Invalid ValidationError
  deriving stock (ValidationResult -> ValidationResult -> Bool
(ValidationResult -> ValidationResult -> Bool)
-> (ValidationResult -> ValidationResult -> Bool)
-> Eq ValidationResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationResult -> ValidationResult -> Bool
== :: ValidationResult -> ValidationResult -> Bool
$c/= :: ValidationResult -> ValidationResult -> Bool
/= :: ValidationResult -> ValidationResult -> Bool
Eq, Int -> ValidationResult -> ShowS
[ValidationResult] -> ShowS
ValidationResult -> String
(Int -> ValidationResult -> ShowS)
-> (ValidationResult -> String)
-> ([ValidationResult] -> ShowS)
-> Show ValidationResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationResult -> ShowS
showsPrec :: Int -> ValidationResult -> ShowS
$cshow :: ValidationResult -> String
show :: ValidationResult -> String
$cshowList :: [ValidationResult] -> ShowS
showList :: [ValidationResult] -> ShowS
Show, (forall x. ValidationResult -> Rep ValidationResult x)
-> (forall x. Rep ValidationResult x -> ValidationResult)
-> Generic ValidationResult
forall x. Rep ValidationResult x -> ValidationResult
forall x. ValidationResult -> Rep ValidationResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValidationResult -> Rep ValidationResult x
from :: forall x. ValidationResult -> Rep ValidationResult x
$cto :: forall x. Rep ValidationResult x -> ValidationResult
to :: forall x. Rep ValidationResult x -> ValidationResult
Generic)

newtype ValidationError = ValidationError {ValidationError -> Text
reason :: Text}
  deriving stock (ValidationError -> ValidationError -> Bool
(ValidationError -> ValidationError -> Bool)
-> (ValidationError -> ValidationError -> Bool)
-> Eq ValidationError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValidationError -> ValidationError -> Bool
== :: ValidationError -> ValidationError -> Bool
$c/= :: ValidationError -> ValidationError -> Bool
/= :: ValidationError -> ValidationError -> Bool
Eq, Int -> ValidationError -> ShowS
[ValidationError] -> ShowS
ValidationError -> String
(Int -> ValidationError -> ShowS)
-> (ValidationError -> String)
-> ([ValidationError] -> ShowS)
-> Show ValidationError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValidationError -> ShowS
showsPrec :: Int -> ValidationError -> ShowS
$cshow :: ValidationError -> String
show :: ValidationError -> String
$cshowList :: [ValidationError] -> ShowS
showList :: [ValidationError] -> ShowS
Show, (forall x. ValidationError -> Rep ValidationError x)
-> (forall x. Rep ValidationError x -> ValidationError)
-> Generic ValidationError
forall x. Rep ValidationError x -> ValidationError
forall x. ValidationError -> Rep ValidationError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ValidationError -> Rep ValidationError x
from :: forall x. ValidationError -> Rep ValidationError x
$cto :: forall x. Rep ValidationError x -> ValidationError
to :: forall x. Rep ValidationError x -> ValidationError
Generic)
  deriving anyclass ([ValidationError] -> Value
[ValidationError] -> Encoding
ValidationError -> Bool
ValidationError -> Value
ValidationError -> Encoding
(ValidationError -> Value)
-> (ValidationError -> Encoding)
-> ([ValidationError] -> Value)
-> ([ValidationError] -> Encoding)
-> (ValidationError -> Bool)
-> ToJSON ValidationError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: ValidationError -> Value
toJSON :: ValidationError -> Value
$ctoEncoding :: ValidationError -> Encoding
toEncoding :: ValidationError -> Encoding
$ctoJSONList :: [ValidationError] -> Value
toJSONList :: [ValidationError] -> Value
$ctoEncodingList :: [ValidationError] -> Encoding
toEncodingList :: [ValidationError] -> Encoding
$comitField :: ValidationError -> Bool
omitField :: ValidationError -> Bool
ToJSON, Maybe ValidationError
Value -> Parser [ValidationError]
Value -> Parser ValidationError
(Value -> Parser ValidationError)
-> (Value -> Parser [ValidationError])
-> Maybe ValidationError
-> FromJSON ValidationError
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser ValidationError
parseJSON :: Value -> Parser ValidationError
$cparseJSONList :: Value -> Parser [ValidationError]
parseJSONList :: Value -> Parser [ValidationError]
$comittedField :: Maybe ValidationError
omittedField :: Maybe ValidationError
FromJSON)

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

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