{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# 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 (SignKeyDSIGN)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
import Cardano.Ledger.Keys (DSIGN, VKey, WitVKey (..))
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessVKey)
import Test.Cardano.Ledger.Generic.Proof (Proof (..))
import Test.Cardano.Ledger.Shelley.Utils (RawSeed (..), mkKeyPair)

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

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

-- By changing the parameter 'n', we get a different keyPair
theKeyPair :: Int -> KeyPair kr
theKeyPair :: forall (kr :: KeyRole). Int -> KeyPair kr
theKeyPair Int
n = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair VKey kr
a SignKeyDSIGN DSIGN
b
  where
    (SignKeyDSIGN DSIGN
b, VKey kr
a) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
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 :: Int -> VKey kr
theVKey :: forall (kr :: KeyRole). Int -> VKey kr
theVKey Int
n = forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey (forall (kr :: KeyRole). Int -> KeyPair kr
theKeyPair Int
n)

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

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

theWitVKey ::
  Int ->
  SafeHash EraIndependentTxBody ->
  WitVKey 'Witness
theWitVKey :: Int -> SafeHash EraIndependentTxBody -> WitVKey 'Witness
theWitVKey Int
n SafeHash EraIndependentTxBody
hash = forall (kr :: KeyRole).
SafeHash EraIndependentTxBody -> KeyPair kr -> WitVKey 'Witness
mkWitnessVKey SafeHash EraIndependentTxBody
hash (forall (kr :: KeyRole). Int -> KeyPair kr
theKeyPair Int
n)

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

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

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