{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

module Test.Cardano.Protocol.Crypto.KES (
  KESKeyPair (..),
) where

import Cardano.Crypto.KES (
  UnsoundPureKESAlgorithm (..),
  seedSizeKES,
  unsoundPureDeriveVerKeyKES,
  unsoundPureGenKeyKES,
 )
import qualified Cardano.Crypto.KES.Class as KES
import Cardano.Crypto.Seed
import Cardano.Protocol.Crypto
import Data.Proxy
import Test.Cardano.Ledger.Binary.Arbitrary (genByteString)
import Test.Cardano.Ledger.Common

data KESKeyPair c = KESKeyPair
  { forall c. KESKeyPair c -> UnsoundPureSignKeyKES (KES c)
kesSignKey :: !(KES.UnsoundPureSignKeyKES (KES c))
  , forall c. KESKeyPair c -> VerKeyKES (KES c)
kesVerKey :: !(KES.VerKeyKES (KES c))
  }

instance Show (KES.VerKeyKES (KES c)) => Show (KESKeyPair c) where
  show :: KESKeyPair c -> String
show (KESKeyPair UnsoundPureSignKeyKES (KES c)
_ VerKeyKES (KES c)
vk) =
    -- showing `SignKeyKES` is impossible for security reasons.
    String
"KESKeyPair <SignKeyKES> " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show VerKeyKES (KES c)
vk

-- TODO: upstream into `cardano-base`

-- | Generate a `Seed` with specified number of bytes, which can only be positive.
genSeedN :: HasCallStack => Int -> Gen Seed
genSeedN :: HasCallStack => Int -> Gen Seed
genSeedN Int
n
  | Int
n forall a. Ord a => a -> a -> Bool
>= Int
1 = ByteString -> Seed
mkSeedFromBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genByteString Int
n
  | Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Seed cannot be empty. Supplied " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n forall a. [a] -> [a] -> [a]
++ String
" for the size of the seed"

instance Crypto c => Arbitrary (KESKeyPair c) where
  arbitrary :: Gen (KESKeyPair c)
arbitrary = do
    UnsoundPureSignKeyKES (KES c)
signKey <- forall v.
UnsoundPureKESAlgorithm v =>
Seed -> UnsoundPureSignKeyKES v
unsoundPureGenKeyKES forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Int -> Gen Seed
genSeedN (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
seedSizeKES (forall {k} (t :: k). Proxy t
Proxy @(KES c))))
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      KESKeyPair
        { kesSignKey :: UnsoundPureSignKeyKES (KES c)
kesSignKey = UnsoundPureSignKeyKES (KES c)
signKey
        , kesVerKey :: VerKeyKES (KES c)
kesVerKey = forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES (KES c)
signKey
        }