{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Tools for building unique Key (and related types) by just supplying an Int
--   Each Int returns a different Key (or related type)
--   Useful when writing unit tests
module Test.Cardano.Ledger.Generic.Indexed where

import Cardano.Crypto.DSIGN.Class ()
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Crypto (Crypto)
import qualified Cardano.Ledger.Crypto as CC (Crypto)
import Cardano.Ledger.Keys (KeyHash, KeyRole (Witness), SignKeyDSIGN, VKey, WitVKey (..), hashKey)
import Cardano.Ledger.SafeHash (SafeHash)
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessVKey)
import Test.Cardano.Ledger.Generic.Proof (GoodCrypto, Proof (..))
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair)

-- =======================================================
-- Keys and KeyHashes

-- | A signing key
newtype SKey (kr :: KeyRole) c = SKey (SignKeyDSIGN c)

-- By changing the parameter 'n', we get a different keyPair
theKeyPair :: Crypto c => Int -> KeyPair kr c
theKeyPair :: forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair Int
n = forall (kd :: KeyRole) c.
VKey kd c -> SignKeyDSIGN (DSIGN c) -> KeyPair kd c
KeyPair VKey kr c
a SignKeyDSIGN (DSIGN c)
b
  where
    (SignKeyDSIGN (DSIGN c)
b, VKey kr c
a) = forall c (kd :: KeyRole).
DSIGNAlgorithm (DSIGN c) =>
RawSeed -> (SignKeyDSIGN (DSIGN c), VKey kd c)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n))

theVKey :: CC.Crypto c => Int -> VKey kr c
theVKey :: forall c (kr :: KeyRole). Crypto c => Int -> VKey kr c
theVKey Int
n = forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey (forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair Int
n)

theSKey :: forall c kr. CC.Crypto c => Int -> SKey kr c
theSKey :: forall c (kr :: KeyRole). Crypto c => Int -> SKey kr c
theSKey Int
n = forall (kr :: KeyRole) c. SignKeyDSIGN c -> SKey kr c
SKey (forall (kd :: KeyRole) c. KeyPair kd c -> SignKeyDSIGN (DSIGN c)
sKey (forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair @c Int
n))

theKeyHash :: CC.Crypto c => Int -> KeyHash kr c
theKeyHash :: forall c (kr :: KeyRole). Crypto c => Int -> KeyHash kr c
theKeyHash Int
n = forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey (forall c (kr :: KeyRole). Crypto c => Int -> VKey kr c
theVKey Int
n)

theWitVKey ::
  GoodCrypto c =>
  Int ->
  SafeHash c EraIndependentTxBody ->
  WitVKey 'Witness c
theWitVKey :: forall c.
GoodCrypto c =>
Int -> SafeHash c EraIndependentTxBody -> WitVKey 'Witness c
theWitVKey Int
n SafeHash c EraIndependentTxBody
hash = forall c (kr :: KeyRole).
(Crypto c, DSignable c (Hash (HASH c) EraIndependentTxBody)) =>
SafeHash c EraIndependentTxBody
-> KeyPair kr c -> WitVKey 'Witness c
mkWitnessVKey SafeHash c EraIndependentTxBody
hash (forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair Int
n)

theKeyHashObj :: CC.Crypto c => Int -> Credential kr c
theKeyHashObj :: forall c (kr :: KeyRole). Crypto c => Int -> Credential kr c
theKeyHashObj Int
n = forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kd :: KeyRole) c. KeyPair kd c -> VKey kd c
vKey forall a b. (a -> b) -> a -> b
$ forall c (kr :: KeyRole). Crypto c => Int -> KeyPair kr c
theKeyPair Int
n

aScriptHashObj ::
  forall era kr. EraScript era => Proof era -> Script era -> Credential kr (EraCrypto era)
aScriptHashObj :: forall era (kr :: KeyRole).
EraScript era =>
Proof era -> Script era -> Credential kr (EraCrypto era)
aScriptHashObj Proof era
_wit Script era
s = forall (kr :: KeyRole) c. ScriptHash c -> Credential kr c
ScriptHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraScript era =>
Script era -> ScriptHash (EraCrypto era)
hashScript @era forall a b. (a -> b) -> a -> b
$ Script era
s

theStakeReference :: CC.Crypto c => Int -> StakeReference c
theStakeReference :: forall c. Crypto c => Int -> StakeReference c
theStakeReference Int
n = (forall c. StakeCredential c -> StakeReference c
StakeRefBase forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
hashKey) (forall c (kr :: KeyRole). Crypto c => Int -> VKey kr c
theVKey Int
n)