{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}

-- | Build Cardano 'OneEraGenTxId' values from raw hash bytes, one per era.
--
-- Shared by the txid @Eq@\/@Ord@ benchmark and the txid @Eq@\/@Ord@
-- equivalence test: both need to place a chosen 32-byte hash at a chosen era
-- position, without going through the network or the ledger.
module Test.Consensus.Cardano.GenTxIdBuilders
  ( BuildGenTxId (..)
  , apInjs
  , buildNP
  , oneEraGenTxIds
  ) where

import Cardano.Crypto.Hashing (unsafeAbstractHashFromShort)
import Cardano.Ledger.Hashes (unsafeMakeSafeHash)
import qualified Cardano.Ledger.Shelley.API as SL
import Data.ByteString.Short (ShortByteString)
import Data.SOP (All, Proxy (..), SListI)
import Data.SOP.Strict (NP, NS, hap, hcollapse, hcpure, injections)
import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
import Ouroboros.Consensus.Byron.Ledger.Mempool (TxId (ByronTxId))
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras
  ( OneEraGenTxId (..)
  )
import Ouroboros.Consensus.Ledger.SupportsMempool (GenTxId)
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
import Ouroboros.Consensus.Shelley.Ledger.Mempool (TxId (ShelleyTxId))
import Ouroboros.Consensus.TypeFamilyWrappers (WrapGenTxId (..))
import Ouroboros.Consensus.Util (hashFromBytesShortE)

-- | Build a transaction id for one era from raw hash bytes. Each era wraps its
-- hash differently, hence one instance per era shape.
class BuildGenTxId blk where
  buildGenTxId :: ShortByteString -> GenTxId blk

instance BuildGenTxId (ShelleyBlock proto era) where
  buildGenTxId :: ShortByteString -> GenTxId (ShelleyBlock proto era)
buildGenTxId ShortByteString
bs = TxId -> GenTxId (ShelleyBlock proto era)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
ShelleyTxId (SafeHash EraIndependentTxBody -> TxId
SL.TxId (Hash HASH EraIndependentTxBody -> SafeHash EraIndependentTxBody
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (ShortByteString -> Hash HASH EraIndependentTxBody
forall h a.
(HashAlgorithm h, HasCallStack) =>
ShortByteString -> Hash h a
hashFromBytesShortE ShortByteString
bs)))

instance BuildGenTxId ByronBlock where
  buildGenTxId :: ShortByteString -> GenTxId ByronBlock
buildGenTxId ShortByteString
bs = TxId -> GenTxId ByronBlock
ByronTxId (ShortByteString -> TxId
forall algo a. ShortByteString -> AbstractHash algo a
unsafeAbstractHashFromShort ShortByteString
bs)

-- | One leaf per era, every era sharing the given hash bytes.
buildNP :: All BuildGenTxId xs => ShortByteString -> NP WrapGenTxId xs
buildNP :: forall (xs :: [*]).
All BuildGenTxId xs =>
ShortByteString -> NP WrapGenTxId xs
buildNP ShortByteString
bs = Proxy BuildGenTxId
-> (forall a. BuildGenTxId a => WrapGenTxId a) -> NP WrapGenTxId xs
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @BuildGenTxId) (GenTxId a -> WrapGenTxId a
forall blk. GenTxId blk -> WrapGenTxId blk
WrapGenTxId (ShortByteString -> GenTxId a
forall blk. BuildGenTxId blk => ShortByteString -> GenTxId blk
buildGenTxId ShortByteString
bs))

-- | Inject each leaf into the sum at its own era position. The strict 'NS' has
-- no @apInjs_NP@, so we go through 'injections'.
apInjs :: SListI xs => NP f xs -> [NS f xs]
apInjs :: forall (xs :: [*]) (f :: * -> *). SListI xs => NP f xs -> [NS f xs]
apInjs NP f xs
np = NP (K (NS f xs)) xs -> CollapseTo NP (NS f xs)
forall (xs :: [*]) a.
SListIN NP xs =>
NP (K a) xs -> CollapseTo NP a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse (Prod NP (f -.-> K (NS f xs)) xs -> NP f xs -> NP (K (NS f xs)) xs
forall k l (h :: (k -> *) -> l -> *) (f :: k -> *) (g :: k -> *)
       (xs :: l).
HAp h =>
Prod h (f -.-> g) xs -> h f xs -> h g xs
forall (f :: * -> *) (g :: * -> *) (xs :: [*]).
Prod NP (f -.-> g) xs -> NP f xs -> NP g xs
hap Prod NP (f -.-> K (NS f xs)) xs
NP (f -.-> K (NS f xs)) xs
forall {k} (xs :: [k]) (f :: k -> *).
SListI xs =>
NP (Injection f xs) xs
injections NP f xs
np)

-- | One 'OneEraGenTxId' per era, list index equal to the era position, every
-- entry carrying the given hash bytes.
oneEraGenTxIds :: All BuildGenTxId xs => ShortByteString -> [OneEraGenTxId xs]
oneEraGenTxIds :: forall (xs :: [*]).
All BuildGenTxId xs =>
ShortByteString -> [OneEraGenTxId xs]
oneEraGenTxIds ShortByteString
bs = NS WrapGenTxId xs -> OneEraGenTxId xs
forall (xs :: [*]). NS WrapGenTxId xs -> OneEraGenTxId xs
OneEraGenTxId (NS WrapGenTxId xs -> OneEraGenTxId xs)
-> [NS WrapGenTxId xs] -> [OneEraGenTxId xs]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NP WrapGenTxId xs -> [NS WrapGenTxId xs]
forall (xs :: [*]) (f :: * -> *). SListI xs => NP f xs -> [NS f xs]
apInjs (ShortByteString -> NP WrapGenTxId xs
forall (xs :: [*]).
All BuildGenTxId xs =>
ShortByteString -> NP WrapGenTxId xs
buildNP ShortByteString
bs)