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 Cardano.Ledger.Shelley.Scripts qualified as Ledger
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 (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator 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 (discriminator :: KeyRole) c.
Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> KeyHash discriminator 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 'ScriptHash', relying on the fact that Plutus
-- is using Blake2b_224 for hashing data (according to 'cardano-ledger').
--
-- Pre-condition: the input bytestring MUST be of length 28.
unsafeScriptHashFromBytes ::
  HasCallStack =>
  ByteString ->
  ScriptHash
unsafeScriptHashFromBytes :: HasCallStack => ByteString -> ScriptHash
unsafeScriptHashFromBytes ByteString
bytes
  | ByteString -> Int
BS.length ByteString
bytes Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
28 =
      [Char] -> ScriptHash
forall a. HasCallStack => [Char] -> a
error ([Char] -> ScriptHash) -> [Char] -> ScriptHash
forall a b. (a -> b) -> a -> b
$ [Char]
"unsafeScriptHashFromBytes: 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 =
      ScriptHash StandardCrypto -> ScriptHash
fromShelleyScriptHash
        (ScriptHash StandardCrypto -> ScriptHash)
-> (Hash Blake2b_224 EraIndependentScript
    -> ScriptHash StandardCrypto)
-> Hash Blake2b_224 EraIndependentScript
-> ScriptHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (ADDRHASH StandardCrypto) EraIndependentScript
-> ScriptHash StandardCrypto
Hash Blake2b_224 EraIndependentScript -> ScriptHash StandardCrypto
forall c. Hash (ADDRHASH c) EraIndependentScript -> ScriptHash c
Ledger.ScriptHash
        (Hash Blake2b_224 EraIndependentScript -> ScriptHash)
-> Hash Blake2b_224 EraIndependentScript -> ScriptHash
forall a b. (a -> b) -> a -> b
$ ByteString -> Hash Blake2b_224 EraIndependentScript
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))