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

module Hydra.Tx.Snapshot where

import Hydra.Prelude

import Cardano.Crypto.Util (SignableRepresentation (..))
import Codec.Serialise (serialise)
import Data.Aeson (Value (String), object, withObject, (.:), (.:?), (.=))
import Data.ByteString.Base16 qualified as Base16
import Data.ByteString.Lazy qualified as LBS
import Hydra.Cardano.Api (SerialiseAsRawBytes (..))
import Hydra.Contract.HeadState qualified as Onchain
import Hydra.Tx.Accumulator qualified as Accumulator
import Hydra.Tx.Crypto (MultiSignature)
import Hydra.Tx.HeadId (HeadId)
import Hydra.Tx.IsTx (IsTx (..), combinedUTxO)
import PlutusLedgerApi.V3 (fromBuiltin, toBuiltin, toData)
import PlutusTx.Builtins (sha2_256)

-- * 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, 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 ToCBOR SnapshotNumber where
  toCBOR :: SnapshotNumber -> Encoding
toCBOR = SnapshotNumber -> Encoding
forall a. (Generic a, GToCBOR (Rep a)) => a -> Encoding
genericToCBOR

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

-- 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, 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)

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

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

-- 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 (TxIdType tx)
depositTxId :: Maybe (TxIdType tx)
  -- ^ Transaction which deposited 'utxoToCommit' on L1, i.e. the deposit an
  -- increment of this snapshot is allowed to claim. Bound into the signature
  -- so a deposit cannot be swapped for a look-alike one, see
  -- 'getSignableRepresentation'.
  --
  -- A transaction id identifies a deposit because a deposit is always the first
  -- output of its transaction; 'Hydra.Tx.Deposit.observeDepositTx' enforces that
  -- and 'Hydra.Contract.Head.checkIncrement' requires it on-chain. Callers set
  -- this exactly when 'utxoToCommit' is set.
  , forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
  -- ^ UTxO to be decommitted. Spec: Uω
  , forall tx. Snapshot tx -> HydraAccumulator
accumulator :: Accumulator.HydraAccumulator
  -- ^ What the head holds if the pending L1 tx (increment or decrement) has
  -- not happened:
  --
  -- > utxo <> utxoToDecommit
  --
  -- A decommit is still in the head until its DecrementTx lands, and a deposit
  -- is not in the head until its IncrementTx lands. Close/Contest store this one
  -- when the head is still at this snapshot's 'version' (redeemers Any/Unused).
  -- Spec: A
  , forall tx. Snapshot tx -> HydraAccumulator
appliedAccumulator :: Accumulator.HydraAccumulator
  -- ^ What the head holds after the pending L1 tx happened:
  --
  -- > utxo <> utxoToCommit
  --
  -- The decommit was paid out, the deposit was absorbed. Close/Contest store
  -- this one when the head moved past this snapshot's 'version' (redeemer Used).
  --
  -- Both are signed, because when the snapshot is signed nobody knows yet which
  -- of the two will be true at close time, and the closed head must commit to
  -- exactly what it holds so that fanout cannot pay out a UTxO twice. With
  -- nothing pending both fields are the same value. Never transmitted, always
  -- rebuilt from the UTxO sets, see 'Hydra.Tx.Accumulator.buildFromSnapshotUTxOs'.
  }
  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', 'accumulatorHash', 'appliedAccumulatorHash',
-- 'decommitOutputsHash', and 'commitOutputsHash' according to CDDL schemata:
--
-- headId = bytes .size 28
-- version = uint
-- number = uint
-- accumulatorHash = bytes .size 32  ; blake2b-256 of the compressed G1 commitment of 'accumulator'
-- appliedAccumulatorHash = bytes .size 32  ; blake2b-256 of the compressed G1 commitment of 'appliedAccumulator'
-- decommitOutputsHash = bytes .size 32  ; sha2-256 of the ordered decommit outputs (Uω)
-- commitOutputsHash = bytes .size 32  ; sha2-256 of the ordered commit outputs (Uα)
--                                     ; and of the deposit transaction id
--
-- The two accumulator hashes let Close/Contest store whichever of the two UTxO
-- sets the head actually holds at that time (see the field docs above).
-- 'decommitOutputsHash' and 'commitOutputsHash' additionally bind the exact
-- ordered sets of decommit (Uω) and commit (Uα) outputs, so the on-chain
-- decrement and increment validators can recompute them from the materialized L1
-- decommit outputs / claimed deposit and reject any redirected/altered output.
--
-- 'commitOutputsHash' further binds 'depositTxId'. Committed content on its own
-- does not identify a deposit: a deposit datum is unauthenticated data anyone can
-- copy into a look-alike deposit holding less value, which would otherwise hash
-- the same and accept this snapshot's signatures. See the matching computation in
-- 'Hydra.Contract.Head.checkIncrement'.
instance IsTx tx => SignableRepresentation (Snapshot tx) where
  getSignableRepresentation :: Snapshot tx -> ByteString
getSignableRepresentation snapshot :: Snapshot tx
snapshot@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, HydraAccumulator
$sel:accumulator:Snapshot :: forall tx. Snapshot tx -> HydraAccumulator
accumulator :: HydraAccumulator
accumulator, HydraAccumulator
$sel:appliedAccumulator:Snapshot :: forall tx. Snapshot tx -> HydraAccumulator
appliedAccumulator :: HydraAccumulator
appliedAccumulator, 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) -> BuiltinByteString -> Data
forall a b. (a -> b) -> a -> b
$ ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin ByteString
accumulatorBytes)
        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 -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin ByteString
appliedAccumulatorBytes)
        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 -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin ByteString
decommitOutputsHash)
        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 -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (Snapshot tx -> ByteString
forall tx. IsTx tx => Snapshot tx -> ByteString
commitOutputsHash Snapshot tx
snapshot))
   where
    accumulatorBytes :: ByteString
accumulatorBytes = HydraAccumulator -> ByteString
Accumulator.getAccumulatorHash HydraAccumulator
accumulator
    appliedAccumulatorBytes :: ByteString
appliedAccumulatorBytes = HydraAccumulator -> ByteString
Accumulator.getAccumulatorHash HydraAccumulator
appliedAccumulator
    -- Matches on-chain 'Hydra.Contract.Util.hashTxOuts' over the same outputs in
    -- the same (TxIn-sorted) order; empty-list hash when there is nothing pending.
    decommitOutputsHash :: ByteString
decommitOutputsHash = forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @tx (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)

-- | Digest of a snapshot's pending commit (Uα) as bound into its signature: the
-- ordered commit outputs together with the id of the deposit transaction they
-- come from.
--
-- Both halves are required. The outputs alone do not identify a deposit, since a
-- deposit datum is unauthenticated data anyone can copy into a look-alike
-- deposit holding less value; binding the deposit's transaction id makes the
-- signature usable for that one deposit only. The increment validator recomputes
-- this from the deposit input it claims, see 'Hydra.Contract.Head.checkIncrement'.
-- Close, contest and decrement transactions cannot recompute it (they spend no
-- deposit) and carry it in their redeemer instead, where it only feeds signature
-- verification.
commitOutputsHash :: forall tx. IsTx tx => Snapshot tx -> ByteString
commitOutputsHash :: forall tx. IsTx tx => Snapshot tx -> ByteString
commitOutputsHash Snapshot{Maybe (UTxOType tx)
$sel:utxoToCommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToCommit :: Maybe (UTxOType tx)
utxoToCommit, Maybe (TxIdType tx)
$sel:depositTxId:Snapshot :: forall tx. Snapshot tx -> Maybe (TxIdType tx)
depositTxId :: Maybe (TxIdType tx)
depositTxId} =
  BuiltinByteString -> ByteString
BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin (BuiltinByteString -> ByteString)
-> (ByteString -> BuiltinByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> BuiltinByteString
sha2_256 (BuiltinByteString -> BuiltinByteString)
-> (ByteString -> BuiltinByteString)
-> ByteString
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
    forall tx. IsTx tx => UTxOType tx -> ByteString
hashUTxO @tx (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
<> (TxIdType tx -> ByteString) -> Maybe (TxIdType tx) -> ByteString
forall m a. Monoid m => (a -> m) -> Maybe a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall tx. IsTx tx => TxIdType tx -> ByteString
txIdBytes @tx) Maybe (TxIdType tx)
depositTxId

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, HydraAccumulator
$sel:accumulator:Snapshot :: forall tx. Snapshot tx -> HydraAccumulator
accumulator :: HydraAccumulator
accumulator, HydraAccumulator
$sel:appliedAccumulator:Snapshot :: forall tx. Snapshot tx -> HydraAccumulator
appliedAccumulator :: HydraAccumulator
appliedAccumulator, Maybe (TxIdType tx)
$sel:depositTxId:Snapshot :: forall tx. Snapshot tx -> Maybe (TxIdType tx)
depositTxId :: Maybe (TxIdType tx)
depositTxId} =
    [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
      , Key
"depositTxId" Key -> Maybe (TxIdType tx) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe (TxIdType tx)
depositTxId
      , Key
"accumulator" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HydraAccumulator -> ByteString
Accumulator.getAccumulatorHash HydraAccumulator
accumulator)
      , Key
"appliedAccumulator" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HydraAccumulator -> ByteString
Accumulator.getAccumulatorHash HydraAccumulator
appliedAccumulator)
      ]

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 -> do
    HeadId
headId <- Object
obj Object -> Key -> Parser HeadId
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"headId"
    SnapshotVersion
version <- Object
obj Object -> Key -> Parser SnapshotVersion
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"version"
    SnapshotNumber
number <- Object
obj Object -> Key -> Parser SnapshotNumber
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"number"
    [tx]
confirmed <- Object
obj Object -> Key -> Parser [tx]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"confirmed"
    UTxOType tx
utxo <- Object
obj Object -> Key -> Parser (UTxOType tx)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"utxo"
    Maybe (UTxOType tx)
utxoToCommit <-
      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)
utxoC) -> Maybe (UTxOType tx) -> Parser (Maybe (UTxOType tx))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UTxOType tx)
utxoC
    Maybe (UTxOType tx)
utxoToDecommit <-
      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)
utxoD) -> Maybe (UTxOType tx) -> Parser (Maybe (UTxOType tx))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (UTxOType tx)
utxoD
    Maybe (TxIdType tx)
depositTxId <- Object
obj Object -> Key -> Parser (Maybe (TxIdType tx))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"depositTxId"
    -- The "accumulator" and "appliedAccumulator" JSON fields carry only the
    -- hashes for display; both accumulators are always rebuilt from the UTxO sets.
    -- SECURITY: never trust a hash from the JSON instead of rebuilding. This
    -- instance is reachable from untrusted client input (SideLoadSnapshot),
    -- and the accumulator hashes are what multisignatures verify against, so
    -- they must always be derived from the UTxO content.
    --
    -- SECURITY: the rebuilt accumulators are bottom when the UTxO set is larger
    -- than the trusted setup can commit to ('computeG1CommitmentBytes' errors
    -- above 'Accumulator.maxAccumulatorSize'), and they are lazy, so this decode
    -- succeeds for a set of any size and the failure surfaces wherever the
    -- accumulator is first forced. The size is deliberately not bounded here:
    -- this codec is also the persistence format, replayed from the event store
    -- at startup, where a rejected decode would stop the node from starting.
    -- Every client API entry point bounds it instead, before the value can be
    -- queued, logged or echoed -- see 'Hydra.API.ClientInput.validateClientInput'
    -- and 'Hydra.API.HTTPServer.handleSideLoadSnapshot'.
    let (HydraAccumulator
accumulator, HydraAccumulator
appliedAccumulator) = UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> (HydraAccumulator, HydraAccumulator)
forall tx.
IsTx tx =>
UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> (HydraAccumulator, HydraAccumulator)
Accumulator.buildFromSnapshotUTxOs UTxOType tx
utxo Maybe (UTxOType tx)
utxoToCommit Maybe (UTxOType tx)
utxoToDecommit
    Snapshot tx -> Parser (Snapshot tx)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Snapshot tx -> Parser (Snapshot tx))
-> Snapshot tx -> Parser (Snapshot tx)
forall a b. (a -> b) -> a -> b
$ 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, [tx]
$sel:confirmed:Snapshot :: [tx]
confirmed :: [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, Maybe (TxIdType tx)
$sel:depositTxId:Snapshot :: Maybe (TxIdType tx)
depositTxId :: Maybe (TxIdType tx)
depositTxId, HydraAccumulator
$sel:accumulator:Snapshot :: HydraAccumulator
accumulator :: HydraAccumulator
accumulator, HydraAccumulator
$sel:appliedAccumulator:Snapshot :: HydraAccumulator
appliedAccumulator :: HydraAccumulator
appliedAccumulator}

-- | Tag of the current on-disk\/wire layout, which carries 'depositTxId'.
--
-- The fields are a bare concatenation with no length prefix, so a layout change
-- is only decodable when the tag distinguishes it: 'snapshotCBORTagV1' names the
-- one written before 'depositTxId' existed and is still accepted, letting a node
-- replay an event log from an earlier version.
snapshotCBORTag :: Text
snapshotCBORTag :: Text
snapshotCBORTag = Text
"Snapshot2"

-- | Tag of the layout without 'depositTxId'. Decoded, never written.
snapshotCBORTagV1 :: Text
snapshotCBORTagV1 :: Text
snapshotCBORTagV1 = Text
"Snapshot"

-- NOTE: Like the JSON encoding, the accumulators are not transmitted (only
-- derived data) and get rebuilt from the UTxO sets on decode. This is why
-- the codec stays hand-written.
instance IsTx tx => ToCBOR (Snapshot tx) where
  toCBOR :: Snapshot tx -> Encoding
toCBOR 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, [tx]
$sel:confirmed:Snapshot :: forall tx. Snapshot tx -> [tx]
confirmed :: [tx]
confirmed, 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 (TxIdType tx)
$sel:depositTxId:Snapshot :: forall tx. Snapshot tx -> Maybe (TxIdType tx)
depositTxId :: Maybe (TxIdType tx)
depositTxId, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: forall tx. Snapshot tx -> Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit} =
    Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Text
snapshotCBORTag
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> 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 (TxIdType tx) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Maybe (TxIdType tx)
depositTxId
      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 IsTx tx => FromCBOR (Snapshot tx) where
  fromCBOR :: forall s. Decoder s (Snapshot tx)
fromCBOR =
    Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Text
-> (Text -> Decoder s (Snapshot tx)) -> Decoder s (Snapshot tx)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Text
tag :: Text)
        | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
snapshotCBORTag -> Bool -> Decoder s (Snapshot tx)
decodeSnapshot Bool
True
        | Text
tag Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
snapshotCBORTagV1 -> Bool -> Decoder s (Snapshot tx)
decodeSnapshot Bool
False
        | Bool
otherwise -> String -> Decoder s (Snapshot tx)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Snapshot tx))
-> String -> Decoder s (Snapshot tx)
forall a b. (a -> b) -> a -> b
$ Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
tag String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a proper CBOR-encoded Snapshot"
   where
    decodeSnapshot :: Bool -> Decoder s (Snapshot tx)
decodeSnapshot Bool
hasDepositTxId = do
      HeadId
headId <- Decoder s HeadId
forall s. Decoder s HeadId
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SnapshotVersion
version <- Decoder s SnapshotVersion
forall s. Decoder s SnapshotVersion
forall a s. FromCBOR a => Decoder s a
fromCBOR
      SnapshotNumber
number <- Decoder s SnapshotNumber
forall s. Decoder s SnapshotNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR
      [tx]
confirmed <- Decoder s [tx]
forall s. Decoder s [tx]
forall a s. FromCBOR a => Decoder s a
fromCBOR
      UTxOType tx
utxo <- Decoder s (UTxOType tx)
forall s. Decoder s (UTxOType tx)
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Maybe (UTxOType tx)
utxoToCommit <- Decoder s (Maybe (UTxOType tx))
forall s. Decoder s (Maybe (UTxOType tx))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      -- A snapshot from before this field existed names no deposit, so an
      -- increment of it cannot validate; only replaying it has to work.
      Maybe (TxIdType tx)
depositTxId <- if Bool
hasDepositTxId then Decoder s (Maybe (TxIdType tx))
forall s. Decoder s (Maybe (TxIdType tx))
forall a s. FromCBOR a => Decoder s a
fromCBOR else Maybe (TxIdType tx) -> Decoder s (Maybe (TxIdType tx))
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (TxIdType tx)
forall a. Maybe a
Nothing
      Maybe (UTxOType tx)
utxoToDecommit <- Decoder s (Maybe (UTxOType tx))
forall s. Decoder s (Maybe (UTxOType tx))
forall a s. FromCBOR a => Decoder s a
fromCBOR
      -- SECURITY: as in the 'FromJSON' instance above, both accumulators are
      -- rebuilt (never trusted from the wire) and are bottom above
      -- 'Accumulator.maxAccumulatorSize'; the bound is enforced at the client
      -- API boundary, not here.
      let (HydraAccumulator
accumulator, HydraAccumulator
appliedAccumulator) = forall tx.
IsTx tx =>
UTxOType tx
-> Maybe (UTxOType tx)
-> Maybe (UTxOType tx)
-> (HydraAccumulator, HydraAccumulator)
Accumulator.buildFromSnapshotUTxOs @tx UTxOType tx
utxo Maybe (UTxOType tx)
utxoToCommit Maybe (UTxOType tx)
utxoToDecommit
      Snapshot tx -> Decoder s (Snapshot tx)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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, [tx]
$sel:confirmed:Snapshot :: [tx]
confirmed :: [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 (TxIdType tx)
$sel:depositTxId:Snapshot :: Maybe (TxIdType tx)
depositTxId :: Maybe (TxIdType tx)
depositTxId, Maybe (UTxOType tx)
$sel:utxoToDecommit:Snapshot :: Maybe (UTxOType tx)
utxoToDecommit :: Maybe (UTxOType tx)
utxoToDecommit, HydraAccumulator
$sel:accumulator:Snapshot :: HydraAccumulator
accumulator :: HydraAccumulator
accumulator, HydraAccumulator
$sel:appliedAccumulator:Snapshot :: HydraAccumulator
appliedAccumulator :: HydraAccumulator
appliedAccumulator}

-- | All UTxOs represented by this snapshot: settled plus any pending commit/decommit.
snapshotUTxO :: IsTx tx => Snapshot tx -> UTxOType tx
snapshotUTxO :: forall tx. IsTx tx => Snapshot tx -> UTxOType tx
snapshotUTxO Snapshot{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} =
  UTxOType tx
-> Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> UTxOType tx
forall a. Monoid a => a -> Maybe a -> Maybe a -> a
combinedUTxO UTxOType tx
utxo Maybe (UTxOType tx)
utxoToCommit 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
      }
  | 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)

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

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

-- | 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 explicitly define a getter which
-- will force us into thinking about changing the signature properly if this
-- happens.
getSnapshot :: forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot :: forall tx. IsTx tx => ConfirmedSnapshot tx -> Snapshot tx
getSnapshot = \case
  InitialSnapshot{HeadId
headId :: forall tx. ConfirmedSnapshot tx -> HeadId
headId :: HeadId
headId} ->
    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
forall a. Monoid a => a
mempty
      , $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
      , $sel:depositTxId:Snapshot :: Maybe (TxIdType tx)
depositTxId = Maybe (TxIdType tx)
forall a. Maybe a
Nothing
      , $sel:accumulator:Snapshot :: HydraAccumulator
accumulator = HydraAccumulator
emptyAccumulator
      , $sel:appliedAccumulator:Snapshot :: HydraAccumulator
appliedAccumulator = HydraAccumulator
emptyAccumulator
      }
  ConfirmedSnapshot{Snapshot tx
$sel:snapshot:InitialSnapshot :: forall tx. ConfirmedSnapshot tx -> Snapshot tx
snapshot :: Snapshot tx
snapshot} -> Snapshot tx
snapshot
 where
  emptyAccumulator :: HydraAccumulator
emptyAccumulator = forall tx. IsTx tx => UTxOType tx -> HydraAccumulator
Accumulator.buildFromUTxO @tx UTxOType tx
forall a. Monoid a => a
mempty