module Hydra.Cardano.Api.Hash where

import Hydra.Cardano.Api.Prelude

import Cardano.Ledger.Keys qualified as Ledger
import Cardano.Ledger.Plutus.TxInfo (transKeyHash)
import Cardano.Ledger.SafeHash (unsafeMakeSafeHash)
import Data.ByteString qualified as BS
import PlutusLedgerApi.V3 qualified as Plutus

-- * Type conversions

-- | Convert a cardano-api 'Hash' into a plutus 'PubKeyHash'
toPlutusKeyHash :: Hash PaymentKey -> Plutus.PubKeyHash
toPlutusKeyHash :: Hash PaymentKey -> PubKeyHash
toPlutusKeyHash (PaymentKeyHash KeyHash 'Payment StandardCrypto
vkh) = KeyHash 'Payment StandardCrypto -> PubKeyHash
forall (d :: KeyRole) c. KeyHash d c -> PubKeyHash
transKeyHash KeyHash 'Payment StandardCrypto
vkh

-- | Convert a cardano-api 'Hash' into a cardano-ledger 'KeyHash'
toLedgerKeyHash :: Hash PaymentKey -> Ledger.KeyHash 'Ledger.Witness StandardCrypto
toLedgerKeyHash :: Hash PaymentKey -> KeyHash 'Witness StandardCrypto
toLedgerKeyHash (PaymentKeyHash (Ledger.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh)) =
  Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Witness StandardCrypto
forall (r :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c)) -> KeyHash r c
Ledger.KeyHash Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
vkh

-- | Unsafe wrap some bytes as a 'Hash PaymentKey'.
--
-- Pre-condition: the input bytestring MUST be of length 28.
unsafePaymentKeyHashFromBytes ::
  HasCallStack =>
  ByteString ->
  Hash PaymentKey
unsafePaymentKeyHashFromBytes :: HasCallStack => ByteString -> Hash PaymentKey
unsafePaymentKeyHashFromBytes ByteString
bytes
  | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
28 =
      [Char] -> Hash PaymentKey
forall a. HasCallStack => [Char] -> a
error ([Char] -> Hash PaymentKey) -> [Char] -> Hash PaymentKey
forall a b. (a -> b) -> a -> b
$ [Char]
"unsafePaymentKeyHashFromBytes: pre-condition failed: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bytes) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" bytes."
  | Bool
otherwise =
      KeyHash 'Payment StandardCrypto -> Hash PaymentKey
PaymentKeyHash (KeyHash 'Payment StandardCrypto -> Hash PaymentKey)
-> KeyHash 'Payment StandardCrypto -> Hash PaymentKey
forall a b. (a -> b) -> a -> b
$ Hash (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Payment StandardCrypto
forall (r :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c)) -> KeyHash r c
Ledger.KeyHash (Hash
   (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
 -> KeyHash 'Payment StandardCrypto)
-> Hash
     (ADDRHASH StandardCrypto) (VerKeyDSIGN (DSIGN StandardCrypto))
-> KeyHash 'Payment StandardCrypto
forall a b. (a -> b) -> a -> b
$ ByteString -> Hash Blake2b_224 (VerKeyDSIGN Ed25519DSIGN)
forall hash a.
(HasCallStack, HashAlgorithm hash) =>
ByteString -> Hash hash a
unsafeHashFromBytes ByteString
bytes

-- | Unsafe wrap some bytes as a 'Hash ScriptData', relying on the fact that
-- Plutus is using Blake2b_256 for hashing data (according to 'cardano-ledger').
--
-- Pre-condition: the input bytestring MUST be of length 32.
unsafeScriptDataHashFromBytes ::
  HasCallStack =>
  ByteString ->
  Hash ScriptData
unsafeScriptDataHashFromBytes :: HasCallStack => ByteString -> Hash ScriptData
unsafeScriptDataHashFromBytes ByteString
bytes
  | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 =
      [Char] -> Hash ScriptData
forall a. HasCallStack => [Char] -> a
error ([Char] -> Hash ScriptData) -> [Char] -> Hash ScriptData
forall a b. (a -> b) -> a -> b
$ [Char]
"unsafeScriptDataHashFromBytes: pre-condition failed: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bytes) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
" bytes."
  | Bool
otherwise =
      DataHash StandardCrypto -> Hash ScriptData
ScriptDataHash
        (DataHash StandardCrypto -> Hash ScriptData)
-> (Hash Blake2b_256 EraIndependentData -> DataHash StandardCrypto)
-> Hash Blake2b_256 EraIndependentData
-> Hash ScriptData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH StandardCrypto) EraIndependentData
-> DataHash StandardCrypto
Hash Blake2b_256 EraIndependentData -> DataHash StandardCrypto
forall c index. Hash (HASH c) index -> SafeHash c index
unsafeMakeSafeHash
        (Hash Blake2b_256 EraIndependentData -> Hash ScriptData)
-> Hash Blake2b_256 EraIndependentData -> Hash ScriptData
forall a b. (a -> b) -> a -> b
$ ByteString -> Hash Blake2b_256 EraIndependentData
forall hash a.
(HasCallStack, HashAlgorithm hash) =>
ByteString -> Hash hash a
unsafeHashFromBytes ByteString
bytes

-- NOTE: The constructor for Hash isn't exposed in the cardano-api. Although
-- there's a 'CastHash' type-class, there are not instances for everything, so
-- we have to resort to binary serialisation/deserialisation to cast hashes.
unsafeCastHash ::
  (SerialiseAsCBOR (Hash a), SerialiseAsCBOR (Hash b), HasCallStack) =>
  Hash a ->
  Hash b
unsafeCastHash :: forall a b.
(SerialiseAsCBOR (Hash a), SerialiseAsCBOR (Hash b),
 HasCallStack) =>
Hash a -> Hash b
unsafeCastHash Hash a
a =
  (DecoderError -> Hash b)
-> (Hash b -> Hash b) -> Either DecoderError (Hash b) -> Hash b
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
    (\DecoderError
e -> [Char] -> Hash b
forall a. HasCallStack => [Char] -> a
error ([Char] -> Hash b) -> [Char] -> Hash b
forall a b. (a -> b) -> a -> b
$ [Char]
"unsafeCastHash: incompatible hash: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> DecoderError -> [Char]
forall a. Show a => a -> [Char]
show DecoderError
e)
    Hash b -> Hash b
forall a. a -> a
id
    (AsType (Hash b) -> ByteString -> Either DecoderError (Hash b)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
deserialiseFromCBOR (Proxy (Hash b) -> AsType (Hash b)
forall t. HasTypeProxy t => Proxy t -> AsType t
proxyToAsType Proxy (Hash b)
forall {k} (t :: k). Proxy t
Proxy) (Hash a -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
serialiseToCBOR Hash a
a))