-- | This module exposes the generation of various kinds of credentials
module Cooked.MockChain.GenerateTx.Credential
  ( toRewardAccount,
    toCardanoCredential,
    toStakeCredential,
    deserialiseFromBuiltinByteString,
    toScriptHash,
    toKeyHash,
    toDRepCredential,
    toStakePoolKeyHash,
    toColdCredential,
    toHotCredential,
    toVRFVerKeyHash,
  )
where

import Cardano.Api qualified as Cardano
import Cardano.Ledger.BaseTypes qualified as C.Ledger
import Cardano.Ledger.Hashes qualified as C.Ledger
import Cardano.Ledger.Shelley.API qualified as C.Ledger
import Ledger.Tx.CardanoAPI qualified as Ledger
import PlutusLedgerApi.V3 qualified as Api
import Polysemy
import Polysemy.Error

-- | Translates a given credential to a reward account.
toRewardAccount ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.Credential ->
  Sem effs C.Ledger.RewardAccount
toRewardAccount :: forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs RewardAccount
toRewardAccount =
  (Network -> Credential 'Staking -> RewardAccount
C.Ledger.RewardAccount Network
C.Ledger.Testnet (Credential 'Staking -> RewardAccount)
-> Sem effs (Credential 'Staking) -> Sem effs RewardAccount
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    (Sem effs (Credential 'Staking) -> Sem effs RewardAccount)
-> (Credential -> Sem effs (Credential 'Staking))
-> Credential
-> Sem effs RewardAccount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType StakeKey
-> (Hash StakeKey -> KeyHash 'Staking)
-> Credential
-> Sem effs (Credential 'Staking)
forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr)
-> Credential
-> Sem effs (Credential kr)
toCardanoCredential AsType StakeKey
Cardano.AsStakeKey Hash StakeKey -> KeyHash 'Staking
Cardano.unStakeKeyHash

-- TODO: if this works, migrate to plutus-ledger

-- | Converts an 'Api.PubKeyHash' to any kind of key
deserialiseFromBuiltinByteString ::
  ( Member (Error Ledger.ToCardanoError) effs,
    Cardano.SerialiseAsRawBytes a
  ) =>
  Cardano.AsType a ->
  Api.BuiltinByteString ->
  Sem effs a
deserialiseFromBuiltinByteString :: forall (effs :: EffectRow) a.
(Member (Error ToCardanoError) effs, SerialiseAsRawBytes a) =>
AsType a -> BuiltinByteString -> Sem effs a
deserialiseFromBuiltinByteString AsType a
asType =
  Either ToCardanoError a -> Sem effs a
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither
    (Either ToCardanoError a -> Sem effs a)
-> (BuiltinByteString -> Either ToCardanoError a)
-> BuiltinByteString
-> Sem effs a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType a -> ByteString -> Either ToCardanoError a
forall t.
SerialiseAsRawBytes t =>
AsType t -> ByteString -> Either ToCardanoError t
Ledger.deserialiseFromRawBytes AsType a
asType
    (ByteString -> Either ToCardanoError a)
-> (BuiltinByteString -> ByteString)
-> BuiltinByteString
-> Either ToCardanoError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinByteString -> ByteString
BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
Api.fromBuiltin

-- | Converts a plutus script hash into a cardano ledger script hash
toScriptHash ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.ScriptHash ->
  Sem effs C.Ledger.ScriptHash
toScriptHash :: forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
ScriptHash -> Sem effs ScriptHash
toScriptHash (Api.ScriptHash BuiltinByteString
sHash) = do
  Cardano.ScriptHash ScriptHash
cHash <- AsType ScriptHash -> BuiltinByteString -> Sem effs ScriptHash
forall (effs :: EffectRow) a.
(Member (Error ToCardanoError) effs, SerialiseAsRawBytes a) =>
AsType a -> BuiltinByteString -> Sem effs a
deserialiseFromBuiltinByteString AsType ScriptHash
Cardano.AsScriptHash BuiltinByteString
sHash
  ScriptHash -> Sem effs ScriptHash
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return ScriptHash
cHash

-- | Converts a plutus pkhash into a certain cardano ledger hash
toKeyHash ::
  ( Member (Error Ledger.ToCardanoError) effs,
    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
  ) =>
  Cardano.AsType key ->
  (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
  Api.PubKeyHash ->
  Sem effs (C.Ledger.KeyHash kr)
toKeyHash :: forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr) -> PubKeyHash -> Sem effs (KeyHash kr)
toKeyHash AsType key
asType Hash key -> KeyHash kr
unwrap =
  (Hash key -> KeyHash kr)
-> Sem effs (Hash key) -> Sem effs (KeyHash kr)
forall a b. (a -> b) -> Sem effs a -> Sem effs b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Hash key -> KeyHash kr
unwrap
    (Sem effs (Hash key) -> Sem effs (KeyHash kr))
-> (PubKeyHash -> Sem effs (Hash key))
-> PubKeyHash
-> Sem effs (KeyHash kr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (Hash key) -> BuiltinByteString -> Sem effs (Hash key)
forall (effs :: EffectRow) a.
(Member (Error ToCardanoError) effs, SerialiseAsRawBytes a) =>
AsType a -> BuiltinByteString -> Sem effs a
deserialiseFromBuiltinByteString (AsType key -> AsType (Hash key)
forall a. AsType a -> AsType (Hash a)
Cardano.AsHash AsType key
asType)
    (BuiltinByteString -> Sem effs (Hash key))
-> (PubKeyHash -> BuiltinByteString)
-> PubKeyHash
-> Sem effs (Hash key)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PubKeyHash -> BuiltinByteString
Api.getPubKeyHash

-- | Converts an 'Api.PubKeyHash' into a cardano ledger stake pool key hash
toStakePoolKeyHash ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.PubKeyHash ->
  Sem effs (C.Ledger.KeyHash 'C.Ledger.StakePool)
toStakePoolKeyHash :: forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
PubKeyHash -> Sem effs (KeyHash 'StakePool)
toStakePoolKeyHash = AsType StakePoolKey
-> (Hash StakePoolKey -> KeyHash 'StakePool)
-> PubKeyHash
-> Sem effs (KeyHash 'StakePool)
forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr) -> PubKeyHash -> Sem effs (KeyHash kr)
toKeyHash AsType StakePoolKey
Cardano.AsStakePoolKey Hash StakePoolKey -> KeyHash 'StakePool
Cardano.unStakePoolKeyHash

-- | Converts an 'Api.PubKeyHash' into a cardano ledger VRFVerKeyHash
toVRFVerKeyHash ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.PubKeyHash ->
  Sem effs (C.Ledger.VRFVerKeyHash a)
toVRFVerKeyHash :: forall (effs :: EffectRow) (a :: KeyRoleVRF).
Member (Error ToCardanoError) effs =>
PubKeyHash -> Sem effs (VRFVerKeyHash a)
toVRFVerKeyHash (Api.PubKeyHash BuiltinByteString
pkh) = do
  Cardano.VrfKeyHash Hash HASH (VerKeyVRF (VRF StandardCrypto))
key <- AsType (Hash VrfKey) -> BuiltinByteString -> Sem effs (Hash VrfKey)
forall (effs :: EffectRow) a.
(Member (Error ToCardanoError) effs, SerialiseAsRawBytes a) =>
AsType a -> BuiltinByteString -> Sem effs a
deserialiseFromBuiltinByteString (AsType VrfKey -> AsType (Hash VrfKey)
forall a. AsType a -> AsType (Hash a)
Cardano.AsHash AsType VrfKey
Cardano.AsVrfKey) BuiltinByteString
pkh
  VRFVerKeyHash a -> Sem effs (VRFVerKeyHash a)
forall a. a -> Sem effs a
forall (m :: * -> *) a. Monad m => a -> m a
return (VRFVerKeyHash a -> Sem effs (VRFVerKeyHash a))
-> VRFVerKeyHash a -> Sem effs (VRFVerKeyHash a)
forall a b. (a -> b) -> a -> b
$ Hash HASH (VerKeyVRF PraosVRF) -> VRFVerKeyHash a
forall v (r :: KeyRoleVRF).
Hash HASH (VerKeyVRF v) -> VRFVerKeyHash r
C.Ledger.toVRFVerKeyHash Hash HASH (VerKeyVRF PraosVRF)
Hash HASH (VerKeyVRF (VRF StandardCrypto))
key

-- | Converts an 'Api.Credential' to a Cardano Credential of the expected kind
toCardanoCredential ::
  ( Member (Error Ledger.ToCardanoError) effs,
    Cardano.SerialiseAsRawBytes (Cardano.Hash key)
  ) =>
  Cardano.AsType key ->
  (Cardano.Hash key -> C.Ledger.KeyHash kr) ->
  Api.Credential ->
  Sem effs (C.Ledger.Credential kr)
toCardanoCredential :: forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr)
-> Credential
-> Sem effs (Credential kr)
toCardanoCredential AsType key
_ Hash key -> KeyHash kr
_ (Api.ScriptCredential ScriptHash
sHash) = ScriptHash -> Credential kr
forall (kr :: KeyRole). ScriptHash -> Credential kr
C.Ledger.ScriptHashObj (ScriptHash -> Credential kr)
-> Sem effs ScriptHash -> Sem effs (Credential kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScriptHash -> Sem effs ScriptHash
forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
ScriptHash -> Sem effs ScriptHash
toScriptHash ScriptHash
sHash
toCardanoCredential AsType key
asType Hash key -> KeyHash kr
unwrap (Api.PubKeyCredential PubKeyHash
pkHash) = KeyHash kr -> Credential kr
forall (kr :: KeyRole). KeyHash kr -> Credential kr
C.Ledger.KeyHashObj (KeyHash kr -> Credential kr)
-> Sem effs (KeyHash kr) -> Sem effs (Credential kr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType key
-> (Hash key -> KeyHash kr) -> PubKeyHash -> Sem effs (KeyHash kr)
forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr) -> PubKeyHash -> Sem effs (KeyHash kr)
toKeyHash AsType key
asType Hash key -> KeyHash kr
unwrap PubKeyHash
pkHash

-- | Translates a credential into a Cardano stake credential
toStakeCredential ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.Credential ->
  Sem effs (C.Ledger.Credential 'C.Ledger.Staking)
toStakeCredential :: forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'Staking)
toStakeCredential = AsType StakeKey
-> (Hash StakeKey -> KeyHash 'Staking)
-> Credential
-> Sem effs (Credential 'Staking)
forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr)
-> Credential
-> Sem effs (Credential kr)
toCardanoCredential AsType StakeKey
Cardano.AsStakeKey Hash StakeKey -> KeyHash 'Staking
Cardano.unStakeKeyHash

-- | Translates a credential into a Cardano drep credential
toDRepCredential ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.Credential ->
  Sem effs (C.Ledger.Credential 'C.Ledger.DRepRole)
toDRepCredential :: forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'DRepRole)
toDRepCredential = AsType DRepKey
-> (Hash DRepKey -> KeyHash 'DRepRole)
-> Credential
-> Sem effs (Credential 'DRepRole)
forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr)
-> Credential
-> Sem effs (Credential kr)
toCardanoCredential AsType DRepKey
Cardano.AsDRepKey Hash DRepKey -> KeyHash 'DRepRole
Cardano.unDRepKeyHash

-- | Translates a credential into a Cardano cold committee credential
toColdCredential ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.Credential ->
  Sem effs (C.Ledger.Credential 'C.Ledger.ColdCommitteeRole)
toColdCredential :: forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'ColdCommitteeRole)
toColdCredential = AsType CommitteeColdKey
-> (Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole)
-> Credential
-> Sem effs (Credential 'ColdCommitteeRole)
forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr)
-> Credential
-> Sem effs (Credential kr)
toCardanoCredential AsType CommitteeColdKey
Cardano.AsCommitteeColdKey Hash CommitteeColdKey -> KeyHash 'ColdCommitteeRole
Cardano.unCommitteeColdKeyHash

-- | Translates a credential into a Cardano hot committee credential
toHotCredential ::
  (Member (Error Ledger.ToCardanoError) effs) =>
  Api.Credential ->
  Sem effs (C.Ledger.Credential 'C.Ledger.HotCommitteeRole)
toHotCredential :: forall (effs :: EffectRow).
Member (Error ToCardanoError) effs =>
Credential -> Sem effs (Credential 'HotCommitteeRole)
toHotCredential = AsType CommitteeHotKey
-> (Hash CommitteeHotKey -> KeyHash 'HotCommitteeRole)
-> Credential
-> Sem effs (Credential 'HotCommitteeRole)
forall (effs :: EffectRow) key (kr :: KeyRole).
(Member (Error ToCardanoError) effs,
 SerialiseAsRawBytes (Hash key)) =>
AsType key
-> (Hash key -> KeyHash kr)
-> Credential
-> Sem effs (Credential kr)
toCardanoCredential AsType CommitteeHotKey
Cardano.AsCommitteeHotKey Hash CommitteeHotKey -> KeyHash 'HotCommitteeRole
Cardano.unCommitteeHotKeyHash