{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Test.Cardano.Ledger.Shelley.Examples.Cast
-- Description : Cast of characters for Shelley ledger examples
--
-- The cast of Characters for Shelley Ledger Examples
-- (excluding the genesis/cord nodes,
-- which are in Test.Cardano.Ledger.Shelley.Examples.Federation).
module Test.Cardano.Ledger.Shelley.Examples.Cast (
  alicePay,
  aliceStake,
  alicePHK,
  aliceSHK,
  aliceAddr,
  alicePtrAddr,
  alicePoolKeys,
  alicePoolParams,
  aliceVRFKeyHash,
  bobPay,
  bobStake,
  bobSHK,
  bobAddr,
  bobPoolKeys,
  bobPoolParams,
  bobVRFKeyHash,
  carlPay,
  carlStake,
  carlSHK,
  carlAddr,
  dariaPay,
  dariaStake,
  dariaSHK,
  dariaAddr,
)
where

import Cardano.Ledger.Address (Addr (..), RewardAccount (..))
import Cardano.Ledger.BaseTypes (
  Network (..),
  StrictMaybe (..),
  textToUrl,
 )
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (
  Credential (..),
  Ptr (..),
  StakeReference (..),
 )
import Cardano.Ledger.Keys (
  KeyRole (..),
  KeyRoleVRF (StakePoolVRF),
  VRFVerKeyHash,
  hashKey,
 )
import Cardano.Ledger.PoolParams (
  PoolMetadata (..),
  PoolParams (..),
 )
import Cardano.Ledger.Slot (SlotNo (..))
import Cardano.Protocol.Crypto (hashVerKeyVRF)
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import qualified Data.ByteString.Char8 as BS (pack)
import qualified Data.List.NonEmpty as NE
import Data.Maybe (fromJust)
import qualified Data.Sequence.Strict as StrictSeq
import qualified Data.Set as Set
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Generator.Core (
  AllIssuerKeys (..),
  VRFKeyPair (..),
 )
import Test.Cardano.Ledger.Shelley.Utils (
  RawSeed (..),
  mkKESKeyPair,
  mkKeyPair,
  mkVRFKeyPair,
  unsafeBoundRational,
 )

-- | Alice's payment key pair
alicePay :: KeyPair 'Payment
alicePay :: KeyPair 'Payment
alicePay = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
0 Word64
0 Word64
0 Word64
0 Word64
0)

-- | Alice's stake key pair
aliceStake :: KeyPair 'Staking
aliceStake :: KeyPair 'Staking
aliceStake = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
1 Word64
1 Word64
1 Word64
1)

-- | Alice's stake pool keys (cold keys, VRF keys, hot KES keys)
alicePoolKeys :: AllIssuerKeys MockCrypto 'StakePool
alicePoolKeys :: AllIssuerKeys MockCrypto 'StakePool
alicePoolKeys =
  forall c (r :: KeyRole).
KeyPair r
-> VRFKeyPair c
-> NonEmpty (KESPeriod, KESKeyPair c)
-> KeyHash r
-> AllIssuerKeys c r
AllIssuerKeys
    (forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vkCold SignKeyDSIGN DSIGN
skCold)
    (forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
2))
    ((Word -> KESPeriod
KESPeriod Word
0, forall c. Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
3)) forall a. a -> [a] -> NonEmpty a
NE.:| [])
    (forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall {kd :: KeyRole}. VKey kd
vkCold)
  where
    (SignKeyDSIGN DSIGN
skCold, VKey kd
vkCold) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
1 Word64
0 Word64
0 Word64
0 Word64
1)

-- | Alice's base address
aliceAddr :: Addr
aliceAddr :: Addr
aliceAddr = (KeyPair 'Payment, KeyPair 'Staking) -> Addr
mkAddr (KeyPair 'Payment
alicePay, KeyPair 'Staking
aliceStake)

-- | Alice's payment credential
alicePHK :: Credential 'Payment
alicePHK :: Credential 'Payment
alicePHK = (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) KeyPair 'Payment
alicePay

-- | Alice's stake credential
aliceSHK :: Credential 'Staking
aliceSHK :: Credential 'Staking
aliceSHK = (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) KeyPair 'Staking
aliceStake

-- | Alice's base address
alicePtrAddr :: Addr
alicePtrAddr :: Addr
alicePtrAddr = Network -> Credential 'Payment -> StakeReference -> Addr
Addr Network
Testnet Credential 'Payment
alicePHK (Ptr -> StakeReference
StakeRefPtr forall a b. (a -> b) -> a -> b
$ SlotNo -> TxIx -> CertIx -> Ptr
Ptr (Word64 -> SlotNo
SlotNo Word64
10) forall a. Bounded a => a
minBound forall a. Bounded a => a
minBound)

-- | Alice's stake pool parameters
alicePoolParams :: PoolParams
alicePoolParams :: PoolParams
alicePoolParams =
  PoolParams
    { ppId :: KeyHash 'StakePool
ppId = 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 c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys MockCrypto 'StakePool
alicePoolKeys
    , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys MockCrypto 'StakePool
alicePoolKeys
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
1
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
5
    , ppMargin :: UnitInterval
ppMargin = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , ppRewardAccount :: RewardAccount
ppRewardAccount = Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
aliceSHK
    , ppOwners :: Set (KeyHash 'Staking)
ppOwners = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ (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) KeyPair 'Staking
aliceStake
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays = forall a. StrictSeq a
StrictSeq.empty
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata =
        forall a. a -> StrictMaybe a
SJust forall a b. (a -> b) -> a -> b
$
          PoolMetadata
            { pmUrl :: Url
pmUrl = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadFail m => Int -> Text -> m Url
textToUrl Int
64 Text
"alice.pool"
            , pmHash :: ByteString
pmHash = String -> ByteString
BS.pack String
"{}"
            }
    }

-- | Alice's VRF key hash
aliceVRFKeyHash :: VRFVerKeyHash 'StakePoolVRF
aliceVRFKeyHash :: VRFVerKeyHash 'StakePoolVRF
aliceVRFKeyHash = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto (forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys MockCrypto 'StakePool
alicePoolKeys)

-- | Bob's payment key pair
bobPay :: KeyPair 'Payment
bobPay :: KeyPair 'Payment
bobPay = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
2 Word64
2 Word64
2 Word64
2 Word64
2)

-- | Bob's stake key pair
bobStake :: KeyPair 'Staking
bobStake :: KeyPair 'Staking
bobStake = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
3 Word64
3 Word64
3 Word64
3 Word64
3)

-- | Bob's address
bobAddr :: Addr
bobAddr :: Addr
bobAddr = (KeyPair 'Payment, KeyPair 'Staking) -> Addr
mkAddr (KeyPair 'Payment
bobPay, KeyPair 'Staking
bobStake)

-- | Bob's stake credential
bobSHK :: Credential 'Staking
bobSHK :: Credential 'Staking
bobSHK = (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) KeyPair 'Staking
bobStake

-- | Bob's stake pool keys (cold keys, VRF keys, hot KES keys)
bobPoolKeys :: AllIssuerKeys MockCrypto 'StakePool
bobPoolKeys :: AllIssuerKeys MockCrypto 'StakePool
bobPoolKeys =
  forall c (r :: KeyRole).
KeyPair r
-> VRFKeyPair c
-> NonEmpty (KESPeriod, KESKeyPair c)
-> KeyHash r
-> AllIssuerKeys c r
AllIssuerKeys
    (forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vkCold SignKeyDSIGN DSIGN
skCold)
    (forall c. Crypto c => RawSeed -> VRFKeyPair c
mkVRFKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
2 Word64
0 Word64
0 Word64
0 Word64
2))
    ((Word -> KESPeriod
KESPeriod Word
0, forall c. Crypto c => RawSeed -> KESKeyPair c
mkKESKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
2 Word64
0 Word64
0 Word64
0 Word64
3)) forall a. a -> [a] -> NonEmpty a
NE.:| [])
    (forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey forall {kd :: KeyRole}. VKey kd
vkCold)
  where
    (SignKeyDSIGN DSIGN
skCold, VKey kd
vkCold) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
2 Word64
0 Word64
0 Word64
0 Word64
1)

-- | Bob's stake pool parameters
bobPoolParams :: PoolParams
bobPoolParams :: PoolParams
bobPoolParams =
  PoolParams
    { ppId :: KeyHash 'StakePool
ppId = 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 c (r :: KeyRole). AllIssuerKeys c r -> KeyPair r
aikCold AllIssuerKeys MockCrypto 'StakePool
bobPoolKeys
    , ppVrf :: VRFVerKeyHash 'StakePoolVRF
ppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys MockCrypto 'StakePool
bobPoolKeys
    , ppPledge :: Coin
ppPledge = Integer -> Coin
Coin Integer
2
    , ppCost :: Coin
ppCost = Integer -> Coin
Coin Integer
1
    , ppMargin :: UnitInterval
ppMargin = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
0.1
    , ppRewardAccount :: RewardAccount
ppRewardAccount = Network -> Credential 'Staking -> RewardAccount
RewardAccount Network
Testnet Credential 'Staking
bobSHK
    , ppOwners :: Set (KeyHash 'Staking)
ppOwners = forall a. a -> Set a
Set.singleton forall a b. (a -> b) -> a -> b
$ forall (kd :: KeyRole). VKey kd -> KeyHash kd
hashKey (forall (kd :: KeyRole). KeyPair kd -> VKey kd
vKey KeyPair 'Staking
bobStake)
    , ppRelays :: StrictSeq StakePoolRelay
ppRelays = forall a. StrictSeq a
StrictSeq.empty
    , ppMetadata :: StrictMaybe PoolMetadata
ppMetadata = forall a. StrictMaybe a
SNothing
    }

-- | Bob's VRF key hash
bobVRFKeyHash :: VRFVerKeyHash 'StakePoolVRF
bobVRFKeyHash :: VRFVerKeyHash 'StakePoolVRF
bobVRFKeyHash = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @MockCrypto (forall c. VRFKeyPair c -> VerKeyVRF (VRF c)
vrfVerKey forall a b. (a -> b) -> a -> b
$ forall c (r :: KeyRole). AllIssuerKeys c r -> VRFKeyPair c
aikVrf AllIssuerKeys MockCrypto 'StakePool
bobPoolKeys)

-- Carl's payment key pair
carlPay :: KeyPair 'Payment
carlPay :: KeyPair 'Payment
carlPay = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
4 Word64
4 Word64
4 Word64
4 Word64
4)

-- | Carl's stake key pair
carlStake :: KeyPair 'Staking
carlStake :: KeyPair 'Staking
carlStake = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
5 Word64
5 Word64
5 Word64
5 Word64
5)

-- | Carl's address
carlAddr :: Addr
carlAddr :: Addr
carlAddr = (KeyPair 'Payment, KeyPair 'Staking) -> Addr
mkAddr (KeyPair 'Payment
carlPay, KeyPair 'Staking
carlStake)

-- | Carl's stake credential
carlSHK :: Credential 'Staking
carlSHK :: Credential 'Staking
carlSHK = (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) KeyPair 'Staking
carlStake

-- | Daria's payment key pair
dariaPay :: KeyPair 'Payment
dariaPay :: KeyPair 'Payment
dariaPay = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
6 Word64
6 Word64
6 Word64
6 Word64
6)

-- | Daria's stake key pair
dariaStake :: KeyPair 'Staking
dariaStake :: KeyPair 'Staking
dariaStake = forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
KeyPair forall {kd :: KeyRole}. VKey kd
vk SignKeyDSIGN DSIGN
sk
  where
    (SignKeyDSIGN DSIGN
sk, VKey kd
vk) = forall (kd :: KeyRole). RawSeed -> (SignKeyDSIGN DSIGN, VKey kd)
mkKeyPair (Word64 -> Word64 -> Word64 -> Word64 -> Word64 -> RawSeed
RawSeed Word64
7 Word64
7 Word64
7 Word64
7 Word64
7)

-- | Daria's address
dariaAddr :: Addr
dariaAddr :: Addr
dariaAddr = (KeyPair 'Payment, KeyPair 'Staking) -> Addr
mkAddr (KeyPair 'Payment
dariaPay, KeyPair 'Staking
dariaStake)

-- | Daria's stake credential
dariaSHK :: Credential 'Staking
dariaSHK :: Credential 'Staking
dariaSHK = (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) KeyPair 'Staking
dariaStake