{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE UndecidableInstances #-}

module Hydra.Tx.Snapshot where

import Hydra.Prelude

import Cardano.Crypto.Util (SignableRepresentation (..))
import Codec.Serialise (serialise)
import Data.Aeson (object, withObject, (.:), (.:?), (.=))
import Data.ByteString.Lazy qualified as LBS
import Hydra.Cardano.Api (SerialiseAsRawBytes (..), SigningKey)
import Hydra.Contract.HeadState qualified as Onchain
import Hydra.Tx.Crypto (HydraKey, MultiSignature, aggregate, sign)
import Hydra.Tx.HeadId (HeadId)
import Hydra.Tx.IsTx (IsTx (..))
import PlutusLedgerApi.V3 (toBuiltin, toData)
import Test.QuickCheck (frequency, suchThat)
import Test.QuickCheck.Instances.Natural ()

-- * SnapshotNumber and SnapshotVersion

newtype SnapshotNumber
  = UnsafeSnapshotNumber Natural
  deriving stock (SnapshotNumber -> SnapshotNumber -> Bool
(SnapshotNumber -> SnapshotNumber -> Bool)
-> (SnapshotNumber -> SnapshotNumber -> Bool) -> Eq SnapshotNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotNumber -> SnapshotNumber -> Bool
== :: SnapshotNumber -> SnapshotNumber -> Bool
$c/= :: SnapshotNumber -> SnapshotNumber -> Bool
/= :: SnapshotNumber -> SnapshotNumber -> Bool
Eq, Eq SnapshotNumber
Eq SnapshotNumber =>
(SnapshotNumber -> SnapshotNumber -> Ordering)
-> (SnapshotNumber -> SnapshotNumber -> Bool)
-> (SnapshotNumber -> SnapshotNumber -> Bool)
-> (SnapshotNumber -> SnapshotNumber -> Bool)
-> (SnapshotNumber -> SnapshotNumber -> Bool)
-> (SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> Ord SnapshotNumber
SnapshotNumber -> SnapshotNumber -> Bool
SnapshotNumber -> SnapshotNumber -> Ordering
SnapshotNumber -> SnapshotNumber -> SnapshotNumber
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 :: SnapshotNumber -> SnapshotNumber -> Ordering
compare :: SnapshotNumber -> SnapshotNumber -> Ordering
$c< :: SnapshotNumber -> SnapshotNumber -> Bool
< :: SnapshotNumber -> SnapshotNumber -> Bool
$c<= :: SnapshotNumber -> SnapshotNumber -> Bool
<= :: SnapshotNumber -> SnapshotNumber -> Bool
$c> :: SnapshotNumber -> SnapshotNumber -> Bool
> :: SnapshotNumber -> SnapshotNumber -> Bool
$c>= :: SnapshotNumber -> SnapshotNumber -> Bool
>= :: SnapshotNumber -> SnapshotNumber -> Bool
$cmax :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
max :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$cmin :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
min :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
Ord, (forall x. SnapshotNumber -> Rep SnapshotNumber x)
-> (forall x. Rep SnapshotNumber x -> SnapshotNumber)
-> Generic SnapshotNumber
forall x. Rep SnapshotNumber x -> SnapshotNumber
forall x. SnapshotNumber -> Rep SnapshotNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SnapshotNumber -> Rep SnapshotNumber x
from :: forall x. SnapshotNumber -> Rep SnapshotNumber x
$cto :: forall x. Rep SnapshotNumber x -> SnapshotNumber
to :: forall x. Rep SnapshotNumber x -> SnapshotNumber
Generic)
  deriving newtype (Int -> SnapshotNumber -> ShowS
[SnapshotNumber] -> ShowS
SnapshotNumber -> String
(Int -> SnapshotNumber -> ShowS)
-> (SnapshotNumber -> String)
-> ([SnapshotNumber] -> ShowS)
-> Show SnapshotNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotNumber -> ShowS
showsPrec :: Int -> SnapshotNumber -> ShowS
$cshow :: SnapshotNumber -> String
show :: SnapshotNumber -> String
$cshowList :: [SnapshotNumber] -> ShowS
showList :: [SnapshotNumber] -> ShowS
Show, [SnapshotNumber] -> Value
[SnapshotNumber] -> Encoding
SnapshotNumber -> Bool
SnapshotNumber -> Value
SnapshotNumber -> Encoding
(SnapshotNumber -> Value)
-> (SnapshotNumber -> Encoding)
-> ([SnapshotNumber] -> Value)
-> ([SnapshotNumber] -> Encoding)
-> (SnapshotNumber -> Bool)
-> ToJSON SnapshotNumber
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SnapshotNumber -> Value
toJSON :: SnapshotNumber -> Value
$ctoEncoding :: SnapshotNumber -> Encoding
toEncoding :: SnapshotNumber -> Encoding
$ctoJSONList :: [SnapshotNumber] -> Value
toJSONList :: [SnapshotNumber] -> Value
$ctoEncodingList :: [SnapshotNumber] -> Encoding
toEncodingList :: [SnapshotNumber] -> Encoding
$comitField :: SnapshotNumber -> Bool
omitField :: SnapshotNumber -> Bool
ToJSON, Maybe SnapshotNumber
Value -> Parser [SnapshotNumber]
Value -> Parser SnapshotNumber
(Value -> Parser SnapshotNumber)
-> (Value -> Parser [SnapshotNumber])
-> Maybe SnapshotNumber
-> FromJSON SnapshotNumber
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SnapshotNumber
parseJSON :: Value -> Parser SnapshotNumber
$cparseJSONList :: Value -> Parser [SnapshotNumber]
parseJSONList :: Value -> Parser [SnapshotNumber]
$comittedField :: Maybe SnapshotNumber
omittedField :: Maybe SnapshotNumber
FromJSON, Typeable SnapshotNumber
Typeable SnapshotNumber =>
(SnapshotNumber -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy SnapshotNumber -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SnapshotNumber] -> Size)
-> ToCBOR SnapshotNumber
SnapshotNumber -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SnapshotNumber] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SnapshotNumber -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SnapshotNumber -> Encoding
toCBOR :: SnapshotNumber -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SnapshotNumber -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SnapshotNumber -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SnapshotNumber] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SnapshotNumber] -> Size
ToCBOR, Typeable SnapshotNumber
Typeable SnapshotNumber =>
(forall s. Decoder s SnapshotNumber)
-> (Proxy SnapshotNumber -> Text) -> FromCBOR SnapshotNumber
Proxy SnapshotNumber -> Text
forall s. Decoder s SnapshotNumber
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s SnapshotNumber
fromCBOR :: forall s. Decoder s SnapshotNumber
$clabel :: Proxy SnapshotNumber -> Text
label :: Proxy SnapshotNumber -> Text
FromCBOR, Num SnapshotNumber
Ord SnapshotNumber
(Num SnapshotNumber, Ord SnapshotNumber) =>
(SnapshotNumber -> Rational) -> Real SnapshotNumber
SnapshotNumber -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: SnapshotNumber -> Rational
toRational :: SnapshotNumber -> Rational
Real, Integer -> SnapshotNumber
SnapshotNumber -> SnapshotNumber
SnapshotNumber -> SnapshotNumber -> SnapshotNumber
(SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber)
-> (Integer -> SnapshotNumber)
-> Num SnapshotNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
+ :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$c- :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
- :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$c* :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
* :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$cnegate :: SnapshotNumber -> SnapshotNumber
negate :: SnapshotNumber -> SnapshotNumber
$cabs :: SnapshotNumber -> SnapshotNumber
abs :: SnapshotNumber -> SnapshotNumber
$csignum :: SnapshotNumber -> SnapshotNumber
signum :: SnapshotNumber -> SnapshotNumber
$cfromInteger :: Integer -> SnapshotNumber
fromInteger :: Integer -> SnapshotNumber
Num, Int -> SnapshotNumber
SnapshotNumber -> Int
SnapshotNumber -> [SnapshotNumber]
SnapshotNumber -> SnapshotNumber
SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
SnapshotNumber
-> SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
(SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber)
-> (Int -> SnapshotNumber)
-> (SnapshotNumber -> Int)
-> (SnapshotNumber -> [SnapshotNumber])
-> (SnapshotNumber -> SnapshotNumber -> [SnapshotNumber])
-> (SnapshotNumber -> SnapshotNumber -> [SnapshotNumber])
-> (SnapshotNumber
    -> SnapshotNumber -> SnapshotNumber -> [SnapshotNumber])
-> Enum SnapshotNumber
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SnapshotNumber -> SnapshotNumber
succ :: SnapshotNumber -> SnapshotNumber
$cpred :: SnapshotNumber -> SnapshotNumber
pred :: SnapshotNumber -> SnapshotNumber
$ctoEnum :: Int -> SnapshotNumber
toEnum :: Int -> SnapshotNumber
$cfromEnum :: SnapshotNumber -> Int
fromEnum :: SnapshotNumber -> Int
$cenumFrom :: SnapshotNumber -> [SnapshotNumber]
enumFrom :: SnapshotNumber -> [SnapshotNumber]
$cenumFromThen :: SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
enumFromThen :: SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
$cenumFromTo :: SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
enumFromTo :: SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
$cenumFromThenTo :: SnapshotNumber
-> SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
enumFromThenTo :: SnapshotNumber
-> SnapshotNumber -> SnapshotNumber -> [SnapshotNumber]
Enum, Enum SnapshotNumber
Real SnapshotNumber
(Real SnapshotNumber, Enum SnapshotNumber) =>
(SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber -> SnapshotNumber -> SnapshotNumber)
-> (SnapshotNumber
    -> SnapshotNumber -> (SnapshotNumber, SnapshotNumber))
-> (SnapshotNumber
    -> SnapshotNumber -> (SnapshotNumber, SnapshotNumber))
-> (SnapshotNumber -> Integer)
-> Integral SnapshotNumber
SnapshotNumber -> Integer
SnapshotNumber
-> SnapshotNumber -> (SnapshotNumber, SnapshotNumber)
SnapshotNumber -> SnapshotNumber -> SnapshotNumber
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
quot :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$crem :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
rem :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$cdiv :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
div :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$cmod :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
mod :: SnapshotNumber -> SnapshotNumber -> SnapshotNumber
$cquotRem :: SnapshotNumber
-> SnapshotNumber -> (SnapshotNumber, SnapshotNumber)
quotRem :: SnapshotNumber
-> SnapshotNumber -> (SnapshotNumber, SnapshotNumber)
$cdivMod :: SnapshotNumber
-> SnapshotNumber -> (SnapshotNumber, SnapshotNumber)
divMod :: SnapshotNumber
-> SnapshotNumber -> (SnapshotNumber, SnapshotNumber)
$ctoInteger :: SnapshotNumber -> Integer
toInteger :: SnapshotNumber -> Integer
Integral, Gen SnapshotNumber
Gen SnapshotNumber
-> (SnapshotNumber -> [SnapshotNumber]) -> Arbitrary SnapshotNumber
SnapshotNumber -> [SnapshotNumber]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SnapshotNumber
arbitrary :: Gen SnapshotNumber
$cshrink :: SnapshotNumber -> [SnapshotNumber]
shrink :: SnapshotNumber -> [SnapshotNumber]
Arbitrary)

-- NOTE: On-chain scripts ensure snapshot number does not become negative.
fromChainSnapshotNumber :: Onchain.SnapshotNumber -> SnapshotNumber
fromChainSnapshotNumber :: Integer -> SnapshotNumber
fromChainSnapshotNumber =
  Natural -> SnapshotNumber
UnsafeSnapshotNumber (Natural -> SnapshotNumber)
-> (Integer -> Natural) -> Integer -> SnapshotNumber
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
0 (Maybe Natural -> Natural)
-> (Integer -> Maybe Natural) -> Integer -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Natural
integerToNatural

newtype SnapshotVersion
  = UnsafeSnapshotVersion Natural
  deriving stock (SnapshotVersion -> SnapshotVersion -> Bool
(SnapshotVersion -> SnapshotVersion -> Bool)
-> (SnapshotVersion -> SnapshotVersion -> Bool)
-> Eq SnapshotVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SnapshotVersion -> SnapshotVersion -> Bool
== :: SnapshotVersion -> SnapshotVersion -> Bool
$c/= :: SnapshotVersion -> SnapshotVersion -> Bool
/= :: SnapshotVersion -> SnapshotVersion -> Bool
Eq, Eq SnapshotVersion
Eq SnapshotVersion =>
(SnapshotVersion -> SnapshotVersion -> Ordering)
-> (SnapshotVersion -> SnapshotVersion -> Bool)
-> (SnapshotVersion -> SnapshotVersion -> Bool)
-> (SnapshotVersion -> SnapshotVersion -> Bool)
-> (SnapshotVersion -> SnapshotVersion -> Bool)
-> (SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> Ord SnapshotVersion
SnapshotVersion -> SnapshotVersion -> Bool
SnapshotVersion -> SnapshotVersion -> Ordering
SnapshotVersion -> SnapshotVersion -> SnapshotVersion
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 :: SnapshotVersion -> SnapshotVersion -> Ordering
compare :: SnapshotVersion -> SnapshotVersion -> Ordering
$c< :: SnapshotVersion -> SnapshotVersion -> Bool
< :: SnapshotVersion -> SnapshotVersion -> Bool
$c<= :: SnapshotVersion -> SnapshotVersion -> Bool
<= :: SnapshotVersion -> SnapshotVersion -> Bool
$c> :: SnapshotVersion -> SnapshotVersion -> Bool
> :: SnapshotVersion -> SnapshotVersion -> Bool
$c>= :: SnapshotVersion -> SnapshotVersion -> Bool
>= :: SnapshotVersion -> SnapshotVersion -> Bool
$cmax :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
max :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$cmin :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
min :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
Ord, (forall x. SnapshotVersion -> Rep SnapshotVersion x)
-> (forall x. Rep SnapshotVersion x -> SnapshotVersion)
-> Generic SnapshotVersion
forall x. Rep SnapshotVersion x -> SnapshotVersion
forall x. SnapshotVersion -> Rep SnapshotVersion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SnapshotVersion -> Rep SnapshotVersion x
from :: forall x. SnapshotVersion -> Rep SnapshotVersion x
$cto :: forall x. Rep SnapshotVersion x -> SnapshotVersion
to :: forall x. Rep SnapshotVersion x -> SnapshotVersion
Generic)
  deriving newtype (Int -> SnapshotVersion -> ShowS
[SnapshotVersion] -> ShowS
SnapshotVersion -> String
(Int -> SnapshotVersion -> ShowS)
-> (SnapshotVersion -> String)
-> ([SnapshotVersion] -> ShowS)
-> Show SnapshotVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SnapshotVersion -> ShowS
showsPrec :: Int -> SnapshotVersion -> ShowS
$cshow :: SnapshotVersion -> String
show :: SnapshotVersion -> String
$cshowList :: [SnapshotVersion] -> ShowS
showList :: [SnapshotVersion] -> ShowS
Show, [SnapshotVersion] -> Value
[SnapshotVersion] -> Encoding
SnapshotVersion -> Bool
SnapshotVersion -> Value
SnapshotVersion -> Encoding
(SnapshotVersion -> Value)
-> (SnapshotVersion -> Encoding)
-> ([SnapshotVersion] -> Value)
-> ([SnapshotVersion] -> Encoding)
-> (SnapshotVersion -> Bool)
-> ToJSON SnapshotVersion
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: SnapshotVersion -> Value
toJSON :: SnapshotVersion -> Value
$ctoEncoding :: SnapshotVersion -> Encoding
toEncoding :: SnapshotVersion -> Encoding
$ctoJSONList :: [SnapshotVersion] -> Value
toJSONList :: [SnapshotVersion] -> Value
$ctoEncodingList :: [SnapshotVersion] -> Encoding
toEncodingList :: [SnapshotVersion] -> Encoding
$comitField :: SnapshotVersion -> Bool
omitField :: SnapshotVersion -> Bool
ToJSON, Maybe SnapshotVersion
Value -> Parser [SnapshotVersion]
Value -> Parser SnapshotVersion
(Value -> Parser SnapshotVersion)
-> (Value -> Parser [SnapshotVersion])
-> Maybe SnapshotVersion
-> FromJSON SnapshotVersion
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser SnapshotVersion
parseJSON :: Value -> Parser SnapshotVersion
$cparseJSONList :: Value -> Parser [SnapshotVersion]
parseJSONList :: Value -> Parser [SnapshotVersion]
$comittedField :: Maybe SnapshotVersion
omittedField :: Maybe SnapshotVersion
FromJSON, Typeable SnapshotVersion
Typeable SnapshotVersion =>
(SnapshotVersion -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy SnapshotVersion -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SnapshotVersion] -> Size)
-> ToCBOR SnapshotVersion
SnapshotVersion -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SnapshotVersion] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SnapshotVersion -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SnapshotVersion -> Encoding
toCBOR :: SnapshotVersion -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SnapshotVersion -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SnapshotVersion -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SnapshotVersion] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SnapshotVersion] -> Size
ToCBOR, Typeable SnapshotVersion
Typeable SnapshotVersion =>
(forall s. Decoder s SnapshotVersion)
-> (Proxy SnapshotVersion -> Text) -> FromCBOR SnapshotVersion
Proxy SnapshotVersion -> Text
forall s. Decoder s SnapshotVersion
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s SnapshotVersion
fromCBOR :: forall s. Decoder s SnapshotVersion
$clabel :: Proxy SnapshotVersion -> Text
label :: Proxy SnapshotVersion -> Text
FromCBOR, Num SnapshotVersion
Ord SnapshotVersion
(Num SnapshotVersion, Ord SnapshotVersion) =>
(SnapshotVersion -> Rational) -> Real SnapshotVersion
SnapshotVersion -> Rational
forall a. (Num a, Ord a) => (a -> Rational) -> Real a
$ctoRational :: SnapshotVersion -> Rational
toRational :: SnapshotVersion -> Rational
Real, Integer -> SnapshotVersion
SnapshotVersion -> SnapshotVersion
SnapshotVersion -> SnapshotVersion -> SnapshotVersion
(SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion)
-> (Integer -> SnapshotVersion)
-> Num SnapshotVersion
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
+ :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$c- :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
- :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$c* :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
* :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$cnegate :: SnapshotVersion -> SnapshotVersion
negate :: SnapshotVersion -> SnapshotVersion
$cabs :: SnapshotVersion -> SnapshotVersion
abs :: SnapshotVersion -> SnapshotVersion
$csignum :: SnapshotVersion -> SnapshotVersion
signum :: SnapshotVersion -> SnapshotVersion
$cfromInteger :: Integer -> SnapshotVersion
fromInteger :: Integer -> SnapshotVersion
Num, Int -> SnapshotVersion
SnapshotVersion -> Int
SnapshotVersion -> [SnapshotVersion]
SnapshotVersion -> SnapshotVersion
SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
SnapshotVersion
-> SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
(SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion)
-> (Int -> SnapshotVersion)
-> (SnapshotVersion -> Int)
-> (SnapshotVersion -> [SnapshotVersion])
-> (SnapshotVersion -> SnapshotVersion -> [SnapshotVersion])
-> (SnapshotVersion -> SnapshotVersion -> [SnapshotVersion])
-> (SnapshotVersion
    -> SnapshotVersion -> SnapshotVersion -> [SnapshotVersion])
-> Enum SnapshotVersion
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SnapshotVersion -> SnapshotVersion
succ :: SnapshotVersion -> SnapshotVersion
$cpred :: SnapshotVersion -> SnapshotVersion
pred :: SnapshotVersion -> SnapshotVersion
$ctoEnum :: Int -> SnapshotVersion
toEnum :: Int -> SnapshotVersion
$cfromEnum :: SnapshotVersion -> Int
fromEnum :: SnapshotVersion -> Int
$cenumFrom :: SnapshotVersion -> [SnapshotVersion]
enumFrom :: SnapshotVersion -> [SnapshotVersion]
$cenumFromThen :: SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
enumFromThen :: SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
$cenumFromTo :: SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
enumFromTo :: SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
$cenumFromThenTo :: SnapshotVersion
-> SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
enumFromThenTo :: SnapshotVersion
-> SnapshotVersion -> SnapshotVersion -> [SnapshotVersion]
Enum, Enum SnapshotVersion
Real SnapshotVersion
(Real SnapshotVersion, Enum SnapshotVersion) =>
(SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion -> SnapshotVersion -> SnapshotVersion)
-> (SnapshotVersion
    -> SnapshotVersion -> (SnapshotVersion, SnapshotVersion))
-> (SnapshotVersion
    -> SnapshotVersion -> (SnapshotVersion, SnapshotVersion))
-> (SnapshotVersion -> Integer)
-> Integral SnapshotVersion
SnapshotVersion -> Integer
SnapshotVersion
-> SnapshotVersion -> (SnapshotVersion, SnapshotVersion)
SnapshotVersion -> SnapshotVersion -> SnapshotVersion
forall a.
(Real a, Enum a) =>
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
$cquot :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
quot :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$crem :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
rem :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$cdiv :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
div :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$cmod :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
mod :: SnapshotVersion -> SnapshotVersion -> SnapshotVersion
$cquotRem :: SnapshotVersion
-> SnapshotVersion -> (SnapshotVersion, SnapshotVersion)
quotRem :: SnapshotVersion
-> SnapshotVersion -> (SnapshotVersion, SnapshotVersion)
$cdivMod :: SnapshotVersion
-> SnapshotVersion -> (SnapshotVersion, SnapshotVersion)
divMod :: SnapshotVersion
-> SnapshotVersion -> (SnapshotVersion, SnapshotVersion)
$ctoInteger :: SnapshotVersion -> Integer
toInteger :: SnapshotVersion -> Integer
Integral, Gen SnapshotVersion
Gen SnapshotVersion
-> (SnapshotVersion -> [SnapshotVersion])
-> Arbitrary SnapshotVersion
SnapshotVersion -> [SnapshotVersion]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen SnapshotVersion
arbitrary :: Gen SnapshotVersion
$cshrink :: SnapshotVersion -> [SnapshotVersion]
shrink :: SnapshotVersion -> [SnapshotVersion]
Arbitrary)

-- NOTE: On-chain scripts ensure snapshot version does not become negative.
fromChainSnapshotVersion :: Onchain.SnapshotVersion -> SnapshotVersion
fromChainSnapshotVersion :: Integer -> SnapshotVersion
fromChainSnapshotVersion =
  Natural -> SnapshotVersion
UnsafeSnapshotVersion (Natural -> SnapshotVersion)
-> (Integer -> Natural) -> Integer -> SnapshotVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Maybe Natural -> Natural
forall a. a -> Maybe a -> a
fromMaybe Natural
0 (Maybe Natural -> Natural)
-> (Integer -> Maybe Natural) -> Integer -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Maybe Natural
integerToNatural

-- * Snapshot

data Snapshot tx = Snapshot
  { forall tx. Snapshot tx -> HeadId
headId :: HeadId
  , forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
  -- ^ Open state version this snapshot is based on. Spec: v
  , forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
  -- ^ Monotonically increasing snapshot number. Spec: s
  , forall tx. Snapshot tx -> [tx]
confirmed :: [tx]
  -- ^ The set of transactions that lead to 'utxo'. Spec: T
  , forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
  -- ^ Snaspshotted UTxO set. Spec: U
  , forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
  -- ^ UTxO to be committed. Spec: Uα
  , forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
  -- ^ UTxO to be decommitted. Spec: Uω
  }
  deriving stock ((forall x. Snapshot tx -> Rep (Snapshot tx) x)
-> (forall x. Rep (Snapshot tx) x -> Snapshot tx)
-> Generic (Snapshot tx)
forall x. Rep (Snapshot tx) x -> Snapshot tx
forall x. Snapshot tx -> Rep (Snapshot tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (Snapshot tx) x -> Snapshot tx
forall tx x. Snapshot tx -> Rep (Snapshot tx) x
$cfrom :: forall tx x. Snapshot tx -> Rep (Snapshot tx) x
from :: forall x. Snapshot tx -> Rep (Snapshot tx) x
$cto :: forall tx x. Rep (Snapshot tx) x -> Snapshot tx
to :: forall x. Rep (Snapshot tx) x -> Snapshot tx
Generic)

deriving stock instance IsTx tx => Eq (Snapshot tx)
deriving stock instance IsTx tx => Show (Snapshot tx)

-- | Binary representation of snapshot signatures. That is, concatenated CBOR for
-- 'headId', 'version', 'number', 'utxoHash' and 'utxoToDecommitHash' according
-- to CDDL schemata:
--
-- headId = bytes .size 16
-- version = uint
-- number = uint
-- utxoHash = bytes
-- utxoToCommitHash = bytes
-- utxoToDecommitHash = bytes
--
-- where hashes are the result of applying 'hashUTxO'.
instance forall tx. IsTx tx => SignableRepresentation (Snapshot tx) where
  getSignableRepresentation :: Snapshot tx -> ByteString
getSignableRepresentation Snapshot{HeadId
$sel:headId:Snapshot :: forall tx. Snapshot tx -> HeadId
headId :: HeadId
headId, SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
version, SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, UTxOType tx
utxo :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo, Maybe (UTxOType tx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit} =
    ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
      Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise (BuiltinByteString -> Data
forall a. ToData a => a -> Data
toData (BuiltinByteString -> Data)
-> (ByteString -> BuiltinByteString) -> ByteString -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> Data) -> ByteString -> Data
forall a b. (a -> b) -> a -> b
$ HeadId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes HeadId
headId)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Integer -> Data
forall a. ToData a => a -> Data
toData (Integer -> Data) -> (Integer -> Integer) -> Integer -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
Integer -> ToBuiltin Integer
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (Integer -> Data) -> Integer -> Data
forall a b. (a -> b) -> a -> b
$ SnapshotVersion -> Integer
forall a. Integral a => a -> Integer
toInteger SnapshotVersion
version)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise (Integer -> Data
forall a. ToData a => a -> Data
toData (Integer -> Data) -> (Integer -> Integer) -> Integer -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
Integer -> ToBuiltin Integer
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (Integer -> Data) -> Integer -> Data
forall a b. (a -> b) -> a -> b
$ SnapshotNumber -> Integer
forall a. Integral a => a -> Integer
toInteger SnapshotNumber
number)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise (BuiltinByteString -> Data
forall a. ToData a => a -> Data
toData (BuiltinByteString -> Data)
-> (ByteString -> BuiltinByteString) -> ByteString -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> Data) -> ByteString -> Data
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @tx UTxOType tx
utxo)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise (BuiltinByteString -> Data
forall a. ToData a => a -> Data
toData (BuiltinByteString -> Data)
-> (UTxOType tx -> BuiltinByteString) -> UTxOType tx -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (UTxOType tx -> ByteString) -> UTxOType tx -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @tx (UTxOType tx -> Data) -> UTxOType tx -> Data
forall a b. (a -> b) -> a -> b
$ UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToCommit)
        ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Data -> ByteString
forall a. Serialise a => a -> ByteString
serialise (BuiltinByteString -> Data
forall a. ToData a => a -> Data
toData (BuiltinByteString -> Data)
-> (UTxOType tx -> BuiltinByteString) -> UTxOType tx -> Data
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (UTxOType tx -> ByteString) -> UTxOType tx -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @tx (UTxOType tx -> Data) -> UTxOType tx -> Data
forall a b. (a -> b) -> a -> b
$ UTxOType tx -> Maybe (UTxOType tx) -> UTxOType tx
forall a. a -> Maybe a -> a
fromMaybe UTxOType tx
forall a. Monoid a => a
mempty Maybe (UTxOType tx)
utxoToDecommit)

instance IsTx tx => ToJSON (Snapshot tx) where
  toJSON :: Snapshot tx -> Value
toJSON Snapshot{HeadId
$sel:headId:Snapshot :: forall tx. Snapshot tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, UTxOType tx
utxo :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo, [tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [tx]
confirmed, Maybe (UTxOType tx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit, SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
version} =
    [Pair] -> Value
object
      [ Key
"headId" Key -> HeadId -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= HeadId
headId
      , Key
"version" Key -> SnapshotVersion -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapshotVersion
version
      , Key
"number" Key -> SnapshotNumber -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= SnapshotNumber
number
      , Key
"confirmed" Key -> [tx] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [tx]
confirmed
      , Key
"utxo" Key -> UTxOType tx -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= UTxOType tx
utxo
      , Key
"utxoToCommit" Key -> Maybe (UTxOType tx) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe (UTxOType tx)
utxoToCommit
      , Key
"utxoToDecommit" Key -> Maybe (UTxOType tx) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe (UTxOType tx)
utxoToDecommit
      ]

instance IsTx tx => FromJSON (Snapshot tx) where
  parseJSON :: Value -> Parser (Snapshot tx)
parseJSON = String
-> (Object -> Parser (Snapshot tx))
-> Value
-> Parser (Snapshot tx)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Snapshot" ((Object -> Parser (Snapshot tx)) -> Value -> Parser (Snapshot tx))
-> (Object -> Parser (Snapshot tx))
-> Value
-> Parser (Snapshot tx)
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
    HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> Snapshot tx
forall tx.
HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> Snapshot tx
Snapshot
      (HeadId
 -> SnapshotVersion
 -> SnapshotNumber
 -> [tx]
 -> UTxOType tx
 -> Maybe (UTxOType tx)
 -> Maybe (UTxOType tx)
 -> Snapshot tx)
-> Parser HeadId
-> Parser
     (SnapshotVersion
      -> SnapshotNumber
      -> [tx]
      -> UTxOType tx
      -> Maybe (UTxOType tx)
      -> Maybe (UTxOType tx)
      -> Snapshot tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj Object -> Key -> Parser HeadId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"headId")
      Parser
  (SnapshotVersion
   -> SnapshotNumber
   -> [tx]
   -> UTxOType tx
   -> Maybe (UTxOType tx)
   -> Maybe (UTxOType tx)
   -> Snapshot tx)
-> Parser SnapshotVersion
-> Parser
     (SnapshotNumber
      -> [tx]
      -> UTxOType tx
      -> Maybe (UTxOType tx)
      -> Maybe (UTxOType tx)
      -> Snapshot tx)
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 SnapshotVersion
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version")
      Parser
  (SnapshotNumber
   -> [tx]
   -> UTxOType tx
   -> Maybe (UTxOType tx)
   -> Maybe (UTxOType tx)
   -> Snapshot tx)
-> Parser SnapshotNumber
-> Parser
     ([tx]
      -> UTxOType tx
      -> Maybe (UTxOType tx)
      -> Maybe (UTxOType tx)
      -> Snapshot tx)
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 SnapshotNumber
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number")
      Parser
  ([tx]
   -> UTxOType tx
   -> Maybe (UTxOType tx)
   -> Maybe (UTxOType tx)
   -> Snapshot tx)
-> Parser [tx]
-> Parser
     (UTxOType tx
      -> Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
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 [tx]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"confirmed")
      Parser
  (UTxOType tx
   -> Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
-> Parser (UTxOType tx)
-> Parser
     (Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
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 (UTxOType tx)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"utxo")
      Parser (Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
-> Parser (Maybe (UTxOType tx))
-> Parser (Maybe (UTxOType tx) -> Snapshot tx)
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 (Maybe (Maybe (UTxOType tx)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"utxoToCommit" Parser (Maybe (Maybe (UTxOType tx)))
-> (Maybe (Maybe (UTxOType tx)) -> Parser (Maybe (UTxOType tx)))
-> Parser (Maybe (UTxOType tx))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe (Maybe (UTxOType tx))
Nothing -> Maybe (UTxOType tx) -> Parser (Maybe (UTxOType tx))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UTxOType tx)
forall a. Monoid a => a
mempty
              (Just Maybe (UTxOType tx)
utxo) -> Maybe (UTxOType tx) -> Parser (Maybe (UTxOType tx))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UTxOType tx)
utxo
          )
      Parser (Maybe (UTxOType tx) -> Snapshot tx)
-> Parser (Maybe (UTxOType tx)) -> Parser (Snapshot tx)
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 (Maybe (Maybe (UTxOType tx)))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"utxoToDecommit" Parser (Maybe (Maybe (UTxOType tx)))
-> (Maybe (Maybe (UTxOType tx)) -> Parser (Maybe (UTxOType tx)))
-> Parser (Maybe (UTxOType tx))
forall a b. Parser a -> (a -> Parser b) -> Parser b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
              Maybe (Maybe (UTxOType tx))
Nothing -> Maybe (UTxOType tx) -> Parser (Maybe (UTxOType tx))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UTxOType tx)
forall a. Monoid a => a
mempty
              (Just Maybe (UTxOType tx)
utxo) -> Maybe (UTxOType tx) -> Parser (Maybe (UTxOType tx))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UTxOType tx)
utxo
          )

instance (Typeable tx, ToCBOR tx, ToCBOR (UTxOType tx)) => ToCBOR (Snapshot tx) where
  toCBOR :: Snapshot tx -> Encoding
toCBOR Snapshot{HeadId
$sel:headId:Snapshot :: forall tx. Snapshot tx -> HeadId
headId :: HeadId
headId, SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, UTxOType tx
utxo :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo, [tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [tx]
confirmed, Maybe (UTxOType tx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit, SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
version} =
    HeadId -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR HeadId
headId
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapshotVersion -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapshotVersion
version
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapshotNumber
number
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [tx] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR [tx]
confirmed
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> UTxOType tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxOType tx
utxo
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (UTxOType tx) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (UTxOType tx)
utxoToCommit
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Maybe (UTxOType tx) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (UTxOType tx)
utxoToDecommit

instance (Typeable tx, FromCBOR tx, FromCBOR (UTxOType tx)) => FromCBOR (Snapshot tx) where
  fromCBOR :: forall s. Decoder s (Snapshot tx)
fromCBOR =
    HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> Snapshot tx
forall tx.
HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> Snapshot tx
Snapshot
      (HeadId
 -> SnapshotVersion
 -> SnapshotNumber
 -> [tx]
 -> UTxOType tx
 -> Maybe (UTxOType tx)
 -> Maybe (UTxOType tx)
 -> Snapshot tx)
-> Decoder s HeadId
-> Decoder
     s
     (SnapshotVersion
      -> SnapshotNumber
      -> [tx]
      -> UTxOType tx
      -> Maybe (UTxOType tx)
      -> Maybe (UTxOType tx)
      -> Snapshot tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s HeadId
forall s. Decoder s HeadId
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (SnapshotVersion
   -> SnapshotNumber
   -> [tx]
   -> UTxOType tx
   -> Maybe (UTxOType tx)
   -> Maybe (UTxOType tx)
   -> Snapshot tx)
-> Decoder s SnapshotVersion
-> Decoder
     s
     (SnapshotNumber
      -> [tx]
      -> UTxOType tx
      -> Maybe (UTxOType tx)
      -> Maybe (UTxOType tx)
      -> Snapshot tx)
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 SnapshotVersion
forall s. Decoder s SnapshotVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (SnapshotNumber
   -> [tx]
   -> UTxOType tx
   -> Maybe (UTxOType tx)
   -> Maybe (UTxOType tx)
   -> Snapshot tx)
-> Decoder s SnapshotNumber
-> Decoder
     s
     ([tx]
      -> UTxOType tx
      -> Maybe (UTxOType tx)
      -> Maybe (UTxOType tx)
      -> Snapshot tx)
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 SnapshotNumber
forall s. Decoder s SnapshotNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  ([tx]
   -> UTxOType tx
   -> Maybe (UTxOType tx)
   -> Maybe (UTxOType tx)
   -> Snapshot tx)
-> Decoder s [tx]
-> Decoder
     s
     (UTxOType tx
      -> Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
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 [tx]
forall s. Decoder s [tx]
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s
  (UTxOType tx
   -> Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
-> Decoder s (UTxOType tx)
-> Decoder
     s (Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
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 (UTxOType tx)
forall s. Decoder s (UTxOType tx)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder
  s (Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> Snapshot tx)
-> Decoder s (Maybe (UTxOType tx))
-> Decoder s (Maybe (UTxOType tx) -> Snapshot tx)
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 (Maybe (UTxOType tx))
forall s. Decoder s (Maybe (UTxOType tx))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Decoder s (Maybe (UTxOType tx) -> Snapshot tx)
-> Decoder s (Maybe (UTxOType tx)) -> Decoder s (Snapshot tx)
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 (Maybe (UTxOType tx))
forall s. Decoder s (Maybe (UTxOType tx))
forall a s. FromCBOR a => Decoder s a
fromCBOR

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

  -- NOTE: See note on 'Arbitrary (ClientInput tx)'
  shrink :: Snapshot tx -> [Snapshot tx]
shrink Snapshot{HeadId
$sel:headId:Snapshot :: forall tx. Snapshot tx -> HeadId
headId :: HeadId
headId, SnapshotVersion
$sel:version:Snapshot :: forall tx. Snapshot tx -> SnapshotVersion
version :: SnapshotVersion
version, SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, UTxOType tx
utxo :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo, [tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [tx]
confirmed, Maybe (UTxOType tx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit} =
    [ HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> Snapshot tx
forall tx.
HeadId
-> SnapshotVersion
-> SnapshotNumber
-> [tx]
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> Snapshot tx
Snapshot HeadId
headId SnapshotVersion
version SnapshotNumber
number [tx]
confirmed' UTxOType tx
utxo' Maybe (UTxOType tx)
utxoToCommit' Maybe (UTxOType tx)
utxoToDecommit'
    | [tx]
confirmed' <- [tx] -> [[tx]]
forall a. Arbitrary a => a -> [a]
shrink [tx]
confirmed
    , UTxOType tx
utxo' <- UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
utxo
    , Maybe (UTxOType tx)
utxoToCommit' <- Maybe (UTxOType tx) -> [Maybe (UTxOType tx)]
forall a. Arbitrary a => a -> [a]
shrink Maybe (UTxOType tx)
utxoToCommit
    , Maybe (UTxOType tx)
utxoToDecommit' <- Maybe (UTxOType tx) -> [Maybe (UTxOType tx)]
forall a. Arbitrary a => a -> [a]
shrink Maybe (UTxOType tx)
utxoToDecommit
    ]

-- * ConfirmedSnapshot

-- | A snapshot that can be used to close a head with. Either the initial one,
-- or when it was signed by all parties, i.e. it is confirmed.
data ConfirmedSnapshot tx
  = InitialSnapshot
      { -- XXX: 'headId' is actually unused. Only 'getSnapshot' forces this to exist.
        forall tx. ConfirmedSnapshot tx -> HeadId
headId :: HeadId
      , forall tx. ConfirmedSnapshot tx -> UTxOType tx
initialUTxO :: UTxOType tx
      }
  | ConfirmedSnapshot
      { forall tx. ConfirmedSnapshot tx -> Snapshot tx
snapshot :: Snapshot tx
      , forall tx. ConfirmedSnapshot tx -> MultiSignature (Snapshot tx)
signatures :: MultiSignature (Snapshot tx)
      }
  deriving stock ((forall x. ConfirmedSnapshot tx -> Rep (ConfirmedSnapshot tx) x)
-> (forall x. Rep (ConfirmedSnapshot tx) x -> ConfirmedSnapshot tx)
-> Generic (ConfirmedSnapshot tx)
forall x. Rep (ConfirmedSnapshot tx) x -> ConfirmedSnapshot tx
forall x. ConfirmedSnapshot tx -> Rep (ConfirmedSnapshot tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (ConfirmedSnapshot tx) x -> ConfirmedSnapshot tx
forall tx x. ConfirmedSnapshot tx -> Rep (ConfirmedSnapshot tx) x
$cfrom :: forall tx x. ConfirmedSnapshot tx -> Rep (ConfirmedSnapshot tx) x
from :: forall x. ConfirmedSnapshot tx -> Rep (ConfirmedSnapshot tx) x
$cto :: forall tx x. Rep (ConfirmedSnapshot tx) x -> ConfirmedSnapshot tx
to :: forall x. Rep (ConfirmedSnapshot tx) x -> ConfirmedSnapshot tx
Generic, ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool
(ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool)
-> (ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool)
-> Eq (ConfirmedSnapshot tx)
forall tx.
IsTx tx =>
ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall tx.
IsTx tx =>
ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool
== :: ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool
$c/= :: forall tx.
IsTx tx =>
ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool
/= :: ConfirmedSnapshot tx -> ConfirmedSnapshot tx -> Bool
Eq, Int -> ConfirmedSnapshot tx -> ShowS
[ConfirmedSnapshot tx] -> ShowS
ConfirmedSnapshot tx -> String
(Int -> ConfirmedSnapshot tx -> ShowS)
-> (ConfirmedSnapshot tx -> String)
-> ([ConfirmedSnapshot tx] -> ShowS)
-> Show (ConfirmedSnapshot tx)
forall tx. IsTx tx => Int -> ConfirmedSnapshot tx -> ShowS
forall tx. IsTx tx => [ConfirmedSnapshot tx] -> ShowS
forall tx. IsTx tx => ConfirmedSnapshot tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall tx. IsTx tx => Int -> ConfirmedSnapshot tx -> ShowS
showsPrec :: Int -> ConfirmedSnapshot tx -> ShowS
$cshow :: forall tx. IsTx tx => ConfirmedSnapshot tx -> String
show :: ConfirmedSnapshot tx -> String
$cshowList :: forall tx. IsTx tx => [ConfirmedSnapshot tx] -> ShowS
showList :: [ConfirmedSnapshot tx] -> ShowS
Show)
  deriving anyclass ([ConfirmedSnapshot tx] -> Value
[ConfirmedSnapshot tx] -> Encoding
ConfirmedSnapshot tx -> Bool
ConfirmedSnapshot tx -> Value
ConfirmedSnapshot tx -> Encoding
(ConfirmedSnapshot tx -> Value)
-> (ConfirmedSnapshot tx -> Encoding)
-> ([ConfirmedSnapshot tx] -> Value)
-> ([ConfirmedSnapshot tx] -> Encoding)
-> (ConfirmedSnapshot tx -> Bool)
-> ToJSON (ConfirmedSnapshot tx)
forall tx. IsTx tx => [ConfirmedSnapshot tx] -> Value
forall tx. IsTx tx => [ConfirmedSnapshot tx] -> Encoding
forall tx. IsTx tx => ConfirmedSnapshot tx -> Bool
forall tx. IsTx tx => ConfirmedSnapshot tx -> Value
forall tx. IsTx tx => ConfirmedSnapshot tx -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: forall tx. IsTx tx => ConfirmedSnapshot tx -> Value
toJSON :: ConfirmedSnapshot tx -> Value
$ctoEncoding :: forall tx. IsTx tx => ConfirmedSnapshot tx -> Encoding
toEncoding :: ConfirmedSnapshot tx -> Encoding
$ctoJSONList :: forall tx. IsTx tx => [ConfirmedSnapshot tx] -> Value
toJSONList :: [ConfirmedSnapshot tx] -> Value
$ctoEncodingList :: forall tx. IsTx tx => [ConfirmedSnapshot tx] -> Encoding
toEncodingList :: [ConfirmedSnapshot tx] -> Encoding
$comitField :: forall tx. IsTx tx => ConfirmedSnapshot tx -> Bool
omitField :: ConfirmedSnapshot tx -> Bool
ToJSON, Maybe (ConfirmedSnapshot tx)
Value -> Parser [ConfirmedSnapshot tx]
Value -> Parser (ConfirmedSnapshot tx)
(Value -> Parser (ConfirmedSnapshot tx))
-> (Value -> Parser [ConfirmedSnapshot tx])
-> Maybe (ConfirmedSnapshot tx)
-> FromJSON (ConfirmedSnapshot tx)
forall tx. IsTx tx => Maybe (ConfirmedSnapshot tx)
forall tx. IsTx tx => Value -> Parser [ConfirmedSnapshot tx]
forall tx. IsTx tx => Value -> Parser (ConfirmedSnapshot tx)
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: forall tx. IsTx tx => Value -> Parser (ConfirmedSnapshot tx)
parseJSON :: Value -> Parser (ConfirmedSnapshot tx)
$cparseJSONList :: forall tx. IsTx tx => Value -> Parser [ConfirmedSnapshot tx]
parseJSONList :: Value -> Parser [ConfirmedSnapshot tx]
$comittedField :: forall tx. IsTx tx => Maybe (ConfirmedSnapshot tx)
omittedField :: Maybe (ConfirmedSnapshot tx)
FromJSON)

-- | Safely get a 'Snapshot' from a confirmed snapshot.
--
-- NOTE: While we could use 'snapshot' directly, this is a record-field accessor
-- which may become partial (and lead to unnoticed runtime errors) if we ever
-- add a new branch to the sumtype. So, we explicitely define a getter which
-- will force us into thinking about changing the signature properly if this
-- happens.
getSnapshot :: ConfirmedSnapshot tx -> Snapshot tx
getSnapshot :: forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot = \case
  InitialSnapshot{HeadId
headId :: forall tx. ConfirmedSnapshot tx -> HeadId
headId :: HeadId
headId, UTxOType tx
$sel:initialUTxO:InitialSnapshot :: forall tx. ConfirmedSnapshot tx -> UTxOType tx
initialUTxO :: UTxOType tx
initialUTxO} ->
    Snapshot
      { HeadId
$sel:headId:Snapshot :: HeadId
headId :: HeadId
headId
      , $sel:version:Snapshot :: SnapshotVersion
version = SnapshotVersion
0
      , $sel:number:Snapshot :: SnapshotNumber
number = SnapshotNumber
0
      , $sel:confirmed:Snapshot :: [tx]
confirmed = []
      , utxo :: UTxOType tx
utxo = UTxOType tx
initialUTxO
      , $sel:utxoToCommit:Snapshot :: Maybe (UTxOType tx)
utxoToCommit = Maybe (UTxOType tx)
forall a. Maybe a
Nothing
      , $sel:utxoToDecommit:Snapshot :: Maybe (UTxOType tx)
utxoToDecommit = Maybe (UTxOType tx)
forall a. Maybe a
Nothing
      }
  ConfirmedSnapshot{Snapshot tx
$sel:snapshot:InitialSnapshot :: forall tx. ConfirmedSnapshot tx -> Snapshot tx
snapshot :: Snapshot tx
snapshot} -> Snapshot tx
snapshot

-- | Tell whether a snapshot is the initial snapshot coming from the collect-com
-- transaction.
isInitialSnapshot :: ConfirmedSnapshot tx -> Bool
isInitialSnapshot :: forall tx. ConfirmedSnapshot tx -> Bool
isInitialSnapshot = \case
  InitialSnapshot{} -> Bool
True
  ConfirmedSnapshot{} -> Bool
False

instance (Arbitrary tx, Arbitrary (UTxOType tx), IsTx tx) => Arbitrary (ConfirmedSnapshot tx) where
  arbitrary :: Gen (ConfirmedSnapshot tx)
arbitrary = do
    [SigningKey HydraKey]
ks <- Gen [SigningKey HydraKey]
forall a. Arbitrary a => Gen a
arbitrary
    UTxOType tx
utxo <- Gen (UTxOType tx)
forall a. Arbitrary a => Gen a
arbitrary
    Maybe (UTxOType tx)
utxoToCommit <- Gen (Maybe (UTxOType tx))
forall a. Arbitrary a => Gen a
arbitrary
    Maybe (UTxOType tx)
utxoToDecommit <- Gen (Maybe (UTxOType tx))
forall a. Arbitrary a => Gen a
arbitrary
    HeadId
headId <- Gen HeadId
forall a. Arbitrary a => Gen a
arbitrary
    HeadId
-> SnapshotVersion
-> SnapshotNumber
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> [SigningKey HydraKey]
-> Gen (ConfirmedSnapshot tx)
forall tx.
IsTx tx =>
HeadId
-> SnapshotVersion
-> SnapshotNumber
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> [SigningKey HydraKey]
-> Gen (ConfirmedSnapshot tx)
genConfirmedSnapshot HeadId
headId SnapshotVersion
0 SnapshotNumber
0 UTxOType tx
utxo Maybe (UTxOType tx)
utxoToCommit Maybe (UTxOType tx)
utxoToDecommit [SigningKey HydraKey]
ks

  shrink :: ConfirmedSnapshot tx -> [ConfirmedSnapshot tx]
shrink = \case
    InitialSnapshot HeadId
hid UTxOType tx
sn -> [HeadId -> UTxOType tx -> ConfirmedSnapshot tx
forall tx. HeadId -> UTxOType tx -> ConfirmedSnapshot tx
InitialSnapshot HeadId
hid UTxOType tx
sn' | UTxOType tx
sn' <- UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
sn]
    ConfirmedSnapshot Snapshot tx
sn MultiSignature (Snapshot tx)
sigs -> Snapshot tx -> MultiSignature (Snapshot tx) -> ConfirmedSnapshot tx
forall tx.
Snapshot tx -> MultiSignature (Snapshot tx) -> ConfirmedSnapshot tx
ConfirmedSnapshot (Snapshot tx
 -> MultiSignature (Snapshot tx) -> ConfirmedSnapshot tx)
-> [Snapshot tx]
-> [MultiSignature (Snapshot tx) -> ConfirmedSnapshot tx]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Snapshot tx -> [Snapshot tx]
forall a. Arbitrary a => a -> [a]
shrink Snapshot tx
sn [MultiSignature (Snapshot tx) -> ConfirmedSnapshot tx]
-> [MultiSignature (Snapshot tx)] -> [ConfirmedSnapshot tx]
forall a b. [a -> b] -> [a] -> [b]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MultiSignature (Snapshot tx) -> [MultiSignature (Snapshot tx)]
forall a. Arbitrary a => a -> [a]
shrink MultiSignature (Snapshot tx)
sigs

genConfirmedSnapshot ::
  IsTx tx =>
  HeadId ->
  -- | Exact snapshot version to generate.
  SnapshotVersion ->
  -- | The lower bound on snapshot number to generate.
  -- If this is 0, then we can generate an `InitialSnapshot` or a `ConfirmedSnapshot`.
  -- Otherwise we generate only `ConfirmedSnapshot` with a number strictly superior to
  -- this lower bound.
  SnapshotNumber ->
  UTxOType tx ->
  Maybe (UTxOType tx) ->
  Maybe (UTxOType tx) ->
  [SigningKey HydraKey] ->
  Gen (ConfirmedSnapshot tx)
genConfirmedSnapshot :: forall tx.
IsTx tx =>
HeadId
-> SnapshotVersion
-> SnapshotNumber
-> UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> [SigningKey HydraKey]
-> Gen (ConfirmedSnapshot tx)
genConfirmedSnapshot HeadId
headId SnapshotVersion
version SnapshotNumber
minSn UTxOType tx
utxo Maybe (UTxOType tx)
utxoToCommit Maybe (UTxOType tx)
utxoToDecommit [SigningKey HydraKey]
sks
  | SnapshotNumber
minSn SnapshotNumber -> SnapshotNumber -> Bool
forall a. Ord a => a -> a -> Bool
> SnapshotNumber
0 = Gen (ConfirmedSnapshot tx)
confirmedSnapshot
  | Bool
otherwise =
      [(Int, Gen (ConfirmedSnapshot tx))] -> Gen (ConfirmedSnapshot tx)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
        [ (Int
1, Gen (ConfirmedSnapshot tx)
initialSnapshot)
        , (Int
9, Gen (ConfirmedSnapshot tx)
confirmedSnapshot)
        ]
 where
  initialSnapshot :: Gen (ConfirmedSnapshot tx)
initialSnapshot =
    HeadId -> UTxOType tx -> ConfirmedSnapshot tx
forall tx. HeadId -> UTxOType tx -> ConfirmedSnapshot tx
InitialSnapshot (HeadId -> UTxOType tx -> ConfirmedSnapshot tx)
-> Gen HeadId -> Gen (UTxOType tx -> ConfirmedSnapshot tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen HeadId
forall a. Arbitrary a => Gen a
arbitrary Gen (UTxOType tx -> ConfirmedSnapshot tx)
-> Gen (UTxOType tx) -> Gen (ConfirmedSnapshot tx)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> UTxOType tx -> Gen (UTxOType tx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxOType tx
utxo

  confirmedSnapshot :: Gen (ConfirmedSnapshot tx)
confirmedSnapshot = do
    -- FIXME: This is another nail in the coffin to our current modeling of
    -- snapshots
    SnapshotNumber
number <- Gen SnapshotNumber
forall a. Arbitrary a => Gen a
arbitrary Gen SnapshotNumber
-> (SnapshotNumber -> Bool) -> Gen SnapshotNumber
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (SnapshotNumber -> SnapshotNumber -> Bool
forall a. Ord a => a -> a -> Bool
> SnapshotNumber
minSn)
    let snapshot :: Snapshot tx
snapshot = Snapshot{HeadId
$sel:headId:Snapshot :: HeadId
headId :: HeadId
headId, SnapshotVersion
$sel:version:Snapshot :: SnapshotVersion
version :: SnapshotVersion
version, SnapshotNumber
$sel:number:Snapshot :: SnapshotNumber
number :: SnapshotNumber
number, $sel:confirmed:Snapshot :: [tx]
confirmed = [], UTxOType tx
utxo :: UTxOType tx
utxo :: UTxOType tx
utxo, Maybe (UTxOType tx)
$sel:utxoToCommit:Snapshot :: Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
utxoToCommit, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit}
    let signatures :: MultiSignature (Snapshot tx)
signatures = [Signature (Snapshot tx)] -> MultiSignature (Snapshot tx)
forall {k} (a :: k). [Signature a] -> MultiSignature a
aggregate ([Signature (Snapshot tx)] -> MultiSignature (Snapshot tx))
-> [Signature (Snapshot tx)] -> MultiSignature (Snapshot tx)
forall a b. (a -> b) -> a -> b
$ (SigningKey HydraKey -> Signature (Snapshot tx))
-> [SigningKey HydraKey] -> [Signature (Snapshot tx)]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (SigningKey HydraKey -> Snapshot tx -> Signature (Snapshot tx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
`sign` Snapshot tx
snapshot) [SigningKey HydraKey]
sks
    ConfirmedSnapshot tx -> Gen (ConfirmedSnapshot tx)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfirmedSnapshot tx -> Gen (ConfirmedSnapshot tx))
-> ConfirmedSnapshot tx -> Gen (ConfirmedSnapshot tx)
forall a b. (a -> b) -> a -> b
$ ConfirmedSnapshot{Snapshot tx
$sel:snapshot:InitialSnapshot :: Snapshot tx
snapshot :: Snapshot tx
snapshot, MultiSignature (Snapshot tx)
$sel:signatures:InitialSnapshot :: MultiSignature (Snapshot tx)
signatures :: MultiSignature (Snapshot tx)
signatures}