-- | A mock implementation of a ledger using very simple UTxO transactions.
--
-- These transactions have a very simplified representation of unspent
-- transaction outputs being just integers, but already have inputs and outputs.
-- Transactions are validated against the current state of the ledger, so that
-- one transaction could at some point be invalid, then becomes valid because
-- some inputs it consumes are now available.
--
-- NOTE: There is no notion of time in this ledger, so transactions validation
-- will never depend on the L1 slot.
module Hydra.Ledger.Simple where

import Hydra.Prelude

import Codec.Serialise (serialise)
import Data.Aeson (
  object,
  withObject,
  (.:),
  (.=),
 )
import Data.List (maximum)
import Data.Set qualified as Set
import Hydra.Chain (ChainStateType, IsChainState (..))
import Hydra.Ledger (
  ChainSlot (..),
  IsTx (..),
  Ledger (..),
  ValidationError (ValidationError),
 )
import Test.QuickCheck (choose, getSize, sublistOf)

-- * Simple transactions

-- | Simple transaction.
-- A transaction is a 'SimpleId', a list of inputs and a list of outputs,
-- and it has no time validity.
data SimpleTx = SimpleTx
  { SimpleTx -> Integer
txSimpleId :: SimpleId
  , SimpleTx -> UTxOType SimpleTx
txInputs :: UTxOType SimpleTx
  , SimpleTx -> UTxOType SimpleTx
txOutputs :: UTxOType SimpleTx
  }
  deriving stock (SimpleTx -> SimpleTx -> Bool
(SimpleTx -> SimpleTx -> Bool)
-> (SimpleTx -> SimpleTx -> Bool) -> Eq SimpleTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleTx -> SimpleTx -> Bool
== :: SimpleTx -> SimpleTx -> Bool
$c/= :: SimpleTx -> SimpleTx -> Bool
/= :: SimpleTx -> SimpleTx -> Bool
Eq, Eq SimpleTx
Eq SimpleTx =>
(SimpleTx -> SimpleTx -> Ordering)
-> (SimpleTx -> SimpleTx -> Bool)
-> (SimpleTx -> SimpleTx -> Bool)
-> (SimpleTx -> SimpleTx -> Bool)
-> (SimpleTx -> SimpleTx -> Bool)
-> (SimpleTx -> SimpleTx -> SimpleTx)
-> (SimpleTx -> SimpleTx -> SimpleTx)
-> Ord SimpleTx
SimpleTx -> SimpleTx -> Bool
SimpleTx -> SimpleTx -> Ordering
SimpleTx -> SimpleTx -> SimpleTx
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
$ccompare :: SimpleTx -> SimpleTx -> Ordering
compare :: SimpleTx -> SimpleTx -> Ordering
$c< :: SimpleTx -> SimpleTx -> Bool
< :: SimpleTx -> SimpleTx -> Bool
$c<= :: SimpleTx -> SimpleTx -> Bool
<= :: SimpleTx -> SimpleTx -> Bool
$c> :: SimpleTx -> SimpleTx -> Bool
> :: SimpleTx -> SimpleTx -> Bool
$c>= :: SimpleTx -> SimpleTx -> Bool
>= :: SimpleTx -> SimpleTx -> Bool
$cmax :: SimpleTx -> SimpleTx -> SimpleTx
max :: SimpleTx -> SimpleTx -> SimpleTx
$cmin :: SimpleTx -> SimpleTx -> SimpleTx
min :: SimpleTx -> SimpleTx -> SimpleTx
Ord, (forall x. SimpleTx -> Rep SimpleTx x)
-> (forall x. Rep SimpleTx x -> SimpleTx) -> Generic SimpleTx
forall x. Rep SimpleTx x -> SimpleTx
forall x. SimpleTx -> Rep SimpleTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SimpleTx -> Rep SimpleTx x
from :: forall x. SimpleTx -> Rep SimpleTx x
$cto :: forall x. Rep SimpleTx x -> SimpleTx
to :: forall x. Rep SimpleTx x -> SimpleTx
Generic, Int -> SimpleTx -> ShowS
[SimpleTx] -> ShowS
SimpleTx -> String
(Int -> SimpleTx -> ShowS)
-> (SimpleTx -> String) -> ([SimpleTx] -> ShowS) -> Show SimpleTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleTx -> ShowS
showsPrec :: Int -> SimpleTx -> ShowS
$cshow :: SimpleTx -> String
show :: SimpleTx -> String
$cshowList :: [SimpleTx] -> ShowS
showList :: [SimpleTx] -> ShowS
Show)

type SimpleId = Integer

instance IsTx SimpleTx where
  type UTxOType SimpleTx = Set SimpleTxIn
  type TxIdType SimpleTx = SimpleId
  type ValueType SimpleTx = Int

  txId :: SimpleTx -> TxIdType SimpleTx
txId (SimpleTx Integer
tid UTxOType SimpleTx
_ UTxOType SimpleTx
_) = Integer
TxIdType SimpleTx
tid
  balance :: UTxOType SimpleTx -> ValueType SimpleTx
balance = Set SimpleTxIn -> Int
UTxOType SimpleTx -> ValueType SimpleTx
forall a. Set a -> Int
Set.size
  hashUTxO :: UTxOType SimpleTx -> ByteString
hashUTxO = ByteString -> ByteString
forall l s. LazyStrict l s => l -> s
toStrict (ByteString -> ByteString)
-> (Set SimpleTxIn -> ByteString) -> Set SimpleTxIn -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SimpleTxIn -> ByteString) -> Set SimpleTxIn -> ByteString
forall m a. Monoid m => (a -> m) -> Set a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (Integer -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Integer -> ByteString)
-> (SimpleTxIn -> Integer) -> SimpleTxIn -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SimpleTxIn -> Integer
unSimpleTxIn)

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

instance ToJSON SimpleTx where
  toJSON :: SimpleTx -> Value
toJSON SimpleTx
tx =
    [Pair] -> Value
object
      [ Key
"id" Key -> Integer -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SimpleTx -> TxIdType SimpleTx
forall tx. IsTx tx => tx -> TxIdType tx
txId SimpleTx
tx
      , Key
"inputs" Key -> Set SimpleTxIn -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SimpleTx -> UTxOType SimpleTx
txInputs SimpleTx
tx
      , Key
"outputs" Key -> Set SimpleTxIn -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SimpleTx -> UTxOType SimpleTx
txOutputs SimpleTx
tx
      ]

instance FromJSON SimpleTx where
  parseJSON :: Value -> Parser SimpleTx
parseJSON = String -> (Object -> Parser SimpleTx) -> Value -> Parser SimpleTx
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SimpleTx" ((Object -> Parser SimpleTx) -> Value -> Parser SimpleTx)
-> (Object -> Parser SimpleTx) -> Value -> Parser SimpleTx
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    Integer -> Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx
Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx
      (Integer -> Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx)
-> Parser Integer
-> Parser (Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id")
      Parser (Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx)
-> Parser (Set SimpleTxIn) -> Parser (Set SimpleTxIn -> SimpleTx)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Set SimpleTxIn)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"inputs")
      Parser (Set SimpleTxIn -> SimpleTx)
-> Parser (Set SimpleTxIn) -> Parser SimpleTx
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj Object -> Key -> Parser (Set SimpleTxIn)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"outputs")

instance ToCBOR SimpleTx where
  toCBOR :: SimpleTx -> Encoding
toCBOR (SimpleTx Integer
txid UTxOType SimpleTx
inputs UTxOType SimpleTx
outputs) =
    Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer
txid Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set SimpleTxIn -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set SimpleTxIn
UTxOType SimpleTx
inputs Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set SimpleTxIn -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Set SimpleTxIn
UTxOType SimpleTx
outputs

instance FromCBOR SimpleTx where
  fromCBOR :: forall s. Decoder s SimpleTx
fromCBOR =
    Integer -> Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx
Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx
      (Integer -> Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx)
-> Decoder s Integer
-> Decoder s (Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Set SimpleTxIn -> Set SimpleTxIn -> SimpleTx)
-> Decoder s (Set SimpleTxIn)
-> Decoder s (Set SimpleTxIn -> SimpleTx)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Set SimpleTxIn)
forall s. Decoder s (Set SimpleTxIn)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Set SimpleTxIn -> SimpleTx)
-> Decoder s (Set SimpleTxIn) -> Decoder s SimpleTx
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s (Set SimpleTxIn)
forall s. Decoder s (Set SimpleTxIn)
forall a s. FromCBOR a => Decoder s a
fromCBOR

-- * Simple chain state

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

instance Arbitrary SimpleChainState where
  arbitrary :: Gen SimpleChainState
arbitrary = ChainSlot -> SimpleChainState
SimpleChainState (ChainSlot -> SimpleChainState)
-> Gen ChainSlot -> Gen SimpleChainState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChainSlot
forall a. Arbitrary a => Gen a
arbitrary

instance IsChainState SimpleTx where
  type ChainStateType SimpleTx = SimpleChainState

  chainStateSlot :: ChainStateType SimpleTx -> ChainSlot
chainStateSlot SimpleChainState{ChainSlot
$sel:slot:SimpleChainState :: SimpleChainState -> ChainSlot
slot :: ChainSlot
slot} = ChainSlot
slot

--
-- MockTxIn
--

-- | An identifier for a single output of a 'SimpleTx'.
newtype SimpleTxIn = SimpleTxIn {SimpleTxIn -> Integer
unSimpleTxIn :: Integer}
  deriving stock ((forall x. SimpleTxIn -> Rep SimpleTxIn x)
-> (forall x. Rep SimpleTxIn x -> SimpleTxIn) -> Generic SimpleTxIn
forall x. Rep SimpleTxIn x -> SimpleTxIn
forall x. SimpleTxIn -> Rep SimpleTxIn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SimpleTxIn -> Rep SimpleTxIn x
from :: forall x. SimpleTxIn -> Rep SimpleTxIn x
$cto :: forall x. Rep SimpleTxIn x -> SimpleTxIn
to :: forall x. Rep SimpleTxIn x -> SimpleTxIn
Generic)
  deriving newtype (SimpleTxIn -> SimpleTxIn -> Bool
(SimpleTxIn -> SimpleTxIn -> Bool)
-> (SimpleTxIn -> SimpleTxIn -> Bool) -> Eq SimpleTxIn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SimpleTxIn -> SimpleTxIn -> Bool
== :: SimpleTxIn -> SimpleTxIn -> Bool
$c/= :: SimpleTxIn -> SimpleTxIn -> Bool
/= :: SimpleTxIn -> SimpleTxIn -> Bool
Eq, Eq SimpleTxIn
Eq SimpleTxIn =>
(SimpleTxIn -> SimpleTxIn -> Ordering)
-> (SimpleTxIn -> SimpleTxIn -> Bool)
-> (SimpleTxIn -> SimpleTxIn -> Bool)
-> (SimpleTxIn -> SimpleTxIn -> Bool)
-> (SimpleTxIn -> SimpleTxIn -> Bool)
-> (SimpleTxIn -> SimpleTxIn -> SimpleTxIn)
-> (SimpleTxIn -> SimpleTxIn -> SimpleTxIn)
-> Ord SimpleTxIn
SimpleTxIn -> SimpleTxIn -> Bool
SimpleTxIn -> SimpleTxIn -> Ordering
SimpleTxIn -> SimpleTxIn -> SimpleTxIn
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
$ccompare :: SimpleTxIn -> SimpleTxIn -> Ordering
compare :: SimpleTxIn -> SimpleTxIn -> Ordering
$c< :: SimpleTxIn -> SimpleTxIn -> Bool
< :: SimpleTxIn -> SimpleTxIn -> Bool
$c<= :: SimpleTxIn -> SimpleTxIn -> Bool
<= :: SimpleTxIn -> SimpleTxIn -> Bool
$c> :: SimpleTxIn -> SimpleTxIn -> Bool
> :: SimpleTxIn -> SimpleTxIn -> Bool
$c>= :: SimpleTxIn -> SimpleTxIn -> Bool
>= :: SimpleTxIn -> SimpleTxIn -> Bool
$cmax :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
max :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
$cmin :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
min :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
Ord, Int -> SimpleTxIn -> ShowS
[SimpleTxIn] -> ShowS
SimpleTxIn -> String
(Int -> SimpleTxIn -> ShowS)
-> (SimpleTxIn -> String)
-> ([SimpleTxIn] -> ShowS)
-> Show SimpleTxIn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SimpleTxIn -> ShowS
showsPrec :: Int -> SimpleTxIn -> ShowS
$cshow :: SimpleTxIn -> String
show :: SimpleTxIn -> String
$cshowList :: [SimpleTxIn] -> ShowS
showList :: [SimpleTxIn] -> ShowS
Show, Integer -> SimpleTxIn
SimpleTxIn -> SimpleTxIn
SimpleTxIn -> SimpleTxIn -> SimpleTxIn
(SimpleTxIn -> SimpleTxIn -> SimpleTxIn)
-> (SimpleTxIn -> SimpleTxIn -> SimpleTxIn)
-> (SimpleTxIn -> SimpleTxIn -> SimpleTxIn)
-> (SimpleTxIn -> SimpleTxIn)
-> (SimpleTxIn -> SimpleTxIn)
-> (SimpleTxIn -> SimpleTxIn)
-> (Integer -> SimpleTxIn)
-> Num SimpleTxIn
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
+ :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
$c- :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
- :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
$c* :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
* :: SimpleTxIn -> SimpleTxIn -> SimpleTxIn
$cnegate :: SimpleTxIn -> SimpleTxIn
negate :: SimpleTxIn -> SimpleTxIn
$cabs :: SimpleTxIn -> SimpleTxIn
abs :: SimpleTxIn -> SimpleTxIn
$csignum :: SimpleTxIn -> SimpleTxIn
signum :: SimpleTxIn -> SimpleTxIn
$cfromInteger :: Integer -> SimpleTxIn
fromInteger :: Integer -> SimpleTxIn
Num, [SimpleTxIn] -> Value
[SimpleTxIn] -> Encoding
SimpleTxIn -> Bool
SimpleTxIn -> Value
SimpleTxIn -> Encoding
(SimpleTxIn -> Value)
-> (SimpleTxIn -> Encoding)
-> ([SimpleTxIn] -> Value)
-> ([SimpleTxIn] -> Encoding)
-> (SimpleTxIn -> Bool)
-> ToJSON SimpleTxIn
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SimpleTxIn -> Value
toJSON :: SimpleTxIn -> Value
$ctoEncoding :: SimpleTxIn -> Encoding
toEncoding :: SimpleTxIn -> Encoding
$ctoJSONList :: [SimpleTxIn] -> Value
toJSONList :: [SimpleTxIn] -> Value
$ctoEncodingList :: [SimpleTxIn] -> Encoding
toEncodingList :: [SimpleTxIn] -> Encoding
$comitField :: SimpleTxIn -> Bool
omitField :: SimpleTxIn -> Bool
ToJSON, Maybe SimpleTxIn
Value -> Parser [SimpleTxIn]
Value -> Parser SimpleTxIn
(Value -> Parser SimpleTxIn)
-> (Value -> Parser [SimpleTxIn])
-> Maybe SimpleTxIn
-> FromJSON SimpleTxIn
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SimpleTxIn
parseJSON :: Value -> Parser SimpleTxIn
$cparseJSONList :: Value -> Parser [SimpleTxIn]
parseJSONList :: Value -> Parser [SimpleTxIn]
$comittedField :: Maybe SimpleTxIn
omittedField :: Maybe SimpleTxIn
FromJSON)

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

instance ToCBOR SimpleTxIn where
  toCBOR :: SimpleTxIn -> Encoding
toCBOR (SimpleTxIn Integer
inId) = Integer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Integer
inId

instance FromCBOR SimpleTxIn where
  fromCBOR :: forall s. Decoder s SimpleTxIn
fromCBOR = Integer -> SimpleTxIn
SimpleTxIn (Integer -> SimpleTxIn)
-> Decoder s Integer -> Decoder s SimpleTxIn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall s. Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR

simpleLedger :: Ledger SimpleTx
simpleLedger :: Ledger SimpleTx
simpleLedger =
  Ledger{ChainSlot
-> Set SimpleTxIn
-> [SimpleTx]
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
ChainSlot
-> UTxOType SimpleTx
-> [SimpleTx]
-> Either (SimpleTx, ValidationError) (UTxOType SimpleTx)
forall {t :: * -> *} {p}.
Foldable t =>
p
-> Set SimpleTxIn
-> t SimpleTx
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
applyTransactions :: forall {t :: * -> *} {p}.
Foldable t =>
p
-> Set SimpleTxIn
-> t SimpleTx
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
$sel:applyTransactions:Ledger :: ChainSlot
-> UTxOType SimpleTx
-> [SimpleTx]
-> Either (SimpleTx, ValidationError) (UTxOType SimpleTx)
applyTransactions}
 where
  -- NOTE: _slot is unused as SimpleTx transactions don't have a notion of time.
  applyTransactions :: p
-> Set SimpleTxIn
-> t SimpleTx
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
applyTransactions p
_slot =
    (Set SimpleTxIn
 -> SimpleTx -> Either (SimpleTx, ValidationError) (Set SimpleTxIn))
-> Set SimpleTxIn
-> t SimpleTx
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM ((Set SimpleTxIn
  -> SimpleTx -> Either (SimpleTx, ValidationError) (Set SimpleTxIn))
 -> Set SimpleTxIn
 -> t SimpleTx
 -> Either (SimpleTx, ValidationError) (Set SimpleTxIn))
-> (Set SimpleTxIn
    -> SimpleTx -> Either (SimpleTx, ValidationError) (Set SimpleTxIn))
-> Set SimpleTxIn
-> t SimpleTx
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
forall a b. (a -> b) -> a -> b
$ \Set SimpleTxIn
utxo tx :: SimpleTx
tx@(SimpleTx Integer
_ UTxOType SimpleTx
ins UTxOType SimpleTx
outs) ->
      if Set SimpleTxIn
UTxOType SimpleTx
ins Set SimpleTxIn -> Set SimpleTxIn -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.isSubsetOf` Set SimpleTxIn
utxo Bool -> Bool -> Bool
&& Set SimpleTxIn
utxo Set SimpleTxIn -> Set SimpleTxIn -> Bool
forall a. Ord a => Set a -> Set a -> Bool
`Set.disjoint` Set SimpleTxIn
UTxOType SimpleTx
outs
        then Set SimpleTxIn
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
forall a b. b -> Either a b
Right (Set SimpleTxIn
 -> Either (SimpleTx, ValidationError) (Set SimpleTxIn))
-> Set SimpleTxIn
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
forall a b. (a -> b) -> a -> b
$ (Set SimpleTxIn
utxo Set SimpleTxIn -> Set SimpleTxIn -> Set SimpleTxIn
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set SimpleTxIn
UTxOType SimpleTx
ins) Set SimpleTxIn -> Set SimpleTxIn -> Set SimpleTxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set SimpleTxIn
UTxOType SimpleTx
outs
        else (SimpleTx, ValidationError)
-> Either (SimpleTx, ValidationError) (Set SimpleTxIn)
forall a b. a -> Either a b
Left (SimpleTx
tx, Text -> ValidationError
ValidationError Text
"cannot apply transaction")

--
-- Builders
--

utxoRef :: Integer -> UTxOType SimpleTx
utxoRef :: Integer -> UTxOType SimpleTx
utxoRef = SimpleTxIn -> Set SimpleTxIn
forall a. a -> Set a
Set.singleton (SimpleTxIn -> Set SimpleTxIn)
-> (Integer -> SimpleTxIn) -> Integer -> Set SimpleTxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> SimpleTxIn
SimpleTxIn

utxoRefs :: [Integer] -> UTxOType SimpleTx
utxoRefs :: [Integer] -> UTxOType SimpleTx
utxoRefs = [SimpleTxIn] -> Set SimpleTxIn
forall a. Ord a => [a] -> Set a
Set.fromList ([SimpleTxIn] -> Set SimpleTxIn)
-> ([Integer] -> [SimpleTxIn]) -> [Integer] -> Set SimpleTxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> SimpleTxIn) -> [Integer] -> [SimpleTxIn]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> SimpleTxIn
SimpleTxIn

aValidTx :: Integer -> SimpleTx
aValidTx :: Integer -> SimpleTx
aValidTx Integer
n = Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
n Set SimpleTxIn
UTxOType SimpleTx
forall a. Monoid a => a
mempty (Integer -> UTxOType SimpleTx
utxoRef Integer
n)

--
--  Generators
--

listOfCommittedUTxOs :: Integer -> Gen [UTxOType SimpleTx]
listOfCommittedUTxOs :: Integer -> Gen [UTxOType SimpleTx]
listOfCommittedUTxOs Integer
numCommits =
  [UTxOType SimpleTx] -> Gen [UTxOType SimpleTx]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([UTxOType SimpleTx] -> Gen [UTxOType SimpleTx])
-> [UTxOType SimpleTx] -> Gen [UTxOType SimpleTx]
forall a b. (a -> b) -> a -> b
$ SimpleTxIn -> Set SimpleTxIn
forall a. a -> Set a
Set.singleton (SimpleTxIn -> Set SimpleTxIn)
-> (Integer -> SimpleTxIn) -> Integer -> Set SimpleTxIn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> SimpleTxIn
SimpleTxIn (Integer -> Set SimpleTxIn) -> [Integer] -> [Set SimpleTxIn]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer
1 .. Integer
numCommits]

genSequenceOfValidTransactions :: UTxOType SimpleTx -> Gen [SimpleTx]
genSequenceOfValidTransactions :: UTxOType SimpleTx -> Gen [SimpleTx]
genSequenceOfValidTransactions UTxOType SimpleTx
initialUTxO = do
  Integer
n <- Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Gen Int -> Gen Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
getSize
  let maxId :: Integer
maxId = if Set SimpleTxIn -> Bool
forall a. Set a -> Bool
Set.null Set SimpleTxIn
UTxOType SimpleTx
initialUTxO then Integer
0 else SimpleTxIn -> Integer
unSimpleTxIn (Set SimpleTxIn -> SimpleTxIn
forall a. Ord a => Set a -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum Set SimpleTxIn
UTxOType SimpleTx
initialUTxO)
  Integer
numTxs <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
n)
  ((Integer, Set SimpleTxIn, [SimpleTx])
 -> Integer -> Gen (Integer, Set SimpleTxIn, [SimpleTx]))
-> (Integer, Set SimpleTxIn, [SimpleTx])
-> [Integer]
-> Gen (Integer, Set SimpleTxIn, [SimpleTx])
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldlM (Integer, Set SimpleTxIn, [SimpleTx])
-> Integer -> Gen (Integer, Set SimpleTxIn, [SimpleTx])
(TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
-> TxIdType SimpleTx
-> Gen (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
newTx (Integer
maxId, Set SimpleTxIn
UTxOType SimpleTx
initialUTxO, [SimpleTx]
forall a. Monoid a => a
mempty) [Integer
1 .. Integer
numTxs] Gen (Integer, Set SimpleTxIn, [SimpleTx])
-> ((Integer, Set SimpleTxIn, [SimpleTx]) -> Gen [SimpleTx])
-> Gen [SimpleTx]
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(Integer
_, Set SimpleTxIn
_, [SimpleTx]
txs) -> [SimpleTx] -> Gen [SimpleTx]
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SimpleTx] -> [SimpleTx]
forall a. [a] -> [a]
reverse [SimpleTx]
txs)
 where
  newTx ::
    (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx]) ->
    TxIdType SimpleTx ->
    Gen (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
  newTx :: (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
-> TxIdType SimpleTx
-> Gen (TxIdType SimpleTx, UTxOType SimpleTx, [SimpleTx])
newTx (TxIdType SimpleTx
maxId, UTxOType SimpleTx
utxo, [SimpleTx]
txs) TxIdType SimpleTx
txid = do
    (Integer
newMax, Set SimpleTxIn
ins, Set SimpleTxIn
outs) <- Integer
-> Set SimpleTxIn -> Gen (Integer, Set SimpleTxIn, Set SimpleTxIn)
genInputsAndOutputs Integer
TxIdType SimpleTx
maxId Set SimpleTxIn
UTxOType SimpleTx
utxo
    (Integer, Set SimpleTxIn, [SimpleTx])
-> Gen (Integer, Set SimpleTxIn, [SimpleTx])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
newMax, (Set SimpleTxIn
UTxOType SimpleTx
utxo Set SimpleTxIn -> Set SimpleTxIn -> Set SimpleTxIn
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set SimpleTxIn
ins) Set SimpleTxIn -> Set SimpleTxIn -> Set SimpleTxIn
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set SimpleTxIn
outs, Integer -> UTxOType SimpleTx -> UTxOType SimpleTx -> SimpleTx
SimpleTx Integer
TxIdType SimpleTx
txid Set SimpleTxIn
UTxOType SimpleTx
ins Set SimpleTxIn
UTxOType SimpleTx
outs SimpleTx -> [SimpleTx] -> [SimpleTx]
forall a. a -> [a] -> [a]
: [SimpleTx]
txs)

  genInputsAndOutputs :: Integer -> Set SimpleTxIn -> Gen (Integer, Set SimpleTxIn, Set SimpleTxIn)
  genInputsAndOutputs :: Integer
-> Set SimpleTxIn -> Gen (Integer, Set SimpleTxIn, Set SimpleTxIn)
genInputsAndOutputs Integer
maxId Set SimpleTxIn
utxo = do
    [SimpleTxIn]
ins <- [SimpleTxIn] -> Gen [SimpleTxIn]
forall a. [a] -> Gen [a]
sublistOf (Set SimpleTxIn -> [SimpleTxIn]
forall a. Set a -> [a]
Set.toList Set SimpleTxIn
utxo)
    Integer
numOuts <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
10)
    let outs :: [Integer]
outs = (Integer -> Integer) -> [Integer] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
maxId) [Integer
1 .. Integer
numOuts]
    (Integer, Set SimpleTxIn, Set SimpleTxIn)
-> Gen (Integer, Set SimpleTxIn, Set SimpleTxIn)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Integer] -> Integer
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Integer]
outs, [SimpleTxIn] -> Set SimpleTxIn
forall a. Ord a => [a] -> Set a
Set.fromList [SimpleTxIn]
ins, [SimpleTxIn] -> Set SimpleTxIn
forall a. Ord a => [a] -> Set a
Set.fromList ([SimpleTxIn] -> Set SimpleTxIn) -> [SimpleTxIn] -> Set SimpleTxIn
forall a b. (a -> b) -> a -> b
$ (Integer -> SimpleTxIn) -> [Integer] -> [SimpleTxIn]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> SimpleTxIn
SimpleTxIn [Integer]
outs)