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

module Cardano.Tracing.ConvertTxId
  ( ConvertTxId (..)
  ) where

import           Cardano.Prelude hiding (All)

import           Data.SOP.Strict

import qualified Cardano.Crypto.Hash as Crypto
import qualified Cardano.Crypto.Hashing as Byron.Crypto
import qualified Cardano.Ledger.SafeHash as Ledger
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
import qualified Shelley.Spec.Ledger.TxBody as Shelley

-- | 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) = AbstractHash Blake2b_256 Tx -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Tx
txId
  txIdToRawBytes (ByronDlgId dlgId) = AbstractHash Blake2b_256 Certificate -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Certificate
dlgId
  txIdToRawBytes (ByronUpdateProposalId upId) =
    AbstractHash Blake2b_256 Proposal -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Proposal
upId
  txIdToRawBytes (ByronUpdateVoteId voteId) =
    AbstractHash Blake2b_256 Vote -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Byron.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Vote
voteId

instance ConvertTxId (ShelleyBlock c) where
  txIdToRawBytes :: TxId (GenTx (ShelleyBlock c)) -> ByteString
txIdToRawBytes (ShelleyTxId txId) =
    Hash (HASH (Crypto c)) EraIndependentTxBody -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes (Hash (HASH (Crypto c)) EraIndependentTxBody -> ByteString)
-> (TxId (Crypto c) -> Hash (HASH (Crypto c)) EraIndependentTxBody)
-> TxId (Crypto c)
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SafeHash (Crypto c) EraIndependentTxBody
-> Hash (HASH (Crypto c)) EraIndependentTxBody
forall crypto i. SafeHash crypto i -> Hash (HASH crypto) i
Ledger.extractHash (SafeHash (Crypto c) EraIndependentTxBody
 -> Hash (HASH (Crypto c)) EraIndependentTxBody)
-> (TxId (Crypto c) -> SafeHash (Crypto c) EraIndependentTxBody)
-> TxId (Crypto c)
-> Hash (HASH (Crypto c)) EraIndependentTxBody
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId (Crypto c) -> SafeHash (Crypto c) EraIndependentTxBody
forall crypto. TxId crypto -> SafeHash crypto EraIndependentTxBody
Shelley._unTxId (TxId (Crypto c) -> ByteString) -> TxId (Crypto c) -> ByteString
forall a b. (a -> b) -> a -> b
$ TxId (Crypto c)
txId

instance All ConvertTxId xs
      => ConvertTxId (HardForkBlock xs) where
  txIdToRawBytes :: TxId (GenTx (HardForkBlock xs)) -> ByteString
txIdToRawBytes =
    NS (K ByteString) xs -> ByteString
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (Proxy ConvertTxId
forall k (t :: k). 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
forall (xs :: [*]).
TxId (GenTx (HardForkBlock xs)) -> OneEraGenTxId xs
getHardForkGenTxId