{-# LANGUAGE AllowAmbiguousTypes #-}

module Hydra.Tx.Accumulator (
  HydraAccumulator,
  unHydraAccumulator,
  getAccumulatorHash,
  getAccumulatorCommitment,
  computeG1CommitmentBytes,
  accumulatorSize,
  maxAccumulatorSize,
  build,
  buildFromUTxO,
  buildFromSnapshotUTxOs,
  applyUTxODelta,

  -- * CRS (Common Reference String)
  crsG2Points,
  crsG1Points,
  requiredCRSPointCount,
  defaultItems,

  -- * Membership proofs for partial fanout
  createMembershipProof,
  createMembershipProofFromUTxO,
  createCRSG2Datum,
) where

import Hydra.Prelude hiding (show)

import Accumulator (Accumulator, Element)
import Accumulator qualified
import Bindings (getPolyCommitOverG1)
import Cardano.Api (BabbageEraOnwards (..), TxOutDatum (TxOutDatumInline))
import Cardano.Crypto.EllipticCurve.BLS12_381.Internal (Point1, Point2, blsCompress)
import Cardano.Crypto.Hash (Blake2b_256)
import Cardano.Crypto.Hash.Class (HashAlgorithm (digest))
import Data.Map.Strict qualified as Map
import Hydra.Cardano.Api qualified as HApi
import Hydra.Contract.KZGTrustedSetup qualified as KZG
import Hydra.Tx.IsTx (IsTx (..))
import PlutusTx.Builtins (
  BuiltinBLS12_381_G1_Element,
  bls12_381_G1_uncompress,
  bls12_381_G2_uncompress,
  toBuiltin,
 )
import Text.Show (Show (..))

-- * HydraAccumulator

data HydraAccumulator = HydraAccumulator
  { HydraAccumulator -> Accumulator
unHydraAccumulator :: Accumulator
  , HydraAccumulator -> ByteString
_cachedCommitment :: ByteString
  -- ^ Lazy thunk: compressed G1 commitment. Forced at most once per value,
  -- shared by the hash below and by 'getAccumulatorCommitment' (datum
  -- construction at close/contest/fanout).
  , HydraAccumulator -> ByteString
_cachedHash :: ByteString
  -- ^ Lazy thunk: blake2b-256 of '_cachedCommitment'. Forced once on first
  -- access; subsequent reads return the memoized value, avoiding repeated
  -- BLS12-381 multi-scalar multiplications for the same accumulator.
  }

-- | Shows only the element map: the derived instance would force the cached
-- commitment, so showing head state in logs or test output would compute a
-- BLS commitment as a side effect.
instance Show HydraAccumulator where
  show :: HydraAccumulator -> String
show HydraAccumulator{$sel:unHydraAccumulator:HydraAccumulator :: HydraAccumulator -> Accumulator
unHydraAccumulator = Accumulator
acc} =
    String
"HydraAccumulator " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Accumulator -> String
forall a. Show a => a -> String
show Accumulator
acc

instance Eq HydraAccumulator where
  HydraAccumulator
a == :: HydraAccumulator -> HydraAccumulator -> Bool
== HydraAccumulator
b = HydraAccumulator -> Accumulator
unHydraAccumulator HydraAccumulator
a Accumulator -> Accumulator -> Bool
forall a. Eq a => a -> a -> Bool
== HydraAccumulator -> Accumulator
unHydraAccumulator HydraAccumulator
b

mkHydraAccumulator :: Accumulator -> HydraAccumulator
mkHydraAccumulator :: Accumulator -> HydraAccumulator
mkHydraAccumulator Accumulator
acc = Accumulator -> ByteString -> ByteString -> HydraAccumulator
HydraAccumulator Accumulator
acc ByteString
cachedCommitment ByteString
cachedHash
 where
  cachedCommitment :: ByteString
cachedCommitment = Accumulator -> ByteString
computeG1CommitmentBytes Accumulator
acc
  cachedHash :: ByteString
cachedHash = Proxy Blake2b_256 -> ByteString -> ByteString
forall h (proxy :: * -> *).
HashAlgorithm h =>
proxy h -> ByteString -> ByteString
forall (proxy :: * -> *).
proxy Blake2b_256 -> ByteString -> ByteString
digest (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @Blake2b_256) ByteString
cachedCommitment

build :: [ByteString] -> HydraAccumulator
build :: [ByteString] -> HydraAccumulator
build = Accumulator -> HydraAccumulator
mkHydraAccumulator (Accumulator -> HydraAccumulator)
-> ([ByteString] -> Accumulator)
-> [ByteString]
-> HydraAccumulator
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Accumulator
Accumulator.buildAccumulator

-- | Build an accumulator from a UTxO by serializing each individual TxOut.
--
-- This is the CORRECT way to build an accumulator for partial fanout proofs.
-- Each TxOut becomes a separate element in the accumulator, allowing you to later
-- prove that a subset of TxOuts was part of the original set.
--
-- The serialization matches how `hashTxOuts` works on-chain:
-- Each element = Builtins.serialiseData (toBuiltinData plutusTxOut)
--
-- Example usage:
-- > -- Build accumulator from the full UTxO set
-- > let fullAcc = buildFromUTxO @Tx utxo
-- >
-- > -- Later, prove a subset exists
-- > let crs = crsG1Points (requiredCRSPointCount fullAcc)
-- > result <- createMembershipProofFromUTxO @Tx subsetUTxO fullAcc crs
--
-- This approach allows proving that 2 out of 5 UTxOs are part of the original set,
-- which is essential for partial fanout functionality.
buildFromUTxO ::
  forall tx.
  IsTx tx =>
  -- | The UTxO set to build the accumulator from
  UTxOType tx ->
  -- | The resulting accumulator containing one element per TxOut
  HydraAccumulator
buildFromUTxO :: forall tx. IsTx tx => UTxOType tx -> HydraAccumulator
buildFromUTxO UTxOType tx
utxo =
  let elements :: [ByteString]
elements = forall tx. IsTx tx => TxOutType tx -> ByteString
utxoToElement @tx (TxOutType tx -> ByteString) -> [TxOutType tx] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tx. IsTx tx => UTxOType tx -> [TxOutType tx]
outputsOfUTxO @tx UTxOType tx
utxo
   in [ByteString] -> HydraAccumulator
build [ByteString]
elements

-- | Build an accumulator from snapshot UTxOs, including commit and decommit UTxOs.
--
-- Combines all UTxOs that could potentially be fanned out — main snapshot,
-- commit, and decommit — and delegates to 'buildFromUTxO' on the merged set.
-- Merging via UTxO union keeps the same canonical TxIn-sorted element order
-- used by every other accumulator call site ('computeFullFanoutUTxO',
-- 'partialFanout' staleness check, 'emitNextFanoutStep'), so the commitment
-- stored in the snapshot and all downstream proofs are built from the same
-- element set by construction.
--
-- Note: the underlying 'HydraAccumulator' is a 'Map' keyed by element bytes,
-- so insertion order is irrelevant for the commitment value; the merge is done
-- here for explicit consistency with the rest of the fanout code paths.
buildFromSnapshotUTxOs ::
  forall tx.
  IsTx tx =>
  -- | The main snapshot UTxO set
  UTxOType tx ->
  -- | UTxOs to be committed (if any)
  Maybe (UTxOType tx) ->
  -- | UTxOs to be decommitted (if any)
  Maybe (UTxOType tx) ->
  -- | The resulting accumulator containing all UTxOs
  HydraAccumulator
buildFromSnapshotUTxOs :: forall tx.
IsTx tx =>
UTxOType tx
-> Maybe (UTxOType tx) -> Maybe (UTxOType tx) -> HydraAccumulator
buildFromSnapshotUTxOs UTxOType tx
utxo Maybe (UTxOType tx)
mUtxoToCommit Maybe (UTxOType tx)
mUtxoToDecommit =
  forall tx. IsTx tx => UTxOType tx -> HydraAccumulator
buildFromUTxO @tx (UTxOType tx -> HydraAccumulator)
-> UTxOType tx -> HydraAccumulator
forall a b. (a -> b) -> a -> b
$
    UTxOType tx
utxo
      UTxOType tx -> UTxOType tx -> UTxOType tx
forall a. Semigroup a => a -> a -> a
<> 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)
mUtxoToCommit
      UTxOType tx -> UTxOType tx -> UTxOType tx
forall a. Semigroup a => a -> a -> a
<> 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)
mUtxoToDecommit

-- | Update an accumulator from one snapshot's combined UTxO set to the next
-- by adding and removing only the changed outputs, avoiding the per-output
-- serialization and hashing of a full rebuild. Extensionally equal to
-- 'buildFromUTxO' on the new set (see the property in
-- "Hydra.Tx.AccumulatorSpec"): the underlying map tracks element multiplicity
-- and the TxIn-keyed set difference removes exactly one occurrence per
-- consumed input. Falls back to a full rebuild if a removed element is
-- missing or has lower multiplicity than the removals require, which would
-- indicate the given accumulator was not built from the given previous UTxO
-- set.
applyUTxODelta ::
  forall tx.
  IsTx tx =>
  -- | Accumulator built from the previous combined UTxO set
  HydraAccumulator ->
  -- | The previous combined UTxO set
  UTxOType tx ->
  -- | The new combined UTxO set
  UTxOType tx ->
  HydraAccumulator
applyUTxODelta :: forall tx.
IsTx tx =>
HydraAccumulator -> UTxOType tx -> UTxOType tx -> HydraAccumulator
applyUTxODelta HydraAccumulator
prevAcc UTxOType tx
prevUTxO UTxOType tx
nextUTxO
  | Bool
removalsCovered =
      Accumulator -> HydraAccumulator
mkHydraAccumulator (Accumulator -> HydraAccumulator)
-> Accumulator -> HydraAccumulator
forall a b. (a -> b) -> a -> b
$
        (Accumulator -> ByteString -> Accumulator)
-> Accumulator -> [ByteString] -> Accumulator
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((ByteString -> Accumulator -> Accumulator)
-> Accumulator -> ByteString -> Accumulator
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> Accumulator -> Accumulator
Accumulator.removeElement) ((Accumulator -> ByteString -> Accumulator)
-> Accumulator -> [ByteString] -> Accumulator
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Accumulator -> ByteString -> Accumulator
Accumulator.addElement Accumulator
prev [ByteString]
addedEls) [ByteString]
removedEls
  | Bool
otherwise = forall tx. IsTx tx => UTxOType tx -> HydraAccumulator
buildFromUTxO @tx UTxOType tx
nextUTxO
 where
  prev :: Accumulator
prev = HydraAccumulator -> Accumulator
unHydraAccumulator HydraAccumulator
prevAcc

  -- Multiset containment: every element must be present with at least the
  -- multiplicity about to be removed. Membership alone would let a
  -- mismatched (accumulator, previous UTxO) pair skip the fallback:
  -- 'Accumulator.removeElement' silently no-ops once a count is exhausted,
  -- yielding a commitment that does not bind 'nextUTxO'.
  removalsCovered :: Bool
removalsCovered =
    (Int -> (ByteString, Int) -> Bool)
-> Map ByteString Int -> Accumulator -> Bool
forall k a b.
Ord k =>
(a -> b -> Bool) -> Map k a -> Map k b -> Bool
Map.isSubmapOfBy (\Int
needed (ByteString
_, Int
held) -> Int
needed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
held) Map ByteString Int
removedCounts Accumulator
prev

  removedCounts :: Map ByteString Int
removedCounts = (Int -> Int -> Int) -> [(ByteString, Int)] -> Map ByteString Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [(ByteString
el, Int
1 :: Int) | ByteString
el <- [ByteString]
removedEls]

  removedEls :: [ByteString]
removedEls = forall tx. IsTx tx => TxOutType tx -> ByteString
utxoToElement @tx (TxOutType tx -> ByteString) -> [TxOutType tx] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tx. IsTx tx => UTxOType tx -> [TxOutType tx]
outputsOfUTxO @tx (UTxOType tx
prevUTxO UTxOType tx -> UTxOType tx -> UTxOType tx
forall tx. IsTx tx => UTxOType tx -> UTxOType tx -> UTxOType tx
`withoutUTxO` UTxOType tx
nextUTxO)

  addedEls :: [ByteString]
addedEls = forall tx. IsTx tx => TxOutType tx -> ByteString
utxoToElement @tx (TxOutType tx -> ByteString) -> [TxOutType tx] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tx. IsTx tx => UTxOType tx -> [TxOutType tx]
outputsOfUTxO @tx (UTxOType tx
nextUTxO UTxOType tx -> UTxOType tx -> UTxOType tx
forall tx. IsTx tx => UTxOType tx -> UTxOType tx -> UTxOType tx
`withoutUTxO` UTxOType tx
prevUTxO)

-- | Get a blake2b-256 hash of the accumulator commitment (compressed G1 point).
--
-- This is a pure function that returns a 32-byte deterministic hash of the
-- compressed G1 accumulator commitment. It is what gets signed by all parties
-- in the multi-signature and stored as 'accumulatorHash' in on-chain datums.
--
-- Hashing the compressed G1 point (rather than the serialized map) binds the
-- signed hash to the exact G1 point stored in 'ClosedDatum.accumulatorCommitment',
-- allowing the on-chain validator to verify their consistency.
--
-- The result is cached inside 'HydraAccumulator' as a lazy thunk and computed
-- at most once per value, regardless of how many times this function is called.
getAccumulatorHash :: HydraAccumulator -> ByteString
getAccumulatorHash :: HydraAccumulator -> ByteString
getAccumulatorHash = HydraAccumulator -> ByteString
_cachedHash

-- | Number of UTxOs tracked by the accumulator.
accumulatorSize :: HydraAccumulator -> Int
accumulatorSize :: HydraAccumulator -> Int
accumulatorSize = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ([Int] -> Int)
-> (HydraAccumulator -> [Int]) -> HydraAccumulator -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Int) -> Int) -> [(ByteString, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Int) -> Int
forall a b. (a, b) -> b
snd ([(ByteString, Int)] -> [Int])
-> (HydraAccumulator -> [(ByteString, Int)])
-> HydraAccumulator
-> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Accumulator -> [(ByteString, Int)]
forall k a. Map k a -> [a]
Map.elems (Accumulator -> [(ByteString, Int)])
-> (HydraAccumulator -> Accumulator)
-> HydraAccumulator
-> [(ByteString, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydraAccumulator -> Accumulator
unHydraAccumulator

-- | Maximum accumulator size, re-exported from 'KZGTrustedSetup' for convenience.
maxAccumulatorSize :: Int
maxAccumulatorSize :: Int
maxAccumulatorSize = Int
KZG.maxAccumulatorSize

-- | Convert a 'KZG.KZGSetupError' 'Either' to the contained value, aborting
-- with a descriptive message if the setup is invalid.
--
-- This should never be reached in a correctly built binary: the trusted setup
-- bytes are embedded at compile time, integrity-checked via SHA-256, and
-- exercised by the test suite. A failure here would indicate binary tampering
-- or a corrupted build artefact.
fromKZGSetup :: Either KZG.KZGSetupError a -> a
fromKZGSetup :: forall a. Either KZGSetupError a -> a
fromKZGSetup = (KZGSetupError -> a) -> (a -> a) -> Either KZGSetupError a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\KZGSetupError
e -> Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> (String -> Text) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"KZG trusted setup invariant violated: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> KZGSetupError -> String
forall a. Show a => a -> String
show KZGSetupError
e) a -> a
forall a. a -> a
id

getAccumulatorCommitment :: HydraAccumulator -> BuiltinBLS12_381_G1_Element
getAccumulatorCommitment :: HydraAccumulator -> BuiltinBLS12_381_G1_Element
getAccumulatorCommitment = BuiltinByteString -> BuiltinBLS12_381_G1_Element
bls12_381_G1_uncompress (BuiltinByteString -> BuiltinBLS12_381_G1_Element)
-> (HydraAccumulator -> BuiltinByteString)
-> HydraAccumulator
-> BuiltinBLS12_381_G1_Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (HydraAccumulator -> ByteString)
-> HydraAccumulator
-> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HydraAccumulator -> ByteString
_cachedCommitment

-- | Compute the compressed G1 commitment for an accumulator through the
-- rust-accumulator FFI (divide-and-conquer FFT polynomial expansion and a
-- Pippenger multi-scalar multiplication), which is orders of magnitude
-- faster than expanding the polynomial in Haskell. Bit-for-bit equal to the
-- PlutusTx reference path; see the equivalence properties and golden values
-- in "Hydra.Tx.AccumulatorSpec".
computeG1CommitmentBytes :: Accumulator -> ByteString
computeG1CommitmentBytes :: Accumulator -> ByteString
computeG1CommitmentBytes Accumulator
acc
  | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
KZG.maxAccumulatorSize =
      Text -> ByteString
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"getAccumulatorCommitment: accumulator has " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
n String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" elements, exceeding the G1 CRS limit of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
KZG.maxAccumulatorSize
  | Bool
otherwise =
      (String -> ByteString)
-> (Point1 -> ByteString) -> Either String Point1 -> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
e -> Text -> ByteString
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
"computeG1CommitmentBytes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. ToText a => a -> Text
toText String
e) Point1 -> ByteString
forall curve. BLS curve => Point curve -> ByteString
blsCompress (Either String Point1 -> ByteString)
-> Either String Point1 -> ByteString
forall a b. (a -> b) -> a -> b
$
        [ByteString] -> Accumulator -> [Point1] -> Either String Point1
getPolyCommitOverG1 [] Accumulator
acc (Int -> [Point1]
crsG1Points (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
 where
  n :: Int
n = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum ((ByteString, Int) -> Int
forall a b. (a, b) -> b
snd ((ByteString, Int) -> Int) -> [(ByteString, Int)] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Accumulator -> [(ByteString, Int)]
forall k a. Map k a -> [a]
Map.elems Accumulator
acc)

-- * CRS (Common Reference String)

-- | Returns the first @n@ G1 powers of tau from the EIP-4844 trusted setup.
-- Used as the off-chain CRS for building accumulator commitments and membership proofs:
-- @[G1, τ·G1, ..., τ^(n-1)·G1]@.
crsG1Points :: Int -> [Point1]
crsG1Points :: Int -> [Point1]
crsG1Points Int
n = Int -> [Point1] -> [Point1]
forall a. Int -> [a] -> [a]
take Int
n ([Point1] -> [Point1]) -> [Point1] -> [Point1]
forall a b. (a -> b) -> a -> b
$ Either KZGSetupError [Point1] -> [Point1]
forall a. Either KZGSetupError a -> a
fromKZGSetup Either KZGSetupError [Point1]
KZG.g1Points

-- | Returns the first @n@ G2 powers of tau from the EIP-4844 trusted setup.
-- Used as the on-chain CRS for verifying membership proofs:
-- @[G2, τ·G2, ..., τ^(n-1)·G2]@.
crsG2Points :: Int -> [Point2]
crsG2Points :: Int -> [Point2]
crsG2Points Int
n = Int -> [Point2] -> [Point2]
forall a. Int -> [a] -> [a]
take Int
n ([Point2] -> [Point2]) -> [Point2] -> [Point2]
forall a b. (a -> b) -> a -> b
$ Either KZGSetupError [Point2] -> [Point2]
forall a. Either KZGSetupError a -> a
fromKZGSetup Either KZGSetupError [Point2]
KZG.g2Points

-- | Number of G2 points published in the on-chain CRS UTxO datum.
--
-- This is the __deployed__ G2 CRS length. It directly caps the largest
-- subset that can be verified in a single fanout / partial-fanout pairing
-- check: a subset of N elements yields a polynomial of degree N (one
-- @(X - sᵢ)@ factor per element), and the on-chain MSM to evaluate
-- @P_S(τ)·G2@ needs N+1 G2 points. With @defaultItems = 30@ the deployed
-- batch limit is therefore __29__.
--
-- The trusted-setup file embeds 65 G2 points (see
-- 'KZGTrustedSetup.maxFanoutBatchSize'); only the first 'defaultItems'
-- are written into the CRS UTxO at script-registry publication time
-- (see 'Hydra.Chain.ScriptRegistry.buildScriptPublishingTxs'). Raising
-- 'defaultItems' requires re-publishing the CRS UTxO and is bounded
-- above by @KZGTrustedSetup.maxFanoutBatchSize + 1@.
defaultItems :: Int
defaultItems :: Int
defaultItems = Int
KZG.defaultItems

-- | Returns the number of G1 CRS points required for this accumulator.
-- An n-element accumulator polynomial has degree n, so needs n+1 G1 points
-- @[G1, τ·G1, ..., τⁿ·G1]@ to compute the commitment A(τ)·G1 and proofs.
-- n is the total element count including duplicates (sum of all counts).
requiredCRSPointCount :: HydraAccumulator -> Int
requiredCRSPointCount :: HydraAccumulator -> Int
requiredCRSPointCount HydraAccumulator
ha = [Int] -> Int
forall a (f :: * -> *). (Foldable f, Num a) => f a -> a
sum (((ByteString, Int) -> Int) -> [(ByteString, Int)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Int) -> Int
forall a b. (a, b) -> b
snd ([(ByteString, Int)] -> [Int]) -> [(ByteString, Int)] -> [Int]
forall a b. (a -> b) -> a -> b
$ Accumulator -> [(ByteString, Int)]
forall k a. Map k a -> [a]
Map.elems (Accumulator -> [(ByteString, Int)])
-> Accumulator -> [(ByteString, Int)]
forall a b. (a -> b) -> a -> b
$ HydraAccumulator -> Accumulator
unHydraAccumulator HydraAccumulator
ha) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

-- * Cryptographic Proofs for partial fanout

-- | Create a membership proof for a subset of UTxO elements.
--
-- This function uses getPolyCommitOverG1 from haskell-accumulator's Bindings module:
-- https://github.com/cardano-scaling/haskell-accumulator/blob/main/haskell-accumulator/lib/Bindings.hs
--
-- Given a subset of elements and the full accumulator, it:
-- 1. Removes the subset elements from the accumulator
-- 2. Computes a polynomial commitment over G1 for the remaining elements
-- 3. Returns the proof as a compressed G1 point
createMembershipProof ::
  -- | The subset of elements to prove membership of (e.g., UTxOs being fanned out)
  [Element] ->
  -- | The full accumulator from the confirmed snapshot
  HydraAccumulator ->
  -- | Common Reference String (CRS) for the cryptographic proof
  [Point1] ->
  -- | Returns the compressed proof point, or an error if elements are missing or CRS is too short
  Either Text ByteString
createMembershipProof :: [ByteString]
-> HydraAccumulator -> [Point1] -> Either Text ByteString
createMembershipProof [ByteString]
subsetElements HydraAccumulator
fullAcc [Point1]
crs =
  (String -> Text)
-> (Point1 -> ByteString)
-> Either String Point1
-> Either Text ByteString
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap String -> Text
forall a. ToText a => a -> Text
toText Point1 -> ByteString
forall curve. BLS curve => Point curve -> ByteString
blsCompress (Either String Point1 -> Either Text ByteString)
-> Either String Point1 -> Either Text ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Accumulator -> [Point1] -> Either String Point1
getPolyCommitOverG1 [ByteString]
subsetElements (HydraAccumulator -> Accumulator
unHydraAccumulator HydraAccumulator
fullAcc) [Point1]
crs

-- | Create a membership proof from a UTxO subset.
--
-- This function extracts individual TxOut elements from the subset UTxO and proves
-- they exist in the full accumulator. The full accumulator must be built using
-- `buildFromUTxO` for this to work correctly.
--
-- The proof is verified on-chain via e(commitment_G1, G2) = e(proof_G1, P_S(τ)·G2).
createMembershipProofFromUTxO ::
  forall tx.
  IsTx tx =>
  -- | The subset of UTxO to prove membership of (e.g., UTxOs being fanned out)
  UTxOType tx ->
  -- | The full accumulator from the confirmed snapshot (built with buildFromUTxO)
  HydraAccumulator ->
  -- | Common Reference String (CRS) for the cryptographic proof
  [Point1] ->
  -- | Returns the compressed proof point, or an error if elements are missing or CRS is too short
  Either Text ByteString
createMembershipProofFromUTxO :: forall tx.
IsTx tx =>
UTxOType tx
-> HydraAccumulator -> [Point1] -> Either Text ByteString
createMembershipProofFromUTxO UTxOType tx
subsetUTxO HydraAccumulator
fullAcc [Point1]
crs =
  -- Extract individual TxOut elements from the subset (each TxOut -> hash).
  -- This matches how buildFromUTxO / buildFromSnapshotUTxOs serialize each TxOut.
  -- The underlying accumulator tracks element multiplicity (via Count), so duplicate
  -- elements are handled correctly.
  -- Drop mempty: TxOuts for which toPlutusTxOut returns Nothing yield mempty here;
  -- we only prove membership of outputs that convert successfully.
  let subsetElements :: [ByteString]
subsetElements = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
forall a. Monoid a => a
mempty) ([ByteString] -> [ByteString]) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ forall tx. IsTx tx => TxOutType tx -> ByteString
utxoToElement @tx (TxOutType tx -> ByteString) -> [TxOutType tx] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall tx. IsTx tx => UTxOType tx -> [TxOutType tx]
outputsOfUTxO @tx UTxOType tx
subsetUTxO
   in -- Use the element-based proof function
      [ByteString]
-> HydraAccumulator -> [Point1] -> Either Text ByteString
createMembershipProof [ByteString]
subsetElements HydraAccumulator
fullAcc [Point1]
crs

createCRSG2Datum :: Int -> HApi.TxOutDatum ctx
createCRSG2Datum :: forall ctx. Int -> TxOutDatum ctx
createCRSG2Datum Int
n =
  BabbageEraOnwards Era -> HashableScriptData -> TxOutDatum ctx Era
forall era ctx.
BabbageEraOnwards era -> HashableScriptData -> TxOutDatum ctx era
TxOutDatumInline BabbageEraOnwards Era
BabbageEraOnwardsConway (HashableScriptData -> TxOutDatum ctx Era)
-> HashableScriptData -> TxOutDatum ctx Era
forall a b. (a -> b) -> a -> b
$
    [BuiltinBLS12_381_G2_Element] -> HashableScriptData
forall a. ToScriptData a => a -> HashableScriptData
HApi.toScriptData
      (BuiltinByteString -> BuiltinBLS12_381_G2_Element
bls12_381_G2_uncompress (BuiltinByteString -> BuiltinBLS12_381_G2_Element)
-> (Point2 -> BuiltinByteString)
-> Point2
-> BuiltinBLS12_381_G2_Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin (ByteString -> BuiltinByteString)
-> (Point2 -> ByteString) -> Point2 -> BuiltinByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Point2 -> ByteString
forall curve. BLS curve => Point curve -> ByteString
blsCompress (Point2 -> BuiltinBLS12_381_G2_Element)
-> [Point2] -> [BuiltinBLS12_381_G2_Element]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> [Point2]
crsG2Points Int
n)