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

module Bcc.Tracing.ConvertTxId
  ( ConvertTxId (..)
  ) where

import           Bcc.Prelude hiding (All)

import           Data.SOP.Strict

import qualified Bcc.Crypto.Hash as Crypto
import qualified Bcc.Crypto.Hashing as Cole.Crypto
import qualified Bcc.Ledger.SafeHash as Ledger
import           Shardagnostic.Consensus.Cole.Ledger.Block (ColeBlock)
import           Shardagnostic.Consensus.Cole.Ledger.Mempool (TxId (..))
import           Shardagnostic.Consensus.HardFork.Combinator
import           Shardagnostic.Consensus.Sophie.Ledger.Block (SophieBlock)
import           Shardagnostic.Consensus.Sophie.Ledger.Mempool (TxId (..))
import           Shardagnostic.Consensus.TypeFamilyWrappers
import qualified Sophie.Spec.Ledger.TxBody as Sophie

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

instance ConvertTxId ColeBlock where
  txIdToRawBytes :: TxId (GenTx ColeBlock) -> ByteString
txIdToRawBytes (ColeTxId txId) = AbstractHash Blake2b_256 Tx -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Cole.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Tx
txId
  txIdToRawBytes (ColeDlgId dlgId) = AbstractHash Blake2b_256 Certificate -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Cole.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Certificate
dlgId
  txIdToRawBytes (ColeUpdateProposalId upId) =
    AbstractHash Blake2b_256 Proposal -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Cole.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Proposal
upId
  txIdToRawBytes (ColeUpdateVoteId voteId) =
    AbstractHash Blake2b_256 Vote -> ByteString
forall algo a. AbstractHash algo a -> ByteString
Cole.Crypto.abstractHashToBytes AbstractHash Blake2b_256 Vote
voteId

instance ConvertTxId (SophieBlock c) where
  txIdToRawBytes :: TxId (GenTx (SophieBlock c)) -> ByteString
txIdToRawBytes (SophieTxId 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
Sophie._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