{-# OPTIONS_GHC -Wno-orphans #-}

module Hydra.Cardano.Api.TxId where

import Hydra.Cardano.Api.Prelude

import Cardano.Binary (FromCBOR (..), ToCBOR (..))
import Cardano.Crypto.Hash.Class qualified as CC
import Cardano.Ledger.SafeHash qualified as Ledger
import Cardano.Ledger.TxIn qualified as Ledger

-- missing CBOR instances

instance ToCBOR TxId where
  toCBOR :: TxId -> Encoding
toCBOR = ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ByteString -> Encoding)
-> (TxId -> ByteString) -> TxId -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes

instance FromCBOR TxId where
  fromCBOR :: forall s. Decoder s TxId
fromCBOR = do
    ByteString
bs <- Decoder s ByteString
forall s. Decoder s ByteString
forall a s. FromCBOR a => Decoder s a
fromCBOR
    case AsType TxId -> ByteString -> Either SerialiseAsRawBytesError TxId
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes AsType TxId
AsTxId ByteString
bs of
      Left SerialiseAsRawBytesError
err -> String -> Decoder s TxId
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (SerialiseAsRawBytesError -> String
forall a. Show a => a -> String
show SerialiseAsRawBytesError
err)
      Right TxId
v -> TxId -> Decoder s TxId
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure TxId
v

-- * Type Conversions

-- | Convert a cardano-api 'TxId' into a cardano-ledger 'TxId'.
toLedgerTxId :: TxId -> Ledger.TxId StandardCrypto
toLedgerTxId :: TxId -> TxId StandardCrypto
toLedgerTxId (TxId Hash StandardCrypto EraIndependentTxBody
h) =
  SafeHash StandardCrypto EraIndependentTxBody -> TxId StandardCrypto
forall c. SafeHash c EraIndependentTxBody -> TxId c
Ledger.TxId (Hash StandardCrypto EraIndependentTxBody
-> SafeHash StandardCrypto EraIndependentTxBody
forall c index. Hash (HASH c) index -> SafeHash c index
Ledger.unsafeMakeSafeHash (Hash Blake2b_256 EraIndependentTxBody
-> Hash Blake2b_256 EraIndependentTxBody
forall h a b. Hash h a -> Hash h b
CC.castHash Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
h))

-- | Convert a cardano-ledger 'TxId' into a cardano-api 'TxId'.
fromLedgerTxId :: Ledger.TxId StandardCrypto -> TxId
fromLedgerTxId :: TxId StandardCrypto -> TxId
fromLedgerTxId (Ledger.TxId SafeHash StandardCrypto EraIndependentTxBody
h) =
  Hash StandardCrypto EraIndependentTxBody -> TxId
TxId (Hash Blake2b_256 EraIndependentTxBody
-> Hash Blake2b_256 EraIndependentTxBody
forall h a b. Hash h a -> Hash h b
CC.castHash (SafeHash StandardCrypto EraIndependentTxBody
-> Hash StandardCrypto EraIndependentTxBody
forall c i. SafeHash c i -> Hash (HASH c) i
Ledger.extractHash SafeHash StandardCrypto EraIndependentTxBody
h))