{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE UndecidableInstances #-}
module Hydra.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 (SigningKey)
import Hydra.Cardano.Api.Prelude (serialiseToRawBytes)
import Hydra.Contract.HeadState qualified as Onchain
import Hydra.Crypto (HydraKey, MultiSignature, aggregate, sign)
import Hydra.HeadId (HeadId)
import Hydra.Ledger (IsTx (..))
import PlutusLedgerApi.V2 (toBuiltin, toData)
import Test.QuickCheck (frequency, suchThat)
import Test.QuickCheck.Instances.Natural ()
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)
instance Arbitrary SnapshotNumber where
arbitrary :: Gen SnapshotNumber
arbitrary = Natural -> SnapshotNumber
UnsafeSnapshotNumber (Natural -> SnapshotNumber) -> Gen Natural -> Gen SnapshotNumber
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Natural
forall a. Arbitrary a => Gen a
arbitrary
data Snapshot tx = Snapshot
{ forall tx. Snapshot tx -> HeadId
headId :: HeadId
, forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
, forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
, forall tx. Snapshot tx -> [TxIdType tx]
confirmed :: [TxIdType tx]
}
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)
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
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo, [TxIdType tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [TxIdType tx]
confirmed :: [TxIdType tx]
confirmed} =
[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
"snapshotNumber" 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
"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
"confirmedTransactions" Key -> [TxIdType tx] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= [TxIdType tx]
confirmed
]
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
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx
forall tx.
HeadId
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx
Snapshot
(HeadId
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx)
-> Parser HeadId
-> Parser
(SnapshotNumber -> UTxOType tx -> [TxIdType 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
(SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx)
-> Parser SnapshotNumber
-> Parser (UTxOType tx -> [TxIdType 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
"snapshotNumber")
Parser (UTxOType tx -> [TxIdType tx] -> Snapshot tx)
-> Parser (UTxOType tx) -> Parser ([TxIdType 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 ([TxIdType tx] -> Snapshot tx)
-> Parser [TxIdType 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 [TxIdType tx]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"confirmedTransactions")
instance IsTx 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
shrink :: Snapshot tx -> [Snapshot tx]
shrink 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
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo, [TxIdType tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [TxIdType tx]
confirmed :: [TxIdType tx]
confirmed} =
[ HeadId
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx
forall tx.
HeadId
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx
Snapshot HeadId
headId SnapshotNumber
number UTxOType tx
utxo' [TxIdType tx]
confirmed'
| UTxOType tx
utxo' <- UTxOType tx -> [UTxOType tx]
forall a. Arbitrary a => a -> [a]
shrink UTxOType tx
utxo
, [TxIdType tx]
confirmed' <- [TxIdType tx] -> [[TxIdType tx]]
forall a. Arbitrary a => a -> [a]
shrink [TxIdType tx]
confirmed
]
instance forall tx. IsTx tx => SignableRepresentation (Snapshot tx) where
getSignableRepresentation :: Snapshot tx -> ByteString
getSignableRepresentation Snapshot{SnapshotNumber
$sel:number:Snapshot :: forall tx. Snapshot tx -> SnapshotNumber
number :: SnapshotNumber
number, HeadId
$sel:headId:Snapshot :: forall tx. Snapshot tx -> HeadId
headId :: HeadId
headId, UTxOType tx
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo} =
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) -> BuiltinByteString -> Data
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
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 -> Data
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (Integer -> Integer) -> Integer -> Integer
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) -> BuiltinByteString -> Data
forall a b. (a -> b) -> a -> b
$ ByteString -> BuiltinByteString
forall a arep. ToBuiltin a arep => a -> arep
toBuiltin (ByteString -> BuiltinByteString)
-> ByteString -> BuiltinByteString
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @tx UTxOType tx
utxo)
instance (Typeable tx, ToCBOR (UTxOType tx), ToCBOR (TxIdType 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
$sel:utxo:Snapshot :: forall tx. Snapshot tx -> UTxOType tx
utxo :: UTxOType tx
utxo, [TxIdType tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [TxIdType tx]
confirmed :: [TxIdType tx]
confirmed} =
HeadId -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR HeadId
headId 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
<> UTxOType tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR UTxOType tx
utxo Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [TxIdType tx] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR [TxIdType tx]
confirmed
instance (Typeable tx, FromCBOR (UTxOType tx), FromCBOR (TxIdType tx)) => FromCBOR (Snapshot tx) where
fromCBOR :: forall s. Decoder s (Snapshot tx)
fromCBOR = HeadId
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx
forall tx.
HeadId
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx
Snapshot (HeadId
-> SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx)
-> Decoder s HeadId
-> Decoder
s (SnapshotNumber -> UTxOType tx -> [TxIdType 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 (SnapshotNumber -> UTxOType tx -> [TxIdType tx] -> Snapshot tx)
-> Decoder s SnapshotNumber
-> Decoder s (UTxOType tx -> [TxIdType 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 (UTxOType tx -> [TxIdType tx] -> Snapshot tx)
-> Decoder s (UTxOType tx)
-> Decoder s ([TxIdType 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 ([TxIdType tx] -> Snapshot tx)
-> Decoder s [TxIdType 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 [TxIdType tx]
forall s. Decoder s [TxIdType tx]
forall a s. FromCBOR a => Decoder s a
fromCBOR
data ConfirmedSnapshot tx
= InitialSnapshot
{ 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)
getSnapshot :: ConfirmedSnapshot tx -> Snapshot tx
getSnapshot :: forall tx. ConfirmedSnapshot tx -> Snapshot tx
getSnapshot = \case
InitialSnapshot{HeadId
$sel:headId:InitialSnapshot :: 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:number:Snapshot :: SnapshotNumber
number = SnapshotNumber
0
, $sel:utxo:Snapshot :: UTxOType tx
utxo = UTxOType tx
initialUTxO
, $sel:confirmed:Snapshot :: [TxIdType tx]
confirmed = []
}
ConfirmedSnapshot{Snapshot tx
$sel:snapshot:InitialSnapshot :: forall tx. ConfirmedSnapshot tx -> Snapshot tx
snapshot :: Snapshot tx
snapshot} -> Snapshot tx
snapshot
isInitialSnapshot :: ConfirmedSnapshot tx -> Bool
isInitialSnapshot :: forall tx. ConfirmedSnapshot tx -> Bool
isInitialSnapshot = \case
InitialSnapshot{} -> Bool
True
ConfirmedSnapshot{} -> Bool
False
instance 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
HeadId
headId <- Gen HeadId
forall a. Arbitrary a => Gen a
arbitrary
HeadId
-> SnapshotNumber
-> UTxOType tx
-> [SigningKey HydraKey]
-> Gen (ConfirmedSnapshot tx)
forall tx.
IsTx tx =>
HeadId
-> SnapshotNumber
-> UTxOType tx
-> [SigningKey HydraKey]
-> Gen (ConfirmedSnapshot tx)
genConfirmedSnapshot HeadId
headId SnapshotNumber
0 UTxOType tx
utxo [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 ->
SnapshotNumber ->
UTxOType tx ->
[SigningKey HydraKey] ->
Gen (ConfirmedSnapshot tx)
genConfirmedSnapshot :: forall tx.
IsTx tx =>
HeadId
-> SnapshotNumber
-> UTxOType tx
-> [SigningKey HydraKey]
-> Gen (ConfirmedSnapshot tx)
genConfirmedSnapshot HeadId
headId SnapshotNumber
minSn UTxOType tx
utxo [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. [(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
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, SnapshotNumber
$sel:number:Snapshot :: SnapshotNumber
number :: SnapshotNumber
number, UTxOType tx
$sel:utxo:Snapshot :: UTxOType tx
utxo :: UTxOType tx
utxo, $sel:confirmed:Snapshot :: [TxIdType tx]
confirmed = []}
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}
fromChainSnapshot :: Onchain.SnapshotNumber -> SnapshotNumber
fromChainSnapshot :: Integer -> SnapshotNumber
fromChainSnapshot Integer
onChainSnapshotNumber =
SnapshotNumber
-> (Natural -> SnapshotNumber) -> Maybe Natural -> SnapshotNumber
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
(Text -> SnapshotNumber
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Failed to convert on-chain SnapShotNumber to off-chain one.")
Natural -> SnapshotNumber
UnsafeSnapshotNumber
(Integer -> Maybe Natural
integerToNatural Integer
onChainSnapshotNumber)