{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Projection of a transaction id to its raw bytes.
--
-- Used by the tracing instances to render transaction ids, but it is a plain
-- projection over Consensus block types with no dependency on the logging
-- framework.
module Ouroboros.Consensus.Tracing.ConvertTxId
  ( ConvertTxId (..)
  ) where

import qualified Cardano.Crypto.Hash as Crypto
import qualified Cardano.Crypto.Hashing as Byron.Crypto
import qualified Cardano.Ledger.Hashes as Ledger
import qualified Cardano.Ledger.TxIn as Ledger
import Data.ByteString (ByteString)
import Data.SOP
import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
import Ouroboros.Consensus.Byron.Ledger.Mempool (TxId (..))
import Ouroboros.Consensus.HardFork.Combinator
import Ouroboros.Consensus.Shelley.Ledger.Block (ShelleyBlock)
import Ouroboros.Consensus.Shelley.Ledger.Mempool (TxId (..))
import Ouroboros.Consensus.TypeFamilyWrappers (unwrapGenTxId)

-- | Convert a transaction ID to raw bytes.
class ConvertTxId blk where
  txIdToRawBytes :: TxId (GenTx blk) -> ByteString

instance ConvertTxId ByronBlock where
  txIdToRawBytes :: TxId (GenTx ByronBlock) -> ByteString
txIdToRawBytes (ByronTxId TxId
txId) = TxId -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes TxId
txId
  txIdToRawBytes (ByronDlgId CertificateId
dlgId) = CertificateId -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes CertificateId
dlgId
  txIdToRawBytes (ByronUpdateProposalId UpId
upId) =
    UpId -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes UpId
upId
  txIdToRawBytes (ByronUpdateVoteId VoteId
voteId) =
    VoteId -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes VoteId
voteId

instance ConvertTxId (ShelleyBlock protocol c) where
  txIdToRawBytes :: TxId (GenTx (ShelleyBlock protocol c)) -> ByteString
txIdToRawBytes (ShelleyTxId TxId
txId) =
    Hash HASH EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes (Hash HASH EraIndependentTxBody -> ByteString)
-> (TxId -> Hash HASH EraIndependentTxBody) -> TxId -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody
forall i. SafeHash i -> Hash HASH i
Ledger.extractHash (SafeHash EraIndependentTxBody -> Hash HASH EraIndependentTxBody)
-> (TxId -> SafeHash EraIndependentTxBody)
-> TxId
-> Hash HASH EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> SafeHash EraIndependentTxBody
Ledger.unTxId (TxId -> ByteString) -> TxId -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId
txId

instance
  All ConvertTxId xs =>
  ConvertTxId (HardForkBlock xs)
  where
  txIdToRawBytes :: TxId (GenTx (HardForkBlock xs)) -> ByteString
txIdToRawBytes =
    NS (K ByteString) xs -> ByteString
NS (K ByteString) xs -> CollapseTo NS ByteString
forall (xs :: [*]) a.
SListIN NS xs =>
NS (K a) xs -> CollapseTo NS a
forall k l (h :: (k -> *) -> l -> *) (xs :: l) a.
(HCollapse h, SListIN h xs) =>
h (K a) xs -> CollapseTo h a
hcollapse
      (NS (K ByteString) xs -> ByteString)
-> (TxId (GenTx (HardForkBlock xs)) -> NS (K ByteString) xs)
-> TxId (GenTx (HardForkBlock xs))
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy ConvertTxId
-> (forall a. ConvertTxId a => WrapGenTxId a -> K ByteString a)
-> NS WrapGenTxId xs
-> NS (K ByteString) xs
forall {k} {l} (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *)
       (f' :: k -> *).
(AllN (Prod h) c xs, HAp h) =>
proxy c
-> (forall (a :: k). c a => f a -> f' a) -> h f xs -> h f' xs
hcmap (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @ConvertTxId) (ByteString -> K ByteString a
forall k a (b :: k). a -> K a b
K (ByteString -> K ByteString a)
-> (WrapGenTxId a -> ByteString) -> WrapGenTxId a -> K ByteString a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId (GenTx a) -> ByteString
forall blk. ConvertTxId blk => TxId (GenTx blk) -> ByteString
txIdToRawBytes (TxId (GenTx a) -> ByteString)
-> (WrapGenTxId a -> TxId (GenTx a)) -> WrapGenTxId a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapGenTxId a -> TxId (GenTx a)
forall blk. WrapGenTxId blk -> GenTxId blk
unwrapGenTxId)
      (NS WrapGenTxId xs -> NS (K ByteString) xs)
-> (TxId (GenTx (HardForkBlock xs)) -> NS WrapGenTxId xs)
-> TxId (GenTx (HardForkBlock xs))
-> NS (K ByteString) xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraGenTxId xs -> NS WrapGenTxId xs
forall (xs :: [*]). OneEraGenTxId xs -> NS WrapGenTxId xs
getOneEraGenTxId
      (OneEraGenTxId xs -> NS WrapGenTxId xs)
-> (TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs)
-> TxId (GenTx (HardForkBlock xs))
-> NS WrapGenTxId xs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
forall (xs :: [*]).
TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
getHardForkGenTxId