diff --git a/cabal.project b/cabal.project
index ede6e58dfa1..bf6c35d1086 100644
--- a/cabal.project
+++ b/cabal.project
@@ -74,7 +74,7 @@ package cardano-ledger-core
 package cardano-ledger-shelley
   flags: +asserts
 
--- Always write GHC env files, because they are needed by the doctests.
+-- Always write GHC env files, because they are needed by for repl and doctest.
 write-ghc-environment-files: always
 
 -- Always build tests and benchmarks.
diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs
index 920fef885a7..6b1cffa23b6 100644
--- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs
+++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs
@@ -27,7 +27,7 @@ import Cardano.Ledger.BaseTypes (BlocksMade, ShelleyBase, epochInfoPure)
 import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Keys (DSignable, Hash, coerceKeyRole)
-import Cardano.Ledger.Shelley.BlockChain (bBodySize, incrBlocks)
+import Cardano.Ledger.Shelley.BlockChain (incrBlocks)
 import Cardano.Ledger.Shelley.Era (ShelleyBBODY)
 import Cardano.Ledger.Shelley.LedgerState (
   AccountState,
diff --git a/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Rewards.hs b/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Rewards.hs
index faaceb04f2a..18ddf805580 100644
--- a/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Rewards.hs
+++ b/eras/shelley/test-suite/bench/Cardano/Ledger/Shelley/Bench/Rewards.hs
@@ -53,6 +53,7 @@ import Test.Cardano.Ledger.Shelley.Generator.Core (
   AllIssuerKeys (..),
   GenEnv (..),
   ScriptSpace (..),
+  VRFKeyPair (..),
   geConstants,
   geKeySpace,
   ksStakePools,
@@ -136,12 +137,12 @@ genChainInEpoch epoch = do
       ShelleyGenesisStaking
         { sgsPools =
             LM.ListMap
-              [ (hk, pp)
-              | (AllIssuerKeys {vrf, hk}, (owner : _)) <- stakeMap
+              [ (aikColdKeyHash, pp)
+              | (AllIssuerKeys {aikVrf, aikColdKeyHash}, (owner : _)) <- stakeMap
               , let pp =
                       PoolParams
-                        { ppId = hk
-                        , ppVrf = hashVerKeyVRF $ snd vrf
+                        { ppId = aikColdKeyHash
+                        , ppVrf = hashVerKeyVRF $ vrfVerKey aikVrf
                         , ppPledge = Coin 1
                         , ppCost = Coin 1
                         , ppMargin = minBound
@@ -153,8 +154,8 @@ genChainInEpoch epoch = do
               ]
         , sgsStake =
             LM.ListMap
-              [ (dlg, hk)
-              | (AllIssuerKeys {hk}, dlgs) <- stakeMap
+              [ (dlg, aikColdKeyHash)
+              | (AllIssuerKeys {aikColdKeyHash}, dlgs) <- stakeMap
               , dlg <- dlgs
               ]
         }
diff --git a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal
index 0fc2b159583..a10db3ade47 100644
--- a/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal
+++ b/eras/shelley/test-suite/cardano-ledger-shelley-test.cabal
@@ -21,7 +21,6 @@ source-repository head
 
 library
     exposed-modules:
-        Test.Cardano.Crypto.VRF.Fake
         Test.Cardano.Ledger.TerseTools
         Test.Cardano.Ledger.Shelley.Address.Bootstrap
         Test.Cardano.Ledger.Shelley.BenchmarkFunctions
@@ -169,7 +168,7 @@ test-suite cardano-ledger-shelley-test
         cardano-ledger-pretty,
         cardano-ledger-shelley:{cardano-ledger-shelley, testlib},
         cardano-ledger-shelley-test >=1.1,
-        cardano-protocol-tpraos,
+        cardano-protocol-tpraos:{cardano-protocol-tpraos, testlib},
         cardano-slotting,
         cborg,
         containers,
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs
index f97a4a72a4c..cd742e848e3 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs
@@ -89,6 +89,7 @@ import qualified Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes as Original (
   C_Crypto,
  )
 import Test.Cardano.Ledger.Shelley.Generator.Core (
+  VRFKeyPair (..),
   genesisCoins,
  )
 import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
@@ -394,18 +395,18 @@ firstStakePoolKeyHash :: KeyHash 'StakePool B_Crypto
 firstStakePoolKeyHash = mkPoolKeyHash firstStakePool
 
 vrfKeyHash :: Hash B_Crypto (VerKeyVRF B_Crypto)
-vrfKeyHash = hashVerKeyVRF . snd . mkVRFKeyPair $ RawSeed 0 0 0 0 0
+vrfKeyHash = hashVerKeyVRF . vrfVerKey . mkVRFKeyPair @B_Crypto $ RawSeed 0 0 0 0 0
 
 mkPoolParameters :: KeyPair 'StakePool B_Crypto -> PoolParams B_Crypto
 mkPoolParameters keys =
   PoolParams
-    { ppId = (hashKey . vKey) keys
+    { ppId = hashKey (vKey keys)
     , ppVrf = vrfKeyHash
     , ppPledge = Coin 0
     , ppCost = Coin 0
     , ppMargin = unsafeBoundRational 0
     , ppRewardAcnt = RewardAcnt Testnet firstStakeKeyCred
-    , ppOwners = Set.singleton $ (hashKey . vKey) stakeKeyOne
+    , ppOwners = Set.singleton $ hashKey (vKey stakeKeyOne)
     , ppRelays = StrictSeq.empty
     , ppMetadata = SNothing
     }
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/ConcreteCryptoTypes.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/ConcreteCryptoTypes.hs
index 056db778b88..28306ec142e 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/ConcreteCryptoTypes.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/ConcreteCryptoTypes.hs
@@ -24,7 +24,7 @@ import Cardano.Ledger.BaseTypes (Seed)
 import Cardano.Ledger.Crypto
 import Cardano.Ledger.Shelley (ShelleyEra)
 import Cardano.Protocol.TPraos.API (PraosCrypto)
-import Test.Cardano.Crypto.VRF.Fake (FakeVRF)
+import Test.Cardano.Protocol.Crypto.VRF.Fake (FakeVRF)
 
 -- | Mocking constraints used in generators
 type Mock c =
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Cast.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Cast.hs
index 23af642f455..121476a9454 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Cast.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Cast.hs
@@ -51,7 +51,7 @@ import Cardano.Ledger.Credential (
   Ptr (..),
   StakeReference (..),
  )
-import qualified Cardano.Ledger.Crypto as CC (Crypto)
+import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Keys (
   Hash,
   KeyRole (..),
@@ -67,12 +67,14 @@ import Cardano.Ledger.Shelley.TxBody (
 import Cardano.Ledger.Slot (SlotNo (..))
 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.Generator.Core (
   AllIssuerKeys (..),
+  VRFKeyPair (..),
  )
 import Test.Cardano.Ledger.Shelley.Utils (
   RawSeed (..),
@@ -83,50 +85,50 @@ import Test.Cardano.Ledger.Shelley.Utils (
  )
 
 -- | Alice's payment key pair
-alicePay :: CC.Crypto c => KeyPair 'Payment c
+alicePay :: Crypto c => KeyPair 'Payment c
 alicePay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 0 0 0 0 0)
 
 -- | Alice's stake key pair
-aliceStake :: CC.Crypto c => KeyPair 'Staking c
+aliceStake :: Crypto c => KeyPair 'Staking c
 aliceStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 1 1 1 1 1)
 
 -- | Alice's stake pool keys (cold keys, VRF keys, hot KES keys)
-alicePoolKeys :: CC.Crypto c => AllIssuerKeys c 'StakePool
+alicePoolKeys :: Crypto c => AllIssuerKeys c 'StakePool
 alicePoolKeys =
   AllIssuerKeys
     (KeyPair vkCold skCold)
     (mkVRFKeyPair (RawSeed 1 0 0 0 2))
-    [(KESPeriod 0, mkKESKeyPair (RawSeed 1 0 0 0 3))]
+    ((KESPeriod 0, mkKESKeyPair (RawSeed 1 0 0 0 3)) NE.:| [])
     (hashKey vkCold)
   where
     (skCold, vkCold) = mkKeyPair (RawSeed 1 0 0 0 1)
 
 -- | Alice's base address
-aliceAddr :: CC.Crypto c => Addr c
+aliceAddr :: Crypto c => Addr c
 aliceAddr = mkAddr (alicePay, aliceStake)
 
 -- | Alice's payment credential
-alicePHK :: CC.Crypto c => Credential 'Payment c
+alicePHK :: Crypto c => Credential 'Payment c
 alicePHK = (KeyHashObj . hashKey . vKey) alicePay
 
 -- | Alice's stake credential
-aliceSHK :: CC.Crypto c => Credential 'Staking c
+aliceSHK :: Crypto c => Credential 'Staking c
 aliceSHK = (KeyHashObj . hashKey . vKey) aliceStake
 
 -- | Alice's base address
-alicePtrAddr :: CC.Crypto c => Addr c
+alicePtrAddr :: Crypto c => Addr c
 alicePtrAddr = Addr Testnet alicePHK (StakeRefPtr $ Ptr (SlotNo 10) minBound minBound)
 
 -- | Alice's stake pool parameters
-alicePoolParams :: forall c. CC.Crypto c => PoolParams c
+alicePoolParams :: forall c. Crypto c => PoolParams c
 alicePoolParams =
   PoolParams
-    { ppId = (hashKey . vKey . cold) alicePoolKeys
-    , ppVrf = hashVerKeyVRF . snd $ vrf (alicePoolKeys @c)
+    { ppId = hashKey . vKey $ aikCold alicePoolKeys
+    , ppVrf = hashVerKeyVRF . vrfVerKey $ aikVrf (alicePoolKeys @c)
     , ppPledge = Coin 1
     , ppCost = Coin 5
     , ppMargin = unsafeBoundRational 0.1
@@ -144,52 +146,52 @@ alicePoolParams =
 -- | Alice's VRF key hash
 aliceVRFKeyHash ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   Hash c (VerKeyVRF c)
-aliceVRFKeyHash = hashVerKeyVRF (snd $ vrf (alicePoolKeys @c))
+aliceVRFKeyHash = hashVerKeyVRF (vrfVerKey $ aikVrf (alicePoolKeys @c))
 
 -- | Bob's payment key pair
-bobPay :: CC.Crypto c => KeyPair 'Payment c
+bobPay :: Crypto c => KeyPair 'Payment c
 bobPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 2 2 2 2 2)
 
 -- | Bob's stake key pair
-bobStake :: CC.Crypto c => KeyPair 'Staking c
+bobStake :: Crypto c => KeyPair 'Staking c
 bobStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 3 3 3 3 3)
 
 -- | Bob's address
-bobAddr :: CC.Crypto c => Addr c
+bobAddr :: Crypto c => Addr c
 bobAddr = mkAddr (bobPay, bobStake)
 
 -- | Bob's stake credential
-bobSHK :: CC.Crypto c => Credential 'Staking c
+bobSHK :: Crypto c => Credential 'Staking c
 bobSHK = (KeyHashObj . hashKey . vKey) bobStake
 
 -- | Bob's stake pool keys (cold keys, VRF keys, hot KES keys)
-bobPoolKeys :: CC.Crypto c => AllIssuerKeys c 'StakePool
+bobPoolKeys :: Crypto c => AllIssuerKeys c 'StakePool
 bobPoolKeys =
   AllIssuerKeys
     (KeyPair vkCold skCold)
     (mkVRFKeyPair (RawSeed 2 0 0 0 2))
-    [(KESPeriod 0, mkKESKeyPair (RawSeed 2 0 0 0 3))]
+    ((KESPeriod 0, mkKESKeyPair (RawSeed 2 0 0 0 3)) NE.:| [])
     (hashKey vkCold)
   where
     (skCold, vkCold) = mkKeyPair (RawSeed 2 0 0 0 1)
 
 -- | Bob's stake pool parameters
-bobPoolParams :: forall c. CC.Crypto c => PoolParams c
+bobPoolParams :: forall c. Crypto c => PoolParams c
 bobPoolParams =
   PoolParams
-    { ppId = (hashKey . vKey . cold) bobPoolKeys
-    , ppVrf = hashVerKeyVRF . snd $ vrf (bobPoolKeys @c)
+    { ppId = hashKey . vKey $ aikCold bobPoolKeys
+    , ppVrf = hashVerKeyVRF . vrfVerKey $ aikVrf (bobPoolKeys @c)
     , ppPledge = Coin 2
     , ppCost = Coin 1
     , ppMargin = unsafeBoundRational 0.1
     , ppRewardAcnt = RewardAcnt Testnet bobSHK
-    , ppOwners = Set.singleton $ (hashKey . vKey) bobStake
+    , ppOwners = Set.singleton $ hashKey (vKey bobStake)
     , ppRelays = StrictSeq.empty
     , ppMetadata = SNothing
     }
@@ -197,46 +199,46 @@ bobPoolParams =
 -- | Bob's VRF key hash
 bobVRFKeyHash ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   Hash c (VerKeyVRF c)
-bobVRFKeyHash = hashVerKeyVRF (snd $ vrf (bobPoolKeys @c))
+bobVRFKeyHash = hashVerKeyVRF (vrfVerKey $ aikVrf (bobPoolKeys @c))
 
 -- Carl's payment key pair
-carlPay :: CC.Crypto c => KeyPair 'Payment c
+carlPay :: Crypto c => KeyPair 'Payment c
 carlPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 4 4 4 4 4)
 
 -- | Carl's stake key pair
-carlStake :: CC.Crypto c => KeyPair 'Staking c
+carlStake :: Crypto c => KeyPair 'Staking c
 carlStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 5 5 5 5 5)
 
 -- | Carl's address
-carlAddr :: CC.Crypto c => Addr c
+carlAddr :: Crypto c => Addr c
 carlAddr = mkAddr (carlPay, carlStake)
 
 -- | Carl's stake credential
-carlSHK :: CC.Crypto c => Credential 'Staking c
+carlSHK :: Crypto c => Credential 'Staking c
 carlSHK = (KeyHashObj . hashKey . vKey) carlStake
 
 -- | Daria's payment key pair
-dariaPay :: CC.Crypto c => KeyPair 'Payment c
+dariaPay :: Crypto c => KeyPair 'Payment c
 dariaPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 6 6 6 6 6)
 
 -- | Daria's stake key pair
-dariaStake :: CC.Crypto c => KeyPair 'Staking c
+dariaStake :: Crypto c => KeyPair 'Staking c
 dariaStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 7 7 7 7 7)
 
 -- | Daria's address
-dariaAddr :: CC.Crypto c => Addr c
+dariaAddr :: Crypto c => Addr c
 dariaAddr = mkAddr (dariaPay, dariaStake)
 
 -- | Daria's stake credential
-dariaSHK :: CC.Crypto c => Credential 'Staking c
+dariaSHK :: Crypto c => Credential 'Staking c
 dariaSHK = (KeyHashObj . hashKey . vKey) dariaStake
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs
index 613bca7af77..cb25703b3db 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs
@@ -38,6 +38,7 @@ import Cardano.Slotting.EpochInfo
 import qualified Data.ByteString as Strict
 import Data.Coerce (coerce)
 import Data.Default.Class
+import qualified Data.List.NonEmpty as NE
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust)
@@ -174,8 +175,8 @@ exampleShelleyLedgerBlock tx = Block blockHeader blockBody
     keys :: AllIssuerKeys (EraCrypto era) 'StakePool
     keys = exampleKeys
 
-    (_, (hotKey, _)) = head $ hot keys
-    KeyPair vKeyCold _ = cold keys
+    hotKey = kesSignKey $ snd $ NE.head $ aikHot keys
+    KeyPair vKeyCold _ = aikCold keys
 
     blockHeader :: BHeader (EraCrypto era)
     blockHeader = BHeader blockHeaderBody (signedKES () 0 blockHeaderBody hotKey)
@@ -187,9 +188,9 @@ exampleShelleyLedgerBlock tx = Block blockHeader blockBody
         , bheaderSlotNo = SlotNo 9
         , bheaderPrev = BlockHash (HashHeader (mkDummyHash (2 :: Int)))
         , bheaderVk = coerceKeyRole vKeyCold
-        , bheaderVrfVk = snd $ vrf keys
-        , bheaderEta = mkCertifiedVRF (mkBytes 0) (fst $ vrf keys)
-        , bheaderL = mkCertifiedVRF (mkBytes 1) (fst $ vrf keys)
+        , bheaderVrfVk = vrfVerKey $ aikVrf keys
+        , bheaderEta = mkCertifiedVRF (mkBytes 0) (vrfSignKey $ aikVrf keys)
+        , bheaderL = mkCertifiedVRF (mkBytes 1) (vrfSignKey $ aikVrf keys)
         , bsize = 2345
         , bhash = hashTxSeq @era blockBody
         , bheaderOCert = mkOCert keys 0 (KESPeriod 0)
@@ -230,7 +231,7 @@ exampleTx mkWitnesses txBody auxData =
     keyPairWits =
       [ asWitness examplePayKey
       , asWitness exampleStakeKey
-      , asWitness $ cold (exampleKeys @(EraCrypto era) @'StakePool)
+      , asWitness $ aikCold (exampleKeys @(EraCrypto era) @'StakePool)
       ]
 
 exampleProposedPParamsUpdates ::
@@ -250,7 +251,7 @@ examplePoolDistr =
         ( mkKeyHash 1
         , IndividualPoolStake
             1
-            (hashVerKeyVRF (snd (vrf (exampleKeys @c))))
+            (hashVerKeyVRF (vrfVerKey (aikVrf (exampleKeys @c))))
         )
       ]
 
@@ -504,7 +505,7 @@ exampleKeys =
   AllIssuerKeys
     coldKey
     (mkVRFKeyPair (Proxy @c) 1)
-    [(KESPeriod 0, mkKESKeyPair (RawSeed 1 0 0 0 3))]
+    ((KESPeriod 0, mkKESKeyPair (RawSeed 1 0 0 0 3)) NE.:| [])
     (hashKey (vKey coldKey))
   where
     coldKey = mkDSIGNKeyPair 1
@@ -532,11 +533,11 @@ mkDSIGNKeyPair byte = KeyPair (VKey $ DSIGN.deriveVerKeyDSIGN sk) sk
 
 mkVRFKeyPair ::
   forall c.
-  VRFAlgorithm (VRF c) =>
+  Crypto c =>
   Proxy c ->
   Word8 ->
-  (Cardano.Ledger.Keys.SignKeyVRF c, Cardano.Ledger.Keys.VerKeyVRF c)
-mkVRFKeyPair _ byte = (sk, VRF.deriveVerKeyVRF sk)
+  VRFKeyPair c
+mkVRFKeyPair _ byte = VRFKeyPair sk (VRF.deriveVerKeyVRF sk)
   where
     seed =
       Seed.mkSeedFromBytes $
@@ -549,8 +550,8 @@ mkVRFKeyPair _ byte = (sk, VRF.deriveVerKeyVRF sk)
 examplePoolParams :: forall c. Crypto c => PoolParams c
 examplePoolParams =
   PoolParams
-    { ppId = hashKey $ vKey $ cold poolKeys
-    , ppVrf = hashVerKeyVRF $ snd $ vrf poolKeys
+    { ppId = hashKey $ vKey $ aikCold poolKeys
+    , ppVrf = hashVerKeyVRF $ vrfVerKey $ aikVrf poolKeys
     , ppPledge = Coin 1
     , ppCost = Coin 5
     , ppMargin = unsafeBoundRational 0.1
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Federation.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Federation.hs
index d0015064415..45f2a00c645 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Federation.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Federation.hs
@@ -21,9 +21,8 @@ module Test.Cardano.Ledger.Shelley.Examples.Federation (
 where
 
 import Cardano.Ledger.BaseTypes (Globals (..))
-import Cardano.Ledger.Core (EraPParams (..), PParams (..))
-import qualified Cardano.Ledger.Crypto as CC (Crypto)
-import Cardano.Ledger.Era (EraCrypto)
+import Cardano.Ledger.Core (EraCrypto, EraPParams (..), PParams (..))
+import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Keys (
   GenDelegPair (..),
   KeyHash (..),
@@ -41,6 +40,7 @@ import Cardano.Protocol.TPraos.Rules.Overlay (
   lookupInOverlaySchedule,
  )
 import qualified Data.List
+import qualified Data.List.NonEmpty as NE
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Word (Word64)
@@ -49,6 +49,7 @@ import Lens.Micro ((^.))
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), vKey)
 import Test.Cardano.Ledger.Shelley.Generator.Core (
   AllIssuerKeys (..),
+  VRFKeyPair (..),
  )
 import Test.Cardano.Ledger.Shelley.Utils
 
@@ -57,21 +58,21 @@ numCoreNodes :: Word64
 numCoreNodes = 7
 
 mkAllCoreNodeKeys ::
-  (CC.Crypto c) =>
+  Crypto c =>
   Word64 ->
   AllIssuerKeys c r
 mkAllCoreNodeKeys w =
   AllIssuerKeys
     (KeyPair vkCold skCold)
     (mkVRFKeyPair (RawSeed w 0 0 0 2))
-    [(KESPeriod 0, mkKESKeyPair (RawSeed w 0 0 0 3))]
+    ((KESPeriod 0, mkKESKeyPair (RawSeed w 0 0 0 3)) NE.:| [])
     (hashKey vkCold)
   where
     (skCold, vkCold) = mkKeyPair (RawSeed w 0 0 0 1)
 
 coreNodes ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   [ ( (SignKeyDSIGN c, VKey 'Genesis c)
     , AllIssuerKeys c 'GenesisDelegate
     )
@@ -84,13 +85,13 @@ coreNodes =
 -- === Signing (Secret) Keys
 -- Retrieve the signing key for a core node by providing
 -- a number in the range @[0, ... ('numCoreNodes'-1)]@.
-coreNodeSK :: forall c. CC.Crypto c => Int -> SignKeyDSIGN c
+coreNodeSK :: forall c. Crypto c => Int -> SignKeyDSIGN c
 coreNodeSK = fst . fst . (coreNodes @c !!)
 
 -- | === Verification (Public) Keys
 -- Retrieve the verification key for a core node by providing
 -- a number in the range @[0, ... ('numCoreNodes'-1)]@.
-coreNodeVK :: forall c. CC.Crypto c => Int -> VKey 'Genesis c
+coreNodeVK :: forall c. Crypto c => Int -> VKey 'Genesis c
 coreNodeVK = snd . fst . (coreNodes @c !!)
 
 -- | === Block Issuer Keys
@@ -99,7 +100,7 @@ coreNodeVK = snd . fst . (coreNodes @c !!)
 -- a number in the range @[0, ... ('numCoreNodes'-1)]@.
 coreNodeIssuerKeys ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   Int ->
   AllIssuerKeys c 'GenesisDelegate
 coreNodeIssuerKeys = snd . (coreNodes @c !!)
@@ -140,14 +141,14 @@ coreNodeKeysBySchedule pp slot =
 -- to their delegate's (verification) key hash.
 genDelegs ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   Map (KeyHash 'Genesis c) (GenDelegPair c)
 genDelegs =
   Map.fromList
     [ ( hashKey $ snd gkey
       , ( GenDelegPair
-            (coerceKeyRole . hashKey . vKey $ cold pkeys)
-            (hashVerKeyVRF . snd . vrf $ pkeys)
+            (coerceKeyRole . hashKey . vKey $ aikCold pkeys)
+            (hashVerKeyVRF . vrfVerKey $ aikVrf pkeys)
         )
       )
     | (gkey, pkeys) <- coreNodes
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs
index 37a0aba2694..39c2b3efb19 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs
@@ -39,6 +39,7 @@ import qualified Control.State.Transition.Trace.Generator.QuickCheck as QC
 import Data.Coerce (coerce)
 import Data.Foldable (toList)
 import qualified Data.List as List (find)
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import Data.Maybe (catMaybes, fromMaybe)
 import Data.Sequence (Seq)
@@ -66,6 +67,7 @@ import Test.Cardano.Ledger.Shelley.Utils (
   slotFromEpoch,
   testGlobals,
  )
+import Test.Cardano.Protocol.TPraos.Create (VRFKeyPair (..))
 import Test.QuickCheck (Gen)
 import qualified Test.QuickCheck as QC (choose)
 
@@ -130,23 +132,31 @@ genBlockWithTxGen
         kp@(KESPeriod kesPeriod_) = runShelleyBase $ kesPeriod nextSlot
         cs = chainOCertIssue chainSt
         m = getKESPeriodRenewalNo issuerKeys kp
-        hotKeys = drop (fromIntegral m) (hot issuerKeys)
-        keys = issuerKeys {hot = hotKeys}
+        hotKeys =
+          fromMaybe
+            ( error $
+                "No more hot keys left. Tried dropping "
+                  ++ show m
+                  ++ " from: "
+                  ++ show (aikHot issuerKeys)
+            )
+            (NE.nonEmpty $ NE.drop (fromIntegral m) (aikHot issuerKeys))
+        keys = issuerKeys {aikHot = hotKeys}
 
         -- And issue a new ocert
         n' =
           currentIssueNo
             ( OCertEnv
-                (Set.fromList $ hk <$> ksStakePools)
+                (Set.fromList $ aikColdKeyHash <$> ksStakePools)
                 (eval (dom ksIndexedGenDelegates))
             )
             cs
-            ((coerceKeyRole . hashKey . vKey . cold) issuerKeys)
+            (coerceKeyRole . hashKey . vKey $ aikCold issuerKeys)
         issueNumber =
           if n' == Nothing
             then error "no issue number available"
             else fromIntegral m
-        oCert = mkOCert keys issueNumber ((fst . head) hotKeys)
+        oCert = mkOCert keys issueNumber (fst $ NE.head hotKeys)
 
     mkBlock
       <$> pure hashheader
@@ -216,12 +226,12 @@ selectNextSlotWithLeader
             Nothing ->
               coerce
                 <$> List.find
-                  ( \(AllIssuerKeys {vrf, hk}) ->
-                      isLeader hk (fst vrf)
+                  ( \(AllIssuerKeys {aikVrf, aikColdKeyHash}) ->
+                      isLeader aikColdKeyHash (vrfSignKey aikVrf)
                   )
                   ksStakePools
             Just (ActiveSlot x) ->
-              fmap coerce $
+              coerce $
                 Map.lookup x cores
                   >>= \y -> Map.lookup (genDelegKeyHash y) ksIndexedGenDelegates
             _ -> Nothing
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs
index fa8bbc5f40e..543a296e378 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Core.hs
@@ -13,6 +13,8 @@
 
 module Test.Cardano.Ledger.Shelley.Generator.Core (
   AllIssuerKeys (..),
+  VRFKeyPair (..),
+  KESKeyPair (..),
   GenEnv (..),
   ScriptSpace (..),
   TwoPhase3ArgInfo (..),
@@ -56,9 +58,7 @@ module Test.Cardano.Ledger.Shelley.Generator.Core (
 )
 where
 
-import Cardano.Crypto.DSIGN.Class (DSIGNAlgorithm (..))
 import qualified Cardano.Crypto.Hash as Hash
-import Cardano.Crypto.VRF (evalCertified)
 import Cardano.Ledger.Address (Addr (..))
 import Cardano.Ledger.BaseTypes (
   BoundedRational (..),
@@ -69,7 +69,6 @@ import Cardano.Ledger.BaseTypes (
   epochInfoPure,
   stabilityWindow,
  )
-import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core hiding (DataHash)
 import Cardano.Ledger.Credential (
@@ -79,25 +78,16 @@ import Cardano.Ledger.Credential (
   pattern StakeRefBase,
   pattern StakeRefPtr,
  )
-import Cardano.Ledger.Crypto (DSIGN)
-import qualified Cardano.Ledger.Crypto as CC (Crypto)
+import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Keys (
-  HasKeyRole (coerceKeyRole),
   Hash,
   KeyHash,
   KeyRole (..),
-  SignKeyKES,
-  SignKeyVRF,
   VKey,
-  VerKeyKES,
-  VerKeyVRF,
   asWitness,
   hashKey,
-  signedDSIGN,
-  signedKES,
  )
 import Cardano.Ledger.SafeHash (SafeHash, unsafeMakeSafeHash)
-import Cardano.Ledger.Shelley.BlockChain (bBodySize)
 import Cardano.Ledger.Shelley.LedgerState (AccountState (..))
 import Cardano.Ledger.Shelley.Tx (
   pattern TxIn,
@@ -114,38 +104,22 @@ import Cardano.Ledger.Slot (
   (*-),
  )
 import Cardano.Ledger.UTxO (UTxO (UTxO))
-import Cardano.Protocol.TPraos.BHeader (
-  BHeader,
-  HashHeader,
-  mkSeed,
-  seedEta,
-  seedL,
-  pattern BHBody,
-  pattern BHeader,
-  pattern BlockHash,
- )
-import Cardano.Protocol.TPraos.OCert (
-  KESPeriod (..),
-  OCert,
-  OCertSignable (..),
-  pattern OCert,
- )
+import Cardano.Protocol.TPraos.BHeader (BHeader, HashHeader)
+import Cardano.Protocol.TPraos.OCert (KESPeriod (..), OCert)
 import Codec.Serialise (serialise)
 import Control.Monad (replicateM)
 import Control.Monad.Trans.Reader (asks)
 import Data.ByteString.Lazy (toStrict)
-import Data.Coerce (coerce)
+import qualified Data.List.NonEmpty as NE
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
 import Data.Ratio (denominator, numerator, (%))
-import qualified Data.Sequence.Strict as StrictSeq
 import Data.Word (Word64)
 import Numeric.Natural (Natural)
 import qualified PlutusLedgerApi.V1 as PV1
-import Test.Cardano.Crypto.VRF.Fake (WithResult (..))
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), KeyPairs, mkAddr, mkCred, vKey)
-import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (ExMock, Mock)
+import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (Mock)
 import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
 import Test.Cardano.Ledger.Shelley.Generator.ScriptClass (
   ScriptClass,
@@ -158,14 +132,23 @@ import Test.Cardano.Ledger.Shelley.Utils (
   GenesisKeyPair,
   RawSeed (..),
   epochFromSlotNo,
-  evolveKESUntil,
   maxKESIterations,
   maxLLSupply,
-  mkCertifiedVRF,
   mkGenKey,
   mkKeyPair,
   runShelleyBase,
  )
+import Test.Cardano.Protocol.Crypto.VRF.Fake (NatNonce (..))
+import Test.Cardano.Protocol.TPraos.Create (
+  AllIssuerKeys (..),
+  KESKeyPair (..),
+  VRFKeyPair (..),
+  mkBHBody,
+  mkBHeader,
+  mkBlock,
+  mkBlockFakeVRF,
+  mkOCert,
+ )
 import Test.QuickCheck (Gen)
 import qualified Test.QuickCheck as QC
 
@@ -176,14 +159,6 @@ type PreAlonzo era =
 
 -- =========================================
 
-data AllIssuerKeys v (r :: KeyRole) = AllIssuerKeys
-  { cold :: KeyPair r v
-  , vrf :: (SignKeyVRF v, VerKeyVRF v)
-  , hot :: [(KESPeriod, (SignKeyKES v, VerKeyKES v))]
-  , hk :: KeyHash r v
-  }
-  deriving (Show)
-
 type DataHash c = SafeHash c EraIndependentData
 
 type ScriptInfo era =
@@ -332,19 +307,19 @@ genWord64 lower upper =
 -- Note: we index all possible genesis delegate keys, that is,
 -- core nodes and all potential keys.
 mkGenesisDelegatesHashMap ::
-  (CC.Crypto c) =>
+  Crypto c =>
   [(GenesisKeyPair c, AllIssuerKeys c 'GenesisDelegate)] ->
   [AllIssuerKeys c 'GenesisDelegate] ->
   Map (KeyHash 'GenesisDelegate c) (AllIssuerKeys c 'GenesisDelegate)
 mkGenesisDelegatesHashMap coreNodes genesisDelegates =
   Map.fromList (f <$> allDelegateKeys)
   where
-    f issuerKeys = ((hashKey . vKey . cold) issuerKeys, issuerKeys)
+    f issuerKeys = (hashKey . vKey $ aikCold issuerKeys, issuerKeys)
     allDelegateKeys = (snd <$> coreNodes) <> genesisDelegates
 
 -- | Generate a mapping from stake key hash to stake key pair, from a list of
 -- (payment, staking) key pairs.
-mkStakeKeyHashMap :: (CC.Crypto c) => KeyPairs c -> Map (KeyHash 'Staking c) (KeyPair 'Staking c)
+mkStakeKeyHashMap :: (Crypto c) => KeyPairs c -> Map (KeyHash 'Staking c) (KeyPair 'Staking c)
 mkStakeKeyHashMap keyPairs =
   Map.fromList (f <$> keyPairs)
   where
@@ -353,7 +328,7 @@ mkStakeKeyHashMap keyPairs =
 -- | Generate a mapping from payment key hash to keypair
 -- from a list of (payment, staking) key pairs.
 mkPayKeyHashMap ::
-  (CC.Crypto c) =>
+  Crypto c =>
   KeyPairs c ->
   Map (KeyHash 'Payment c) (KeyPair 'Payment c)
 mkPayKeyHashMap keyPairs =
@@ -477,6 +452,10 @@ unitIntervalToNatural ui =
   toNat ((toInteger (maxBound :: Word64) % 1) * unboundRational ui)
   where
     toNat r = fromInteger (numerator r `quot` denominator r)
+{-# DEPRECATED
+  unitIntervalToNatural
+  "This function has been made private in cardano-protocol-tpraos:testlib. Open an issue if you need it"
+  #-}
 
 mkBlockHeader ::
   Mock c =>
@@ -502,153 +481,17 @@ mkBlockHeader ::
   -- | Block body hash
   Hash c EraIndependentBlockBody ->
   BHeader c
-mkBlockHeader protVer prev pkeys s blockNo enonce kesPeriod c0 oCert bodySize bodyHash =
-  let (_, (sHot, _)) = head $ hot pkeys
-      KeyPair vKeyCold _ = cold pkeys
-      nonceNonce = mkSeed seedEta s enonce
-      leaderNonce = mkSeed seedL s enonce
-      bhb =
-        BHBody
-          blockNo
-          s
-          (BlockHash prev)
-          (coerceKeyRole vKeyCold)
-          (snd $ vrf pkeys)
-          (coerce $ evalCertified () nonceNonce (fst $ vrf pkeys))
-          (coerce $ evalCertified () leaderNonce (fst $ vrf pkeys))
-          bodySize
-          bodyHash
-          oCert
-          protVer
-      kpDiff = kesPeriod - c0
-      hotKey = case evolveKESUntil sHot (KESPeriod 0) (KESPeriod kpDiff) of
-        Nothing ->
-          error ("could not evolve key to iteration " ++ show (c0, kesPeriod, kpDiff))
-        Just hkey -> hkey
-      sig = signedKES () kpDiff bhb hotKey
-   in BHeader bhb sig
-
-mkBlock ::
-  forall era r.
-  (EraSegWits era, Mock (EraCrypto era)) =>
-  -- | Hash of previous block
-  HashHeader (EraCrypto era) ->
-  -- | All keys in the stake pool
-  AllIssuerKeys (EraCrypto era) r ->
-  -- | Transactions to record
-  [Tx era] ->
-  -- | Current slot
-  SlotNo ->
-  -- | Block number/chain length/chain "difficulty"
-  BlockNo ->
-  -- | EpochNo nonce
-  Nonce ->
-  -- | Period of KES (key evolving signature scheme)
-  Word ->
-  -- | KES period of key registration
-  Word ->
-  -- | Operational certificate
-  OCert (EraCrypto era) ->
-  Block (BHeader (EraCrypto era)) era
-mkBlock prev pkeys txns s blockNo enonce kesPeriod c0 oCert =
-  let protVer = ProtVer (eraProtVerHigh @era) 0
-      txseq = (toTxSeq @era . StrictSeq.fromList) txns
-      bodySize = fromIntegral $ bBodySize protVer txseq
-      bodyHash = hashTxSeq @era txseq
-      bh = mkBlockHeader protVer prev pkeys s blockNo enonce kesPeriod c0 oCert bodySize bodyHash
-   in Block bh txseq
-
--- | Create a block with a faked VRF result.
-mkBlockFakeVRF ::
-  forall era r.
-  (EraSegWits era, ExMock (EraCrypto era)) =>
-  -- | Hash of previous block
-  HashHeader (EraCrypto era) ->
-  -- | All keys in the stake pool
-  AllIssuerKeys (EraCrypto era) r ->
-  -- | Transactions to record
-  [Tx era] ->
-  -- | Current slot
-  SlotNo ->
-  -- | Block number/chain length/chain "difficulty"
-  BlockNo ->
-  -- | EpochNo nonce
-  Nonce ->
-  -- | Block nonce
-  NatNonce ->
-  -- | Praos leader value
-  UnitInterval ->
-  -- | Period of KES (key evolving signature scheme)
-  Word ->
-  -- | KES period of key registration
-  Word ->
-  -- | Operational certificate
-  OCert (EraCrypto era) ->
-  Block (BHeader (EraCrypto era)) era
-mkBlockFakeVRF prev pkeys txns s blockNo enonce (NatNonce bnonce) l kesPeriod c0 oCert =
-  let (_, (sHot, _)) = head $ hot pkeys
-      KeyPair vKeyCold _ = cold pkeys
-      nonceNonce = mkSeed seedEta s enonce
-      leaderNonce = mkSeed seedL s enonce
-      txseq = toTxSeq @era (StrictSeq.fromList txns)
-      protVer = ProtVer (eraProtVerHigh @era) 0
-      bhb =
-        BHBody
-          blockNo
-          s
-          (BlockHash prev)
-          (coerceKeyRole vKeyCold)
-          (snd $ vrf pkeys)
-          ( mkCertifiedVRF
-              (WithResult nonceNonce (fromIntegral bnonce))
-              (fst $ vrf pkeys)
-          )
-          ( mkCertifiedVRF
-              (WithResult leaderNonce (fromIntegral $ unitIntervalToNatural l))
-              (fst $ vrf pkeys)
-          )
-          (fromIntegral $ bBodySize protVer txseq)
-          (hashTxSeq @era txseq)
-          oCert
-          protVer
-      kpDiff = kesPeriod - c0
-      hotKey = case evolveKESUntil sHot (KESPeriod 0) (KESPeriod kpDiff) of
-        Nothing ->
-          error ("could not evolve key to iteration " ++ show (c0, kesPeriod, kpDiff))
-        Just hkey -> hkey
-      sig = signedKES () kpDiff bhb hotKey
-      bh = BHeader bhb sig
-   in Block bh txseq
-
--- | We provide our own nonces to 'mkBlock', which we then wish to recover as
--- the output of the VRF functions. In general, however, we just derive them
--- from a natural. Since the nonce is a hash, we do not want to recover it to
--- find a preimage. In testing, therefore, we just wrap the raw natural, which
--- we then encode into the fake VRF implementation.
-newtype NatNonce = NatNonce Natural
-
-mkOCert ::
-  forall c r.
-  (CC.Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
-  AllIssuerKeys c r ->
-  Word64 ->
-  KESPeriod ->
-  OCert c
-mkOCert pkeys n c0 =
-  let (_, (_, vKeyHot)) = head $ hot pkeys
-      KeyPair _vKeyCold sKeyCold = cold pkeys
-   in OCert
-        vKeyHot
-        n
-        c0
-        (signedDSIGN @c sKeyCold (OCertSignable vKeyHot n c0))
-
--- | Takes a set of KES hot keys and checks to see whether there is one whose
+mkBlockHeader protVer prev pKeys slotNo blockNo enonce kesPeriod c0 oCert bodySize bodyHash =
+  let bhBody = mkBHBody protVer prev pKeys slotNo blockNo enonce oCert bodySize bodyHash
+   in mkBHeader pKeys kesPeriod c0 bhBody
+{-# DEPRECATED mkBlockHeader "In favor of `mkBHeader` and `mkBHBody`" #-}
+
+-- | Takes a sequence of KES hot keys and checks to see whether there is one whose
 -- range contains the current KES period. If so, return its index in the list of
 -- hot keys.
 getKESPeriodRenewalNo :: AllIssuerKeys h r -> KESPeriod -> Integer
 getKESPeriodRenewalNo keys (KESPeriod kp) =
-  go (hot keys) 0 kp
+  go (NE.toList (aikHot keys)) 0 kp
   where
     go [] _ _ = error "did not find enough KES renewals"
     go ((KESPeriod p, _) : rest) n k =
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Delegation.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Delegation.hs
index c63da0fa681..47544f96a62 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Delegation.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Delegation.hs
@@ -79,6 +79,7 @@ import Test.Cardano.Ledger.Shelley.Generator.Core (
  )
 import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen)
 import Test.Cardano.Ledger.Shelley.Utils
+import Test.Cardano.Protocol.TPraos.Create (VRFKeyPair (..))
 import Test.QuickCheck (Gen)
 import qualified Test.QuickCheck as QC
 
@@ -321,7 +322,7 @@ genDelegation
       availablePools = Set.toList $ domain registeredPools
 
 genGenesisDelegation ::
-  (Era era) =>
+  Era era =>
   -- | Core nodes
   [(GenesisKeyPair (EraCrypto era), AllIssuerKeys (EraCrypto era) 'GenesisDelegate)] ->
   -- | All potential genesis delegate keys
@@ -333,10 +334,10 @@ genGenesisDelegation coreNodes delegateKeys dpState =
     then pure Nothing
     else do
       gk <- QC.elements genesisDelegators
-      AllIssuerKeys {cold, vrf} <- QC.elements availableDelegatees
+      AllIssuerKeys {aikCold, aikVrf} <- QC.elements availableDelegatees
       case Map.lookup (hashVKey gk) genDelegs_ of
         Nothing -> pure Nothing
-        Just _ -> return $ mkCert gk cold (snd vrf)
+        Just _ -> return $ mkCert gk aikCold (vrfVerKey aikVrf)
   where
     allDelegateKeys = (snd <$> coreNodes) <> delegateKeys
     hashVKey = hashKey . vKey
@@ -350,14 +351,16 @@ genGenesisDelegation coreNodes delegateKeys dpState =
             )
         , CoreKeyCred [gkey]
         )
-    (GenDelegs genDelegs_) = dsGenDelegs $ dpsDState dpState
+    GenDelegs genDelegs_ = dsGenDelegs $ dpsDState dpState
     genesisDelegator k = eval (k ∈ dom genDelegs_)
     genesisDelegators = filter (genesisDelegator . hashVKey) (fst <$> coreNodes)
-    notActiveDelegatee k = not (coerceKeyRole k `List.elem` fmap genDelegKeyHash (Map.elems genDelegs_))
+    notActiveDelegatee k =
+      not (coerceKeyRole k `List.elem` fmap genDelegKeyHash (Map.elems genDelegs_))
     fGenDelegs = dsFutureGenDelegs $ dpsDState dpState
-    notFutureDelegatee k = not (coerceKeyRole k `List.elem` fmap genDelegKeyHash (Map.elems fGenDelegs))
+    notFutureDelegatee k =
+      not (coerceKeyRole k `List.elem` fmap genDelegKeyHash (Map.elems fGenDelegs))
     notDelegatee k = notActiveDelegatee k && notFutureDelegatee k
-    availableDelegatees = filter (notDelegatee . hashVKey . cold) allDelegateKeys
+    availableDelegatees = filter (notDelegatee . hashVKey . aikCold) allDelegateKeys
 
 -- | Generate PoolParams and the key witness.
 genStakePool ::
@@ -389,8 +392,8 @@ genStakePool poolKeys skeys (Coin minPoolCost) =
       let interval = unsafeBoundRational $ fromIntegral marginPercent % 100
           pps =
             PoolParams
-              (hashKey . vKey . cold $ allPoolKeys)
-              (hashVerKeyVRF . snd . vrf $ allPoolKeys)
+              (hashKey . vKey $ aikCold allPoolKeys)
+              (hashVerKeyVRF . vrfVerKey $ aikVrf allPoolKeys)
               pledge
               cost
               interval
@@ -398,7 +401,7 @@ genStakePool poolKeys skeys (Coin minPoolCost) =
               Set.empty
               StrictSeq.empty
               SNothing
-       in (pps, cold allPoolKeys)
+       in (pps, aikCold allPoolKeys)
 
 -- | Generate `RegPool` and the key witness.
 genRegPool ::
@@ -426,13 +429,13 @@ genRetirePool ::
   SlotNo ->
   Gen (Maybe (DCert (EraCrypto era), CertCred era))
 genRetirePool _pp poolKeys pState slot =
-  if (null retireable)
+  if null retireable
     then pure Nothing
     else
       ( \keyHash epoch ->
           Just
             ( DCertPool (RetirePool keyHash epoch)
-            , PoolCred (cold $ lookupHash keyHash)
+            , PoolCred (aikCold $ lookupHash keyHash)
             )
       )
         <$> QC.elements retireable
@@ -445,7 +448,7 @@ genRetirePool _pp poolKeys pState slot =
     lookupHash hk' =
       fromMaybe
         (error "genRetirePool: could not find keyHash")
-        (List.find (\x -> hk x == hk') poolKeys)
+        (List.find (\x -> aikColdKeyHash x == hk') poolKeys)
     EpochNo cepoch = epochFromSlotNo slot
     epochLow = cepoch + 1
     -- if epochHigh is more than a few epochs above epochLow, then
@@ -501,7 +504,7 @@ genInstantaneousRewardsAccounts s genesisDelegatesByHash pparams accountState de
       else
         Just
           ( DCertMir (MIRCert pot (StakeAddressesMIR credCoinMap))
-          , DelegateCred (cold <$> coreSigners)
+          , DelegateCred (aikCold <$> coreSigners)
           )
 
 -- | Generate an InstantaneousRewards Transfer
@@ -539,7 +542,7 @@ genInstantaneousRewardsTransfer s genesisDelegatesByHash pparams accountState de
       else
         Just
           ( DCertMir (MIRCert pot (SendToOppositePotMIR $ Coin amount))
-          , DelegateCred (cold <$> coreSigners)
+          , DelegateCred (aikCold <$> coreSigners)
           )
 
 genInstantaneousRewards ::
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs
index 215df076fbf..658f2fd511c 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Presets.hs
@@ -21,7 +21,7 @@ module Test.Cardano.Ledger.Shelley.Generator.Presets (
 where
 
 import Cardano.Ledger.Core (EraScript (hashScript))
-import qualified Cardano.Ledger.Crypto as CC (Crypto)
+import Cardano.Ledger.Crypto (Crypto)
 import Cardano.Ledger.Keys (
   GenDelegPair (..),
   KeyHash,
@@ -31,6 +31,7 @@ import Cardano.Ledger.Keys (
   hashVerKeyVRF,
  )
 import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
+import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Proxy (Proxy (..))
@@ -96,7 +97,7 @@ keySpace c =
 -- NOTE: we use a seed range in the [1000...] range
 -- to create keys that don't overlap with any of the other generated keys
 coreNodeKeys ::
-  CC.Crypto c =>
+  Crypto c =>
   Constants ->
   [(KeyPair 'Genesis c, AllIssuerKeys c 'GenesisDelegate)]
 coreNodeKeys c@Constants {numCoreNodes} =
@@ -109,14 +110,14 @@ coreNodeKeys c@Constants {numCoreNodes} =
     toKeyPair (sk, vk) = KeyPair vk sk
 
 -- Pre-generate a set of keys to use for genesis delegates.
-genesisDelegates :: CC.Crypto c => Constants -> [AllIssuerKeys c 'GenesisDelegate]
+genesisDelegates :: Crypto c => Constants -> [AllIssuerKeys c 'GenesisDelegate]
 genesisDelegates c =
   [ issuerKeys c 20 x
   | x <- [0 .. 50]
   ]
 
 -- Pre-generate a set of keys to use for stake pools.
-stakePoolKeys :: CC.Crypto c => Constants -> [AllIssuerKeys c 'StakePool]
+stakePoolKeys :: Crypto c => Constants -> [AllIssuerKeys c 'StakePool]
 stakePoolKeys c =
   [ issuerKeys c 10 x
   | x <- [0 .. 50]
@@ -124,7 +125,7 @@ stakePoolKeys c =
 
 -- | Generate all keys for any entity which will be issuing blocks.
 issuerKeys ::
-  (CC.Crypto c) =>
+  (Crypto c) =>
   Constants ->
   -- | Namespace parameter. Can be used to differentiate between different
   --   "types" of issuer.
@@ -133,37 +134,38 @@ issuerKeys ::
   AllIssuerKeys c r
 issuerKeys Constants {maxSlotTrace} ns x =
   let (skCold, vkCold) = mkKeyPair (RawSeed x 0 0 0 (ns + 1))
+      iters =
+        0
+          :| [ 1
+             .. 1
+              + ( maxSlotTrace
+                    `div` fromIntegral (maxKESIterations * slotsPerKESIteration)
+                )
+             ]
    in AllIssuerKeys
-        { cold = KeyPair vkCold skCold
-        , hot =
-            [ ( KESPeriod (fromIntegral (iter * fromIntegral maxKESIterations))
-              , mkKESKeyPair (RawSeed x 0 0 (fromIntegral iter) (ns + 3))
+        { aikCold = KeyPair vkCold skCold
+        , aikHot =
+            fmap
+              ( \iter ->
+                  ( KESPeriod (fromIntegral (iter * fromIntegral maxKESIterations))
+                  , mkKESKeyPair (RawSeed x 0 0 (fromIntegral iter) (ns + 3))
+                  )
               )
-            | iter <-
-                [ 0
-                .. ( 1
-                      + div
-                        maxSlotTrace
-                        ( fromIntegral
-                            (maxKESIterations * slotsPerKESIteration)
-                        )
-                   )
-                ]
-            ]
-        , vrf = mkVRFKeyPair (RawSeed x 0 0 0 (ns + 2))
-        , hk = hashKey vkCold
+              iters
+        , aikVrf = mkVRFKeyPair (RawSeed x 0 0 0 (ns + 2))
+        , aikColdKeyHash = hashKey vkCold
         }
 
 genesisDelegs0 ::
-  CC.Crypto c =>
+  Crypto c =>
   Constants ->
   Map (KeyHash 'Genesis c) (GenDelegPair c)
 genesisDelegs0 c =
   Map.fromList
     [ ( hashVKey gkey
       , GenDelegPair
-          (coerceKeyRole $ hashVKey (cold pkeys))
-          (hashVerKeyVRF . snd . vrf $ pkeys)
+          (coerceKeyRole . hashVKey $ aikCold pkeys)
+          (hashVerKeyVRF . vrfVerKey $ aikVrf pkeys)
       )
     | (gkey, pkeys) <- coreNodeKeys c
     ]
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs
index 0dea0f51e86..4f83eb50f75 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Update.hs
@@ -70,7 +70,7 @@ import Test.Cardano.Ledger.Binary.Arbitrary (genVersion)
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair, vKey)
 import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
 import Test.Cardano.Ledger.Shelley.Generator.Core (
-  AllIssuerKeys (cold),
+  AllIssuerKeys (aikCold),
   genInteger,
   genNatural,
   genWord64,
@@ -337,7 +337,7 @@ genUpdate
         then -- discard
           pure (Nothing, [])
         else
-          let wits = asWitness . cold <$> coreSigners
+          let wits = asWitness . aikCold <$> coreSigners
            in QC.frequency
                 [
                   ( frequencyTxUpdates
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs
index ee3dbd435cf..f85de795ae0 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs
@@ -1,71 +1,7 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
+module Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators (
+  genCoherentBlock,
+) where
 
-module Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators (genCoherentBlock) where
-
-import qualified Cardano.Crypto.DSIGN as DSIGN
-import qualified Cardano.Crypto.KES as KES
-import Cardano.Crypto.Util (SignableRepresentation)
-import Cardano.Ledger.BaseTypes (
-  BlockNo (..),
-  SlotNo (..),
- )
-import Cardano.Ledger.Crypto (DSIGN, KES)
-import Cardano.Ledger.Shelley.API hiding (SignedDSIGN)
-import Cardano.Ledger.Shelley.Core
-import Cardano.Protocol.TPraos.API (PraosCrypto)
-import Cardano.Protocol.TPraos.BHeader (BHeader, HashHeader)
-import qualified Cardano.Protocol.TPraos.OCert as TP
 import Test.Cardano.Ledger.Core.Arbitrary ()
 import Test.Cardano.Ledger.Shelley.Arbitrary ()
-import Test.Cardano.Ledger.Shelley.Constants (defaultConstants)
-import Test.Cardano.Ledger.Shelley.Generator.Core (
-  mkBlock,
-  mkOCert,
- )
-import Test.Cardano.Ledger.Shelley.Generator.Presets (coreNodeKeys)
-import Test.Cardano.Protocol.TPraos.Arbitrary ()
-import Test.QuickCheck
-
--- | For some purposes, a totally random block generator may not be suitable.
--- There are tests in the ouroboros-network repository, for instance, that
--- perform some integrity checks on the generated blocks.
---
--- For other purposes, such as the serialization tests in this repository,
--- 'genBlock' is more appropriate.
---
--- This generator uses 'mkBlock' provide more coherent blocks.
-genCoherentBlock ::
-  forall era.
-  ( EraSegWits era
-  , Arbitrary (Tx era)
-  , KES.Signable (KES (EraCrypto era)) ~ SignableRepresentation
-  , DSIGN.Signable (DSIGN (EraCrypto era)) ~ SignableRepresentation
-  , PraosCrypto (EraCrypto era)
-  ) =>
-  Gen (Block (BHeader (EraCrypto era)) era)
-genCoherentBlock = do
-  let ksCoreNodes = coreNodeKeys defaultConstants
-  prevHash <- arbitrary :: Gen (HashHeader (EraCrypto era))
-  allPoolKeys <- elements (map snd ksCoreNodes)
-  txs <- arbitrary
-  curSlotNo <- SlotNo <$> choose (0, 10)
-  curBlockNo <- BlockNo <$> choose (0, 100)
-  epochNonce <- arbitrary :: Gen Nonce
-  let kesPeriod = 1
-      keyRegKesPeriod = 1
-      ocert = mkOCert allPoolKeys 1 (TP.KESPeriod kesPeriod)
-  return $
-    mkBlock
-      prevHash
-      allPoolKeys
-      txs
-      curSlotNo
-      curBlockNo
-      epochNonce
-      kesPeriod
-      keyRegKesPeriod
-      ocert
+import Test.Cardano.Protocol.TPraos.Arbitrary (genCoherentBlock)
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs
index d7040fc9ec2..9717c5b4863 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs
+++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Utils.hs
@@ -49,8 +49,6 @@ import Cardano.Crypto.Hash (
  )
 import Cardano.Crypto.KES (
   KESAlgorithm (..),
-  SignKeyKES,
-  VerKeyKES,
   deriveVerKeyKES,
   genKeyKES,
  )
@@ -59,7 +57,6 @@ import Cardano.Crypto.VRF (
   CertifiedVRF,
   SignKeyVRF,
   VRFAlgorithm (..),
-  VerKeyVRF,
   certifiedOutput,
   deriveVerKeyVRF,
   evalCertified,
@@ -78,14 +75,13 @@ import Cardano.Ledger.BaseTypes (
 import Cardano.Ledger.Binary (EncCBOR (..), hashWithEncoder, shelleyProtVer)
 import Cardano.Ledger.Block (Block, bheader)
 import Cardano.Ledger.Coin (Coin (..))
-import Cardano.Ledger.Crypto (DSIGN)
+import Cardano.Ledger.Crypto (Crypto (DSIGN))
 import Cardano.Ledger.Shelley.API (ApplyBlock, KeyRole (..), VKey (..))
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Slot (EpochNo, EpochSize (..), SlotNo)
 import Cardano.Ledger.TreeDiff (ToExpr)
 import Cardano.Protocol.TPraos.API (GetLedgerView)
 import Cardano.Protocol.TPraos.BHeader (BHBody (..), BHeader, bhbody)
-import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
 import Cardano.Slotting.EpochInfo (
   epochInfoEpoch,
   epochInfoFirst,
@@ -111,6 +107,7 @@ import Test.Cardano.Ledger.Core.KeyPair (KeyPair, pattern KeyPair)
 import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
 import Test.Cardano.Ledger.Shelley.Arbitrary (RawSeed (..))
 import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (Mock)
+import Test.Cardano.Protocol.TPraos.Create (KESKeyPair (..), VRFKeyPair (..), evolveKESUntil)
 import Test.Tasty.HUnit (
   Assertion,
   (@?=),
@@ -193,13 +190,13 @@ mkKeyPair' seed = KeyPair vk sk
     (sk, vk) = mkKeyPair seed
 
 -- | For testing purposes, generate a deterministic VRF key pair given a seed.
-mkVRFKeyPair ::
-  VRFAlgorithm v =>
-  RawSeed ->
-  (SignKeyVRF v, VerKeyVRF v)
+mkVRFKeyPair :: Crypto c => RawSeed -> VRFKeyPair c
 mkVRFKeyPair seed =
   let sk = genKeyVRF $ mkSeedFromWords seed
-   in (sk, deriveVerKeyVRF sk)
+   in VRFKeyPair
+        { vrfSignKey = sk
+        , vrfVerKey = deriveVerKeyVRF sk
+        }
 
 -- | For testing purposes, create a VRF value
 mkCertifiedVRF ::
@@ -215,13 +212,13 @@ mkCertifiedVRF a sk =
   coerce $ evalCertified () a sk
 
 -- | For testing purposes, generate a deterministic KES key pair given a seed.
-mkKESKeyPair ::
-  KESAlgorithm v =>
-  RawSeed ->
-  (SignKeyKES v, VerKeyKES v)
+mkKESKeyPair :: Crypto c => RawSeed -> KESKeyPair c
 mkKESKeyPair seed =
   let sk = genKeyKES $ mkSeedFromWords seed
-   in (sk, deriveVerKeyKES sk)
+   in KESKeyPair
+        { kesSignKey = sk
+        , kesVerKey = deriveVerKeyKES sk
+        }
 
 testGlobals :: Globals
 testGlobals =
@@ -252,24 +249,6 @@ slotFromEpoch = runIdentity . epochInfoFirst (epochInfoPure testGlobals)
 epochSize :: EpochNo -> EpochSize
 epochSize = runIdentity . epochInfoSize (epochInfoPure testGlobals)
 
--- | Try to evolve KES key until specific KES period is reached, given the
--- current KES period.
-evolveKESUntil ::
-  (KESAlgorithm v, ContextKES v ~ ()) =>
-  SignKeyKES v ->
-  -- | Current KES period
-  KESPeriod ->
-  -- | Target KES period
-  KESPeriod ->
-  Maybe (SignKeyKES v)
-evolveKESUntil sk1 (KESPeriod current) (KESPeriod target) = go sk1 current target
-  where
-    go !_ c t | t < c = Nothing
-    go !sk c t | c == t = Just sk
-    go !sk c t = case updateKES () sk c of
-      Nothing -> Nothing
-      Just sk' -> go sk' (c + 1) t
-
 maxKESIterations :: Word64
 maxKESIterations = runShelleyBase (asks maxKESEvo)
 
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs
index e2edacdf3f5..38dca026be6 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -15,16 +16,16 @@ module Test.Cardano.Ledger.Shelley.Examples.GenesisDelegation (
 where
 
 import Cardano.Crypto.DSIGN.Class (Signable)
-import Cardano.Crypto.Hash (HashAlgorithm)
 import qualified Cardano.Crypto.Hash as Hash
-import qualified Cardano.Crypto.VRF as VRF
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
 import Cardano.Ledger.Block (Block, bheader)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Crypto
 import Cardano.Ledger.Keys (
   GenDelegPair (..),
+  Hash,
   KeyRole (..),
+  VerKeyVRF,
   asWitness,
   hashKey,
   hashVerKeyVRF,
@@ -71,6 +72,7 @@ import Test.Cardano.Ledger.Shelley.Examples.Init (
 import Test.Cardano.Ledger.Shelley.Examples.PoolLifetime (makePulser')
 import Test.Cardano.Ledger.Shelley.Generator.Core (
   NatNonce (..),
+  VRFKeyPair (..),
   genesisCoins,
   mkBlockFakeVRF,
   mkOCert,
@@ -119,16 +121,13 @@ newGenDelegate = KeyPair vkCold skCold
   where
     (skCold, vkCold) = mkKeyPair (RawSeed 108 0 0 0 1)
 
-newGenesisVrfKH ::
-  forall h v.
-  (HashAlgorithm h, VRF.VRFAlgorithm v) =>
-  Hash.Hash h (VRF.VerKeyVRF v)
-newGenesisVrfKH = hashVerKeyVRF . snd $ mkVRFKeyPair (RawSeed 9 8 7 6 5)
+newGenesisVrfKH :: forall c. Crypto c => Hash c (VerKeyVRF c)
+newGenesisVrfKH = hashVerKeyVRF (vrfVerKey (mkVRFKeyPair @c (RawSeed 9 8 7 6 5)))
 
 feeTx1 :: Coin
 feeTx1 = Coin 1
 
-txbodyEx1 :: Crypto c => ShelleyTxBody (ShelleyEra c)
+txbodyEx1 :: forall c. Crypto c => ShelleyTxBody (ShelleyEra c)
 txbodyEx1 =
   ShelleyTxBody
     (Set.fromList [TxIn genesisId minBound])
@@ -138,7 +137,7 @@ txbodyEx1 =
             ( ConstitutionalDelegCert
                 (hashKey (coreNodeVK 0))
                 (hashKey (vKey newGenDelegate))
-                newGenesisVrfKH
+                (newGenesisVrfKH @c)
             )
         ]
     )
@@ -198,7 +197,7 @@ newGenDeleg ::
   (FutureGenDeleg c, GenDelegPair c)
 newGenDeleg =
   ( FutureGenDeleg (SlotNo 43) (hashKey $ coreNodeVK 0)
-  , GenDelegPair (hashKey . vKey $ newGenDelegate) newGenesisVrfKH
+  , GenDelegPair (hashKey . vKey $ newGenDelegate) (newGenesisVrfKH @c)
   )
 
 expectedStEx1 ::
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs
index 8c25299039a..ef7a6ae0266 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs
@@ -151,7 +151,7 @@ txbodyEx1 pot =
     aliceCoinEx1 = aliceInitCoin <-> (Val.inject $ feeTx1 <+> Coin 7)
 
 mirWits :: Crypto c => [Int] -> [KeyPair 'Witness c]
-mirWits nodes = asWitness <$> map (\x -> cold . coreNodeIssuerKeys $ x) nodes
+mirWits = map (asWitness . aikCold . coreNodeIssuerKeys)
 
 sufficientMIRWits :: Crypto c => [KeyPair 'Witness c]
 sufficientMIRWits = mirWits [0 .. 4]
@@ -260,7 +260,7 @@ mirFailWits pot =
         ]
     )
   where
-    ws = Set.fromList $ asWitness <$> map (\x -> hk . coreNodeIssuerKeys $ x) [0 .. 3]
+    ws = Set.fromList $ map (asWitness . aikColdKeyHash . coreNodeIssuerKeys) [0 .. 3]
 
 -- === Block 1, Slot 10, Epoch 0, Insufficient MIR funds, Reserves Example
 --
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs
index 8ad0eb0afc9..b5ff9518e4f 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs
@@ -227,13 +227,13 @@ txEx1 =
             (hashAnnotated (txbodyEx1 @c))
             ( (asWitness <$> [Cast.alicePay, Cast.carlPay])
                 <> (asWitness <$> [Cast.aliceStake])
-                <> [asWitness $ cold Cast.alicePoolKeys]
+                <> [asWitness $ aikCold Cast.alicePoolKeys]
                 <> ( asWitness
-                      <$> [ cold (coreNodeIssuerKeys 0)
-                          , cold (coreNodeIssuerKeys 1)
-                          , cold (coreNodeIssuerKeys 2)
-                          , cold (coreNodeIssuerKeys 3)
-                          , cold (coreNodeIssuerKeys 4)
+                      <$> [ aikCold (coreNodeIssuerKeys 0)
+                          , aikCold (coreNodeIssuerKeys 1)
+                          , aikCold (coreNodeIssuerKeys 2)
+                          , aikCold (coreNodeIssuerKeys 3)
+                          , aikCold (coreNodeIssuerKeys 4)
                           ]
                    )
             )
@@ -304,8 +304,8 @@ txbodyEx2 =
           ]
     , stbCerts =
         StrictSeq.fromList
-          [ DCertDeleg (Delegate $ Delegation Cast.aliceSHK (hk Cast.alicePoolKeys))
-          , DCertDeleg (Delegate $ Delegation Cast.bobSHK (hk Cast.alicePoolKeys))
+          [ DCertDeleg (Delegate $ Delegation Cast.aliceSHK (aikColdKeyHash Cast.alicePoolKeys))
+          , DCertDeleg (Delegate $ Delegation Cast.bobSHK (aikColdKeyHash Cast.alicePoolKeys))
           ]
     , stbWithdrawals = Withdrawals Map.empty
     , stbTxFee = feeTx2
@@ -430,10 +430,10 @@ snapEx3 =
           , (Cast.bobSHK, bobInitCoin)
           ]
     , EB.ssDelegations =
-        [ (Cast.aliceSHK, hk Cast.alicePoolKeys)
-        , (Cast.bobSHK, hk Cast.alicePoolKeys)
+        [ (Cast.aliceSHK, aikColdKeyHash Cast.alicePoolKeys)
+        , (Cast.bobSHK, aikColdKeyHash Cast.alicePoolKeys)
         ]
-    , EB.ssPoolParams = [(hk Cast.alicePoolKeys, Cast.alicePoolParams)]
+    , EB.ssPoolParams = [(aikColdKeyHash Cast.alicePoolKeys, Cast.alicePoolParams)]
     }
 
 expectedStEx3 ::
@@ -471,7 +471,7 @@ txbodyEx4 =
     , stbOutputs = StrictSeq.fromList [ShelleyTxOut Cast.aliceAddr (Val.inject aliceCoinEx4Base)]
     , stbCerts =
         StrictSeq.fromList
-          [DCertDeleg (Delegate $ Delegation Cast.carlSHK (hk Cast.alicePoolKeys))]
+          [DCertDeleg (Delegate $ Delegation Cast.carlSHK (aikColdKeyHash Cast.alicePoolKeys))]
     , stbWithdrawals = Withdrawals Map.empty
     , stbTxFee = feeTx4
     , stbTTL = SlotNo 500
@@ -574,18 +574,18 @@ snapEx5 =
           , (Cast.bobSHK, bobInitCoin)
           ]
     , EB.ssDelegations =
-        [ (Cast.aliceSHK, hk Cast.alicePoolKeys)
-        , (Cast.carlSHK, hk Cast.alicePoolKeys)
-        , (Cast.bobSHK, hk Cast.alicePoolKeys)
+        [ (Cast.aliceSHK, aikColdKeyHash Cast.alicePoolKeys)
+        , (Cast.carlSHK, aikColdKeyHash Cast.alicePoolKeys)
+        , (Cast.bobSHK, aikColdKeyHash Cast.alicePoolKeys)
         ]
-    , EB.ssPoolParams = [(hk Cast.alicePoolKeys, Cast.alicePoolParams)]
+    , EB.ssPoolParams = [(aikColdKeyHash Cast.alicePoolKeys, Cast.alicePoolParams)]
     }
 
 pdEx5 :: forall c. Cr.Crypto c => PoolDistr c
 pdEx5 =
   PoolDistr $
     Map.singleton
-      (hk $ Cast.alicePoolKeys @c)
+      (aikColdKeyHash $ Cast.alicePoolKeys @c)
       (IndividualPoolStake 1 (Cast.aliceVRFKeyHash @c))
 
 expectedStEx5 ::
@@ -600,7 +600,7 @@ expectedStEx5 =
     . C.setOCertCounter coreNodeHK 1
     $ expectedStEx4
   where
-    coreNodeHK = coerceKeyRole . hk $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 220
+    coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 220
 
 -- === Block 5, Slot 220, Epoch 2
 --
@@ -645,8 +645,8 @@ expectedStEx6 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (Sh
 expectedStEx6 =
   C.evolveNonceFrozen (getBlockNonce (blockEx6 @c))
     . C.newLab blockEx6
-    . C.setOCertCounter (coerceKeyRole $ hk Cast.alicePoolKeys) 0
-    . C.incrBlockCount (hk Cast.alicePoolKeys)
+    . C.setOCertCounter (coerceKeyRole $ aikColdKeyHash Cast.alicePoolKeys) 0
+    . C.incrBlockCount (aikColdKeyHash Cast.alicePoolKeys)
     . C.pulserUpdate pulserEx6
     $ expectedStEx5
 
@@ -688,7 +688,7 @@ expectedStEx7 =
     . C.setOCertCounter coreNodeHK 1
     $ expectedStEx6
   where
-    coreNodeHK = coerceKeyRole . hk $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 310
+    coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 310
 
 -- === Block 7, Slot 310, Epoch 3
 --
@@ -750,11 +750,12 @@ alicePerfEx8 = likelihood blocks t (epochSize $ EpochNo 3)
 nonMyopicEx8 :: forall c. Cr.Crypto c => NonMyopic c
 nonMyopicEx8 =
   NonMyopic
-    (Map.singleton (hk Cast.alicePoolKeys) alicePerfEx8)
+    (Map.singleton (aikColdKeyHash Cast.alicePoolKeys) alicePerfEx8)
     rewardPot8
 
 pulserEx8 :: forall c. (ExMock c) => PulsingRewUpdate c
-pulserEx8 = makeCompletedPulser (BlocksMade $ Map.singleton (hk Cast.alicePoolKeys) 1) expectedStEx7
+pulserEx8 =
+  makeCompletedPulser (BlocksMade $ Map.singleton (aikColdKeyHash Cast.alicePoolKeys) 1) expectedStEx7
 
 rewardUpdateEx8 :: forall c. Cr.Crypto c => RewardUpdate c
 rewardUpdateEx8 =
@@ -765,11 +766,11 @@ rewardUpdateEx8 =
         Map.fromList
           [
             ( Cast.aliceSHK
-            , Set.singleton $ Reward LeaderReward (hk Cast.alicePoolKeys) aliceRAcnt8
+            , Set.singleton $ Reward LeaderReward (aikColdKeyHash Cast.alicePoolKeys) aliceRAcnt8
             )
           ,
             ( Cast.bobSHK
-            , Set.singleton $ Reward MemberReward (hk Cast.alicePoolKeys) bobRAcnt8
+            , Set.singleton $ Reward MemberReward (aikColdKeyHash Cast.alicePoolKeys) bobRAcnt8
             )
           ]
     , deltaF = DeltaCoin 0
@@ -784,7 +785,7 @@ expectedStEx8 =
     . C.pulserUpdate pulserEx8
     $ expectedStEx7
   where
-    coreNodeHK = coerceKeyRole . hk $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 390
+    coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 390
 
 -- === Block 8, Slot 390, Epoch 3
 --
@@ -835,7 +836,7 @@ expectedStEx9 =
     . C.setOCertCounter coreNodeHK 2
     $ expectedStEx8
   where
-    coreNodeHK = coerceKeyRole . hk $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 410
+    coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 410
 
 -- === Block 9, Slot 410, Epoch 4
 --
@@ -928,7 +929,7 @@ txbodyEx11 =
   ShelleyTxBody
     (Set.fromList [TxIn (txid txbodyEx4) minBound])
     (StrictSeq.singleton $ ShelleyTxOut Cast.alicePtrAddr (Val.inject aliceCoinEx11Ptr))
-    (StrictSeq.fromList [DCertPool (RetirePool (hk Cast.alicePoolKeys) aliceRetireEpoch)])
+    (StrictSeq.fromList [DCertPool (RetirePool (aikColdKeyHash Cast.alicePoolKeys) aliceRetireEpoch)])
     (Withdrawals Map.empty)
     feeTx11
     (SlotNo 500)
@@ -944,7 +945,7 @@ txEx11 =
           mkWitnessesVKey
             (hashAnnotated (txbodyEx11 @c))
             ( [asWitness Cast.alicePay]
-                <> [asWitness $ cold Cast.alicePoolKeys]
+                <> [asWitness $ aikCold Cast.alicePoolKeys]
             )
       }
     SNothing
@@ -982,7 +983,7 @@ alicePerfEx11 = applyDecay decayFactor alicePerfEx8 <> epoch4Likelihood
 nonMyopicEx11 :: forall c. Cr.Crypto c => NonMyopic c
 nonMyopicEx11 =
   NonMyopic
-    (Map.singleton (hk Cast.alicePoolKeys) (alicePerfEx11 @c))
+    (Map.singleton (aikColdKeyHash Cast.alicePoolKeys) (alicePerfEx11 @c))
     (Coin 0)
 
 pulserEx11 :: forall c. (ExMock c) => PulsingRewUpdate c
@@ -1005,7 +1006,7 @@ expectedStEx11 =
     . C.feesAndDeposits ppEx feeTx11 [] []
     . C.newUTxO txbodyEx11
     . C.pulserUpdate pulserEx11
-    . C.stageRetirement (hk Cast.alicePoolKeys) aliceRetireEpoch
+    . C.stageRetirement (aikColdKeyHash Cast.alicePoolKeys) aliceRetireEpoch
     $ expectedStEx10
 
 -- === Block 11, Slot 490, Epoch 4
@@ -1047,8 +1048,8 @@ snapEx12 =
           , (Cast.carlSHK, carlMIR)
           ]
     , EB.ssDelegations =
-        [ (Cast.aliceSHK, hk Cast.alicePoolKeys)
-        , (Cast.carlSHK, hk Cast.alicePoolKeys)
+        [ (Cast.aliceSHK, aikColdKeyHash Cast.alicePoolKeys)
+        , (Cast.carlSHK, aikColdKeyHash Cast.alicePoolKeys)
         ]
     }
 
@@ -1061,7 +1062,7 @@ expectedStEx12 =
     . C.reapPool Cast.alicePoolParams
     $ expectedStEx11
   where
-    coreNodeHK = coerceKeyRole . hk $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 510
+    coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @(ShelleyEra c) ppEx 510
 
 -- === Block 12, Slot 510, Epoch 5
 --
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs
index 47f81500064..3849b1c98d4 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs
@@ -125,7 +125,7 @@ txEx1 =
             (hashAnnotated $ txbodyEx1 @c)
             ( [asWitness $ Cast.alicePay]
                 <> [asWitness $ Cast.aliceStake]
-                <> [asWitness $ cold Cast.alicePoolKeys]
+                <> [asWitness $ aikCold Cast.alicePoolKeys]
             )
       }
     SNothing
@@ -205,7 +205,7 @@ txEx2 =
             (hashAnnotated $ txbodyEx2 @c)
             ( (asWitness <$> [Cast.alicePay])
                 <> (asWitness <$> [Cast.aliceStake])
-                <> [asWitness $ cold Cast.alicePoolKeys]
+                <> [asWitness $ aikCold Cast.alicePoolKeys]
             )
       }
     SNothing
@@ -296,7 +296,7 @@ blockEx3 =
 
 snapEx3 :: Cr.Crypto c => SnapShot c
 snapEx3 =
-  emptySnapShot {ssPoolParams = [(hk Cast.alicePoolKeys, Cast.alicePoolParams)]}
+  emptySnapShot {ssPoolParams = [(aikColdKeyHash Cast.alicePoolKeys, Cast.alicePoolParams)]}
 
 expectedStEx3 :: forall c. (ExMock (EraCrypto (ShelleyEra c))) => ChainState (ShelleyEra c)
 expectedStEx3 =
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs
index 74624fb3a00..8fb16367506 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs
@@ -196,9 +196,9 @@ txbodyEx1 =
         , DCertDeleg (RegKey Cast.carlSHK)
         , DCertPool (RegPool alicePoolParams')
         , DCertPool (RegPool bobPoolParams')
-        , DCertDeleg (Delegate $ Delegation Cast.aliceSHK (hk Cast.alicePoolKeys))
-        , DCertDeleg (Delegate $ Delegation Cast.bobSHK (hk Cast.bobPoolKeys))
-        , DCertDeleg (Delegate $ Delegation Cast.carlSHK (hk Cast.alicePoolKeys))
+        , DCertDeleg (Delegate $ Delegation Cast.aliceSHK (aikColdKeyHash Cast.alicePoolKeys))
+        , DCertDeleg (Delegate $ Delegation Cast.bobSHK (aikColdKeyHash Cast.bobPoolKeys))
+        , DCertDeleg (Delegate $ Delegation Cast.carlSHK (aikColdKeyHash Cast.alicePoolKeys))
         ]
     )
     (Withdrawals Map.empty)
@@ -217,7 +217,7 @@ txEx1 =
             (hashAnnotated $ txbodyEx1)
             ( (asWitness <$> [Cast.alicePay])
                 <> (asWitness <$> [Cast.aliceStake, Cast.bobStake, Cast.carlStake])
-                <> (asWitness <$> [cold Cast.alicePoolKeys, cold Cast.bobPoolKeys])
+                <> (asWitness <$> [aikCold Cast.alicePoolKeys, aikCold Cast.bobPoolKeys])
             )
       }
     SNothing
@@ -328,13 +328,13 @@ snapEx3 =
           , (Cast.carlSHK, carlInitCoin)
           ]
     , EB.ssDelegations =
-        [ (Cast.aliceSHK, hk Cast.alicePoolKeys)
-        , (Cast.bobSHK, hk Cast.bobPoolKeys)
-        , (Cast.carlSHK, hk Cast.alicePoolKeys)
+        [ (Cast.aliceSHK, aikColdKeyHash Cast.alicePoolKeys)
+        , (Cast.bobSHK, aikColdKeyHash Cast.bobPoolKeys)
+        , (Cast.carlSHK, aikColdKeyHash Cast.alicePoolKeys)
         ]
     , EB.ssPoolParams =
-        [ (hk Cast.alicePoolKeys, alicePoolParams')
-        , (hk Cast.bobPoolKeys, bobPoolParams')
+        [ (aikColdKeyHash Cast.alicePoolKeys, alicePoolParams')
+        , (aikColdKeyHash Cast.bobPoolKeys, bobPoolParams')
         ]
     }
 
@@ -435,22 +435,22 @@ pdEx5 =
   PoolDistr $
     Map.fromList
       [
-        ( hk $ Cast.alicePoolKeys @c
+        ( aikColdKeyHash $ Cast.alicePoolKeys @c
         , IndividualPoolStake alicePoolStake (Cast.aliceVRFKeyHash @c)
         )
       ,
-        ( hk $ Cast.bobPoolKeys @c
+        ( aikColdKeyHash $ Cast.bobPoolKeys @c
         , IndividualPoolStake bobPoolStake (Cast.bobVRFKeyHash @c)
         )
       ]
 
 expectedStEx5 :: ChainState C
 expectedStEx5 =
-  C.incrBlockCount (hk Cast.alicePoolKeys)
+  C.incrBlockCount (aikColdKeyHash Cast.alicePoolKeys)
     . C.newSnapshot snapEx3 (Coin 0)
     . C.applyRewardUpdate rewardUpdateEx4
     . C.setPoolDistr pdEx5
-    . C.setOCertCounter (coerceKeyRole $ hk Cast.alicePoolKeys) 0
+    . C.setOCertCounter (coerceKeyRole $ aikColdKeyHash Cast.alicePoolKeys) 0
     . C.newEpoch blockEx5 -- This must be processed before the incrBlockCount
     $ expectedStEx4
 
@@ -484,8 +484,8 @@ expectedStEx6 :: ChainState C
 expectedStEx6 =
   C.evolveNonceFrozen (getBlockNonce (blockEx6))
     . C.newLab blockEx6
-    . C.setOCertCounter (coerceKeyRole $ hk Cast.alicePoolKeys) 0
-    . C.incrBlockCount (hk Cast.alicePoolKeys)
+    . C.setOCertCounter (coerceKeyRole $ aikColdKeyHash Cast.alicePoolKeys) 0
+    . C.incrBlockCount (aikColdKeyHash Cast.alicePoolKeys)
     . C.rewardUpdate emptyRewardUpdate
     $ expectedStEx5
 
@@ -518,8 +518,8 @@ expectedStEx7 :: ChainState C
 expectedStEx7 =
   C.evolveNonceFrozen (getBlockNonce (blockEx7))
     . C.newLab blockEx7
-    . C.setOCertCounter (coerceKeyRole $ hk Cast.bobPoolKeys) 0
-    . C.incrBlockCount (hk Cast.bobPoolKeys)
+    . C.setOCertCounter (coerceKeyRole $ aikColdKeyHash Cast.bobPoolKeys) 0
+    . C.incrBlockCount (aikColdKeyHash Cast.bobPoolKeys)
     $ expectedStEx6
 
 -- === Block 7, Slot 295, Epoch 2
@@ -560,7 +560,7 @@ expectedStEx8 =
     . C.applyRewardUpdate emptyRewardUpdate
     $ expectedStEx7
   where
-    coreNodeHK = coerceKeyRole . hk $ coreNodeKeysBySchedule @C ppEx 310
+    coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @C ppEx 310
 
 -- === Block 8, Slot 310, Epoch 3
 --
@@ -683,8 +683,8 @@ nonMyopicEx9 :: forall c. ExMock c => NonMyopic c
 nonMyopicEx9 =
   NonMyopic
     ( Map.fromList
-        [ (hk Cast.alicePoolKeys, alicePerfEx9)
-        , (hk Cast.bobPoolKeys, bobPerfEx9)
+        [ (aikColdKeyHash Cast.alicePoolKeys, alicePerfEx9)
+        , (aikColdKeyHash Cast.bobPoolKeys, bobPerfEx9)
         ]
     )
     bigR
@@ -710,7 +710,7 @@ pulserEx9 pp =
   makeCompletedPulser
     ( BlocksMade $
         Map.fromList
-          [(hk Cast.alicePoolKeys, 2), (hk Cast.bobPoolKeys, 1)]
+          [(aikColdKeyHash Cast.alicePoolKeys, 2), (aikColdKeyHash Cast.bobPoolKeys, 1)]
     )
     expectedStEx8'
   where
@@ -724,7 +724,7 @@ expectedStEx9 pp =
     . C.pulserUpdate (pulserEx9 pp)
     $ expectedStEx8
   where
-    coreNodeHK = coerceKeyRole . hk $ coreNodeKeysBySchedule @C ppEx 390
+    coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @C ppEx 390
 
 -- === Block 9, Slot 390, Epoch 3
 --
@@ -739,9 +739,9 @@ twoPools9 = CHAINExample expectedStEx8 blockEx9 (Right $ expectedStEx9 ppEx)
 carlsRewards :: forall c. ExMock c => Set (Reward c)
 carlsRewards =
   Set.fromList
-    [ Reward MemberReward (hk Cast.alicePoolKeys) (carlMemberRewardsFromAlice @c)
-    , Reward LeaderReward (hk Cast.alicePoolKeys) (carlLeaderRewardsFromAlice @c)
-    , Reward LeaderReward (hk Cast.bobPoolKeys) (carlLeaderRewardsFromBob @c)
+    [ Reward MemberReward (aikColdKeyHash Cast.alicePoolKeys) (carlMemberRewardsFromAlice @c)
+    , Reward LeaderReward (aikColdKeyHash Cast.alicePoolKeys) (carlLeaderRewardsFromAlice @c)
+    , Reward LeaderReward (aikColdKeyHash Cast.bobPoolKeys) (carlLeaderRewardsFromBob @c)
     ]
 
 rsEx9Agg :: forall c. ExMock c => Map (Credential 'Staking c) (Set (Reward c))
@@ -783,13 +783,11 @@ twoPoolsExample =
     "two pools"
     [ testCase "create non-aggregated pulser" $ testCHAINExample twoPools9
     , testCase "non-aggregated pulser is correct" $
-        ( (Complete (rewardUpdateEx9 ppEx rsEx9Agg))
-            @?= (fst . runShelleyBase . completeStep $ pulserEx9 ppEx)
-        )
+        Complete (rewardUpdateEx9 ppEx rsEx9Agg)
+          @?= (fst . runShelleyBase . completeStep $ pulserEx9 ppEx)
     , testCase "aggregated pulser is correct" $
-        ( (Complete (rewardUpdateEx9 ppProtVer3 rsEx9Agg))
-            @?= (fst . runShelleyBase . completeStep $ pulserEx9 ppProtVer3)
-        )
+        Complete (rewardUpdateEx9 ppProtVer3 rsEx9Agg)
+          @?= (fst . runShelleyBase . completeStep $ pulserEx9 ppProtVer3)
     , testCase "create aggregated pulser" $ testCHAINExample twoPools9Agg
     , testCase "create legacy aggregatedRewards" testAggregateRewardsLegacy
     , testCase "create new aggregatedRewards" testAggregateRewardsNew
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs
index a916fb01d60..c435611b292 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs
@@ -154,9 +154,9 @@ txEx1 =
           mkWitnessesVKey
             (hashAnnotated $ txbodyEx1 @c)
             ( [asWitness Cast.alicePay]
-                <> [ asWitness . cold $ coreNodeIssuerKeys 0
-                   , asWitness . cold $ coreNodeIssuerKeys 3
-                   , asWitness . cold $ coreNodeIssuerKeys 4
+                <> [ asWitness . aikCold $ coreNodeIssuerKeys 0
+                   , asWitness . aikCold $ coreNodeIssuerKeys 3
+                   , asWitness . aikCold $ coreNodeIssuerKeys 4
                    ]
             )
       }
@@ -229,8 +229,8 @@ txEx2 =
           mkWitnessesVKey
             (hashAnnotated $ txbodyEx2 @c)
             ( [asWitness Cast.alicePay]
-                <> [ asWitness . cold $ coreNodeIssuerKeys 1
-                   , asWitness . cold $ coreNodeIssuerKeys 5
+                <> [ asWitness . aikCold $ coreNodeIssuerKeys 1
+                   , asWitness . aikCold $ coreNodeIssuerKeys 5
                    ]
             )
       }
@@ -304,7 +304,7 @@ txEx3 =
       { addrWits =
           mkWitnessesVKey
             (hashAnnotated $ txbodyEx3 @c)
-            [asWitness Cast.alicePay, asWitness . cold $ coreNodeIssuerKeys 1]
+            [asWitness Cast.alicePay, asWitness . aikCold $ coreNodeIssuerKeys 1]
       }
     SNothing
 
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Fees.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Fees.hs
index 599ddfbfd08..cddf1f420bb 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Fees.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Fees.hs
@@ -11,8 +11,6 @@ module Test.Cardano.Ledger.Shelley.Fees (
 )
 where
 
-import Cardano.Crypto.VRF (VRFAlgorithm)
-import qualified Cardano.Crypto.VRF as VRF
 import Cardano.Ledger.BaseTypes (
   Network (..),
   StrictMaybe (..),
@@ -22,7 +20,7 @@ import Cardano.Ledger.BaseTypes (
 import Cardano.Ledger.Binary.Plain as Plain (serialize)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Core
-import qualified Cardano.Ledger.Crypto as Cr
+import Cardano.Ledger.Crypto
 import Cardano.Ledger.Keys (
   KeyHash,
   KeyRole (..),
@@ -73,6 +71,7 @@ import qualified Data.Set as Set
 import GHC.Stack (HasCallStack)
 import Lens.Micro
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkAddr, mkWitnessesVKey, vKey)
+import Test.Cardano.Ledger.Shelley.Generator.Core (VRFKeyPair (..))
 import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
 import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
 import Test.Cardano.Ledger.Shelley.Utils (
@@ -89,35 +88,35 @@ sizeTest b16 tx = do
   Base16.encode (Plain.serialize tx) @?= b16
   (tx ^. sizeTxF) @?= toInteger (BSL.length b16 `div` 2)
 
-alicePay :: forall c. Cr.Crypto c => KeyPair 'Payment c
+alicePay :: forall c. Crypto c => KeyPair 'Payment c
 alicePay = KeyPair @'Payment @c vk sk
   where
     (sk, vk) = mkKeyPair @c (RawSeed 0 0 0 0 0)
 
-aliceStake :: forall c. Cr.Crypto c => KeyPair 'Staking c
+aliceStake :: forall c. Crypto c => KeyPair 'Staking c
 aliceStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair @c (RawSeed 0 0 0 0 1)
 
-aliceSHK :: forall c. Cr.Crypto c => Credential 'Staking c
+aliceSHK :: forall c. Crypto c => Credential 'Staking c
 aliceSHK = (KeyHashObj . hashKey . vKey) aliceStake
 
-alicePool :: forall c. Cr.Crypto c => KeyPair 'StakePool c
+alicePool :: forall c. Crypto c => KeyPair 'StakePool c
 alicePool = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair @c (RawSeed 0 0 0 0 2)
 
-alicePoolKH :: forall c. Cr.Crypto c => KeyHash 'StakePool c
+alicePoolKH :: forall c. Crypto c => KeyHash 'StakePool c
 alicePoolKH = (hashKey . vKey) alicePool
 
-aliceVRF :: forall v. VRFAlgorithm v => (VRF.SignKeyVRF v, VRF.VerKeyVRF v)
+aliceVRF :: forall c. Crypto c => VRFKeyPair c
 aliceVRF = mkVRFKeyPair (RawSeed 0 0 0 0 3)
 
-alicePoolParams :: forall c. Cr.Crypto c => PoolParams c
+alicePoolParams :: forall c. Crypto c => PoolParams c
 alicePoolParams =
   PoolParams
     { ppId = alicePoolKH
-    , ppVrf = hashVerKeyVRF . snd $ aliceVRF @(Cr.VRF c)
+    , ppVrf = hashVerKeyVRF . vrfVerKey $ aliceVRF @c
     , ppPledge = Coin 1
     , ppCost = Coin 5
     , ppMargin = unsafeBoundRational 0.1
@@ -136,26 +135,26 @@ alicePoolParams =
             }
     }
 
-aliceAddr :: forall c. Cr.Crypto c => Addr c
+aliceAddr :: forall c. Crypto c => Addr c
 aliceAddr = mkAddr (alicePay, aliceStake)
 
-bobPay :: forall c. Cr.Crypto c => KeyPair 'Payment c
+bobPay :: forall c. Crypto c => KeyPair 'Payment c
 bobPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair @c (RawSeed 1 0 0 0 0)
 
-bobStake :: forall c. Cr.Crypto c => KeyPair 'Staking c
+bobStake :: forall c. Crypto c => KeyPair 'Staking c
 bobStake = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair @c (RawSeed 1 0 0 0 1)
 
-bobSHK :: forall c. Cr.Crypto c => Credential 'Staking c
+bobSHK :: forall c. Crypto c => Credential 'Staking c
 bobSHK = (KeyHashObj . hashKey . vKey) bobStake
 
-bobAddr :: forall c. Cr.Crypto c => Addr c
+bobAddr :: forall c. Crypto c => Addr c
 bobAddr = mkAddr (bobPay, bobStake)
 
-carlPay :: forall c. Cr.Crypto c => KeyPair 'Payment c
+carlPay :: forall c. Crypto c => KeyPair 'Payment c
 carlPay = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 2 0 0 0 0)
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs
index 4abcfaba03f..ea01f0bcb49 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs
@@ -59,16 +59,13 @@ import Cardano.Ledger.Block (Block (..))
 import Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (..), StakeReference (..))
-import qualified Cardano.Ledger.Crypto as CC
+import Cardano.Ledger.Crypto
 import Cardano.Ledger.Keys (
   Hash,
   KeyHash (..),
   KeyRole (..),
-  SignKeyKES,
-  SignKeyVRF,
   SignedDSIGN,
   VKey (..),
-  VerKeyKES,
   VerKeyVRF,
   asWitness,
   encodeSignedKES,
@@ -172,12 +169,11 @@ import qualified Data.Set as Set
 import Data.String (fromString)
 import Lens.Micro ((&), (.~))
 import Numeric.Natural (Natural)
-import Test.Cardano.Crypto.VRF.Fake (WithResult (..))
 import Test.Cardano.Ledger.Binary.TreeDiff (CBORBytes (CBORBytes), diffExpr)
 import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..), mkWitnessVKey, sKey, vKey)
 import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C, C_Crypto, ExMock, Mock)
 import Test.Cardano.Ledger.Shelley.Examples.Consensus as Ex (ledgerExamplesShelley, sleNewEpochState)
-import Test.Cardano.Ledger.Shelley.Generator.Core (PreAlonzo)
+import Test.Cardano.Ledger.Shelley.Generator.Core (KESKeyPair (..), PreAlonzo, VRFKeyPair (..))
 import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
 import Test.Cardano.Ledger.Shelley.Serialisation.GoldenUtils (
   ToTokens (..),
@@ -186,6 +182,7 @@ import Test.Cardano.Ledger.Shelley.Serialisation.GoldenUtils (
   checkEncodingCBORAnnotated,
  )
 import Test.Cardano.Ledger.Shelley.Utils
+import Test.Cardano.Protocol.Crypto.VRF.Fake (WithResult (..))
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (assertFailure, testCase)
 
@@ -217,19 +214,19 @@ getRawNonce :: Nonce -> ByteString
 getRawNonce (Nonce hsh) = Monomorphic.hashToBytes hsh
 getRawNonce NeutralNonce = error "The neutral nonce has no bytes"
 
-testGKey :: CC.Crypto c => GenesisKeyPair c
+testGKey :: Crypto c => GenesisKeyPair c
 testGKey = KeyPair vk sk
   where
     (sk, vk) = mkGenKey (RawSeed 0 0 0 0 0)
 
-testGKeyHash :: CC.Crypto c => KeyHash 'Genesis c
+testGKeyHash :: Crypto c => KeyHash 'Genesis c
 testGKeyHash = (hashKey . vKey) testGKey
 
-testVRF :: CC.Crypto c => (SignKeyVRF c, VerKeyVRF c)
+testVRF :: Crypto c => VRFKeyPair c
 testVRF = mkVRFKeyPair (RawSeed 0 0 0 0 5)
 
-testVRFKH :: forall c. CC.Crypto c => Hash c (VerKeyVRF c)
-testVRFKH = hashVerKeyVRF $ snd (testVRF @c)
+testVRFKH :: forall c. Crypto c => Hash c (VerKeyVRF c)
+testVRFKH = hashVerKeyVRF $ vrfVerKey (testVRF @c)
 
 testTxb :: EraTxOut era => ShelleyTxBody era
 testTxb =
@@ -249,28 +246,28 @@ testTxbHash ::
   SafeHash (EraCrypto era) EraIndependentTxBody
 testTxbHash = hashAnnotated $ testTxb @era
 
-testKey1 :: CC.Crypto c => KeyPair 'Payment c
+testKey1 :: Crypto c => KeyPair 'Payment c
 testKey1 = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 0 0 0 0 1)
 
-testKey2 :: CC.Crypto c => KeyPair kr c
+testKey2 :: Crypto c => KeyPair kr c
 testKey2 = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 0 0 0 0 2)
 
-testBlockIssuerKey :: CC.Crypto c => KeyPair 'BlockIssuer c
+testBlockIssuerKey :: Crypto c => KeyPair 'BlockIssuer c
 testBlockIssuerKey = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 0 0 0 0 4)
 
-testStakePoolKey :: CC.Crypto c => KeyPair 'StakePool c
+testStakePoolKey :: Crypto c => KeyPair 'StakePool c
 testStakePoolKey = KeyPair vk sk
   where
     (sk, vk) = mkKeyPair (RawSeed 0 0 0 0 5)
 
 testGenesisDelegateKey ::
-  CC.Crypto c =>
+  Crypto c =>
   KeyPair 'GenesisDelegate c
 testGenesisDelegateKey = KeyPair vk sk
   where
@@ -306,43 +303,43 @@ testOpCertSigTokens = e
     s =
       signedDSIGN @c
         (sKey $ testKey1 @c)
-        (OCertSignable @c (snd $ testKESKeys @c) 0 (KESPeriod 0))
+        (OCertSignable @c (kesVerKey $ testKESKeys @c) 0 (KESPeriod 0))
     CBOR.Encoding e = toPlainEncoding shelleyProtVer (encodeSignedDSIGN s)
 
-testKeyHash1 :: CC.Crypto c => KeyHash 'Payment c
+testKeyHash1 :: Crypto c => KeyHash 'Payment c
 testKeyHash1 = (hashKey . vKey) testKey1
 
-testKeyHash2 :: CC.Crypto c => KeyHash 'Staking c
+testKeyHash2 :: Crypto c => KeyHash 'Staking c
 testKeyHash2 = (hashKey . vKey) testKey2
 
-testKESKeys :: CC.Crypto c => (SignKeyKES c, VerKeyKES c)
+testKESKeys :: Crypto c => KESKeyPair c
 testKESKeys = mkKESKeyPair (RawSeed 0 0 0 0 3)
 
-testAddrE :: CC.Crypto c => Addr c
+testAddrE :: Crypto c => Addr c
 testAddrE =
   Addr
     Testnet
     (KeyHashObj testKeyHash1)
     StakeRefNull
 
-testPayCred :: forall c. CC.Crypto c => Credential 'Payment c
+testPayCred :: forall c. Crypto c => Credential 'Payment c
 testPayCred = KeyHashObj (testKeyHash1 @c)
 
-testStakeCred :: forall c. CC.Crypto c => Credential 'Staking c
+testStakeCred :: forall c. Crypto c => Credential 'Staking c
 testStakeCred = KeyHashObj $ testKeyHash2 @c
 
-testScript :: forall c. CC.Crypto c => MultiSig (ShelleyEra c)
+testScript :: forall c. Crypto c => MultiSig (ShelleyEra c)
 testScript = RequireSignature $ asWitness (testKeyHash1 @c)
 
-testScriptHash :: forall c. CC.Crypto c => ScriptHash c
+testScriptHash :: forall c. Crypto c => ScriptHash c
 testScriptHash = hashScript @(ShelleyEra c) testScript
 
-testScript2 :: forall c. CC.Crypto c => MultiSig (ShelleyEra c)
+testScript2 :: forall c. Crypto c => MultiSig (ShelleyEra c)
 testScript2 = RequireSignature $ asWitness (testKeyHash2 @c)
 
 testHeaderHash ::
   forall c.
-  CC.Crypto c =>
+  Crypto c =>
   HashHeader c
 testHeaderHash =
   HashHeader $
@@ -364,31 +361,31 @@ testBHB =
     , bheaderSlotNo = SlotNo 33
     , bheaderPrev = BlockHash testHeaderHash
     , bheaderVk = vKey testBlockIssuerKey
-    , bheaderVrfVk = snd $ testVRF @c
+    , bheaderVrfVk = vrfVerKey $ testVRF @c
     , bheaderEta =
         mkCertifiedVRF
           ( WithResult
               (mkSeed seedEta (SlotNo 33) (mkNonceFromNumber 0))
               1
           )
-          (fst $ testVRF @c)
+          (vrfSignKey $ testVRF @c)
     , bheaderL =
         mkCertifiedVRF
           ( WithResult
               (mkSeed seedL (SlotNo 33) (mkNonceFromNumber 0))
               1
           )
-          (fst $ testVRF @c)
+          (vrfSignKey $ testVRF @c)
     , bsize = 0
     , bhash = bbHash @era $ ShelleyTxSeq @era StrictSeq.empty
     , bheaderOCert =
         OCert
-          (snd $ testKESKeys @c)
+          (kesVerKey $ testKESKeys @c)
           0
           (KESPeriod 0)
           ( signedDSIGN @c
               (sKey $ testKey1 @c)
-              (OCertSignable (snd $ testKESKeys @c) 0 (KESPeriod 0))
+              (OCertSignable (kesVerKey $ testKESKeys @c) 0 (KESPeriod 0))
           )
     , bprotver = ProtVer minBound 0
     }
@@ -405,11 +402,11 @@ testBHBSigTokens ::
 testBHBSigTokens = e
   where
     s =
-      signedKES @(CC.KES (EraCrypto era))
+      signedKES @(KES (EraCrypto era))
         ()
         0
         (testBHB @era)
-        (fst $ testKESKeys @(EraCrypto era))
+        (kesSignKey $ testKESKeys @(EraCrypto era))
     CBOR.Encoding e = toPlainEncoding shelleyProtVer (encodeSignedKES s)
 
 tests :: TestTree
@@ -938,32 +935,32 @@ tests =
             )
     , -- checkEncodingCBOR "block_header_body"
       let prevhash = BlockHash testHeaderHash
-          vrfVkey = snd $ testVRF @C_Crypto
+          vrfVkey = vrfVerKey $ testVRF @C_Crypto
           slot = SlotNo 33
           nonce = mkSeed seedEta (SlotNo 33) (mkNonceFromNumber 0)
-          nonceProof :: CertifiedVRF (CC.VRF C_Crypto) Nonce
+          nonceProof :: CertifiedVRF (VRF C_Crypto) Nonce
           nonceProof =
             mkCertifiedVRF
               (WithResult nonce 1)
-              (fst $ testVRF @C_Crypto)
+              (vrfSignKey $ testVRF @C_Crypto)
           leaderValue = mkSeed seedL (SlotNo 33) (mkNonceFromNumber 0)
-          leaderProof :: CertifiedVRF (CC.VRF C_Crypto) Natural
+          leaderProof :: CertifiedVRF (VRF C_Crypto) Natural
           leaderProof =
             mkCertifiedVRF
               (WithResult leaderValue 1)
-              (fst $ testVRF @C_Crypto)
+              (vrfSignKey $ testVRF @C_Crypto)
           size = 0
           blockNo = BlockNo 44
           bbhash = bbHash @C $ ShelleyTxSeq StrictSeq.empty
           ocert :: OCert C_Crypto
           ocert =
             OCert
-              (snd $ testKESKeys @C_Crypto)
+              (kesVerKey $ testKESKeys @C_Crypto)
               0
               (KESPeriod 0)
               ( signedDSIGN @C_Crypto
                   (sKey (testBlockIssuerKey @C_Crypto))
-                  (OCertSignable (snd $ testKESKeys @C_Crypto) 0 (KESPeriod 0))
+                  (OCertSignable (kesVerKey $ testKESKeys @C_Crypto) 0 (KESPeriod 0))
               )
           protover = ProtVer minBound 0
        in checkEncodingCBOR
@@ -997,13 +994,13 @@ tests =
                 <> G protover -- 3
             )
     , -- checkEncodingCBOR "operational_cert"
-      let vkHot = snd $ testKESKeys @C_Crypto
+      let vkHot = kesVerKey $ testKESKeys @C_Crypto
           counter = 0
           kesperiod = KESPeriod 0
           signature =
             signedDSIGN @C_Crypto
               (sKey $ testKey1 @C_Crypto)
-              (OCertSignable (snd $ testKESKeys @C_Crypto) 0 (KESPeriod 0))
+              (OCertSignable (kesVerKey $ testKESKeys @C_Crypto) 0 (KESPeriod 0))
        in checkEncodingCBORCBORGroup
             "operational_cert"
             ( OCert @C_Crypto
@@ -1018,8 +1015,8 @@ tests =
                 <> T (testOpCertSigTokens @C_Crypto)
             )
     , -- checkEncodingCBOR "block_header"
-      let sig :: (SignedKES (CC.KES C_Crypto) (BHBody C_Crypto))
-          sig = signedKES () 0 (testBHB @C) (fst $ testKESKeys @C_Crypto)
+      let sig :: (SignedKES (KES C_Crypto) (BHBody C_Crypto))
+          sig = signedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto)
        in checkEncodingCBORAnnotated
             shelleyProtVer
             "block_header"
@@ -1029,8 +1026,8 @@ tests =
                 <> T (testBHBSigTokens @C)
             )
     , -- checkEncodingCBOR "empty_block"
-      let sig :: (SignedKES (CC.KES C_Crypto) (BHBody C_Crypto))
-          sig = signedKES () 0 (testBHB @C) (fst $ testKESKeys @C_Crypto)
+      let sig :: (SignedKES (KES C_Crypto) (BHBody C_Crypto))
+          sig = signedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto)
           bh = BHeader (testBHB @C) sig
           txns = ShelleyTxSeq StrictSeq.Empty
        in checkEncodingCBORAnnotated
@@ -1042,8 +1039,8 @@ tests =
                 <> T (TkListLen 0 . TkListLen 0 . TkMapLen 0)
             )
     , -- checkEncodingCBOR "rich_block"
-      let sig :: SignedKES (CC.KES C_Crypto) (BHBody C_Crypto)
-          sig = signedKES () 0 (testBHB @C) (fst $ testKESKeys @C_Crypto)
+      let sig :: SignedKES (KES C_Crypto) (BHBody C_Crypto)
+          sig = signedKES () 0 (testBHB @C) (kesSignKey $ testKESKeys @C_Crypto)
           bh = BHeader (testBHB @C) sig
           tout = StrictSeq.singleton $ ShelleyTxOut @C testAddrE (Coin 2)
           txb s =
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Genesis.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Genesis.hs
index 68a8d92155b..b907f8b0bb5 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Genesis.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Genesis.hs
@@ -40,6 +40,7 @@ import Paths_cardano_ledger_shelley_test (getDataFileName)
 import Test.Cardano.Ledger.Binary.TreeDiff (CBORBytes (CBORBytes), diffExpr)
 import Test.Cardano.Ledger.Core.KeyPair (vKey)
 import qualified Test.Cardano.Ledger.Shelley.Examples.Cast as Cast
+import Test.Cardano.Ledger.Shelley.Generator.Core (VRFKeyPair (..))
 import Test.Cardano.Ledger.Shelley.Utils (
   RawSeed (..),
   mkKeyPair,
@@ -254,12 +255,12 @@ exampleShelleyGenesis =
     poolParams =
       L.PoolParams
         { L.ppId = hashKey . snd $ mkKeyPair (RawSeed 1 0 0 0 1)
-        , L.ppVrf = hashVerKeyVRF . snd $ mkVRFKeyPair (RawSeed 1 0 0 0 2)
+        , L.ppVrf = hashVerKeyVRF . vrfVerKey $ mkVRFKeyPair @c (RawSeed 1 0 0 0 2)
         , L.ppPledge = L.Coin 1
         , L.ppCost = L.Coin 5
         , L.ppMargin = unsafeBoundRational 0.25
         , L.ppRewardAcnt = L.RewardAcnt L.Testnet Cast.aliceSHK
-        , L.ppOwners = Set.singleton $ (hashKey . vKey) Cast.aliceStake
+        , L.ppOwners = Set.singleton $ hashKey (vKey Cast.aliceStake)
         , L.ppRelays = relays
         , L.ppMetadata =
             L.SJust $
diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs
index cc534480ebc..1ce35592a05 100644
--- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs
+++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs
@@ -45,8 +45,6 @@ import Cardano.Ledger.Shelley.LedgerState (
   dsUnified,
   rewards,
  )
-import Control.DeepSeq (rnf)
-
 import Cardano.Ledger.Shelley.Rules (
   ShelleyDelegsPredFailure (..),
   ShelleyDelplPredFailure (..),
@@ -85,6 +83,7 @@ import Cardano.Ledger.Shelley.TxWits (
 import qualified Cardano.Ledger.UMapCompact as UM
 import Cardano.Ledger.Val ((<+>), (<->))
 import Cardano.Protocol.TPraos.BHeader (checkLeaderValue)
+import Control.DeepSeq (rnf)
 import Control.State.Transition.Extended (PredicateFailure, TRC (..))
 import Control.State.Transition.Trace (checkTrace, (.-), (.->>))
 import qualified Data.ByteString.Char8 as BS (pack)
@@ -108,7 +107,7 @@ import Test.Cardano.Ledger.Shelley.Address.Bootstrap (
 import Test.Cardano.Ledger.Shelley.Arbitrary (ASC (ASC), StakeProportion (StakeProportion), VRFNatVal (VRFNatVal))
 import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C, C_Crypto)
 import Test.Cardano.Ledger.Shelley.Fees (sizeTests)
-import Test.Cardano.Ledger.Shelley.Generator.Core (genesisCoins)
+import Test.Cardano.Ledger.Shelley.Generator.Core (VRFKeyPair (..), genesisCoins)
 import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
 import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
 import Test.Cardano.Ledger.Shelley.Utils
@@ -631,7 +630,7 @@ alicePoolParamsSmallCost =
             }
     }
   where
-    (_skVrf, vkVrf) = mkVRFKeyPair (RawSeed 0 0 0 0 2)
+    vkVrf = vrfVerKey $ mkVRFKeyPair @C_Crypto (RawSeed 0 0 0 0 2)
 
 testPoolCostTooSmall :: Assertion
 testPoolCostTooSmall =
diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs
index fb8ee8ec4ad..187742a98fc 100644
--- a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs
+++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/KeyPair.hs
@@ -29,7 +29,6 @@ import Cardano.Ledger.Credential (
   StakeReference (..),
  )
 import Cardano.Ledger.Crypto (Crypto, DSIGN, HASH)
-import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Keys (
   DSignable,
   HasKeyRole,
@@ -73,13 +72,13 @@ instance Crypto c => NoThunks (KeyPair kd c)
 instance HasKeyRole KeyPair
 
 mkAddr ::
-  CC.Crypto c =>
+  Crypto c =>
   (KeyPair 'Payment c, KeyPair 'Staking c) ->
   Addr c
 mkAddr (payKey, stakeKey) = Addr Testnet (mkCred payKey) (StakeRefBase $ mkCred stakeKey)
 
 mkCred ::
-  CC.Crypto c =>
+  Crypto c =>
   KeyPair kr c ->
   Credential kr c
 mkCred k = KeyHashObj . hashKey $ vKey k
@@ -120,7 +119,7 @@ makeWitnessesFromScriptKeys txbodyHash hashKeyMap scriptHashes =
    in mkWitnessesVKey txbodyHash (Map.elems witKeys)
 
 mkVKeyRwdAcnt ::
-  CC.Crypto c =>
+  Crypto c =>
   Network ->
   KeyPair 'Staking c ->
   RewardAcnt c
diff --git a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs
index 333598a1f27..cab4a0a7265 100644
--- a/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs
+++ b/libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs
@@ -58,7 +58,6 @@ import Cardano.Ledger.Shelley.API (
   ProtVer (..),
   UTxO (..),
  )
-import Cardano.Ledger.Shelley.BlockChain (bBodySize)
 import Cardano.Ledger.Shelley.Core hiding (TranslationError)
 import Cardano.Ledger.Shelley.LedgerState (smartUTxOState)
 import Cardano.Ledger.Shelley.Rules (
@@ -125,6 +124,7 @@ import Test.Cardano.Ledger.Shelley.Utils (
   mkKeyPair,
   mkVRFKeyPair,
  )
+import Test.Cardano.Protocol.TPraos.Create (VRFKeyPair (..))
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase)
 
@@ -573,7 +573,7 @@ poolMDHTooBigTx pf =
         poolParams =
           PoolParams
             { ppId = coerceKeyRole . hashKey . vKey $ someKeys pf
-            , ppVrf = hashVerKeyVRF . snd . mkVRFKeyPair $ RawSeed 0 0 0 0 0
+            , ppVrf = hashVerKeyVRF . vrfVerKey . mkVRFKeyPair @(EraCrypto era) $ RawSeed 0 0 0 0 0
             , ppPledge = Coin 0
             , ppCost = Coin 0
             , ppMargin = minBound
diff --git a/libs/cardano-protocol-tpraos/CHANGELOG.md b/libs/cardano-protocol-tpraos/CHANGELOG.md
index bb2a30cce8e..1a293a7ba82 100644
--- a/libs/cardano-protocol-tpraos/CHANGELOG.md
+++ b/libs/cardano-protocol-tpraos/CHANGELOG.md
@@ -2,10 +2,25 @@
 
 ## 1.0.1.0
 
-* Add a `testlib` and move `Arbitrary` instances from `Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators` over.
 * Add `ToCBOR`/`FromCBOR` instaces for `OCert` and `KESPeriod`
 * Make fields for `OCertEnv` strict.
 
+### `testlib`
+
+* Add a `testlib` and move `Arbitrary` instances from
+  `Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators` over.
+* Create `VRFKeyPair` and `KESKeyPair`. Dtart using them everywhere instead of tuples.
+* Add `mkBHeader`
+* Move from `cardano-ledger-shelley-test`: `mkOCert`, `mkBHBody`, `mkBlock`
+* Move `AllIssuerKeys` from `cardano-ledegr-shelley-test`. Rename its fields:
+  *  `cold` - > `aikCold`
+  *  `hot` - > `aikHot`
+  *  `vrf` - > `aikVrf`
+  *  `hk` - > `aikColdKeyHash`
+* Bring back `genBlock`
+* Move `genCoherentBlock` from `cardano-ledegr-shelley-test` and change it to accept
+  `AllIssuerKeys` as an argument.
+
 ## 1.0.0.0
 
 * First properly versioned release.
diff --git a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal
index f79af17a53f..b35b4cd9eed 100644
--- a/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal
+++ b/libs/cardano-protocol-tpraos/cardano-protocol-tpraos.cabal
@@ -55,7 +55,13 @@ library
         transformers
 
 library testlib
-    exposed-modules:  Test.Cardano.Protocol.TPraos.Arbitrary
+    exposed-modules:
+        Test.Cardano.Protocol.Crypto.KES
+        Test.Cardano.Protocol.Crypto.VRF
+        Test.Cardano.Protocol.Crypto.VRF.Fake
+        Test.Cardano.Protocol.TPraos.Arbitrary
+        Test.Cardano.Protocol.TPraos.Create
+
     visibility:       public
     hs-source-dirs:   testlib
     default-language: Haskell2010
@@ -66,10 +72,12 @@ library testlib
 
     build-depends:
         base,
+        bytestring,
         cardano-protocol-tpraos,
-        cardano-ledger-binary:testlib,
+        cardano-ledger-binary:{cardano-ledger-binary, testlib},
         cardano-ledger-shelley:testlib,
         cardano-ledger-core:{cardano-ledger-core, testlib},
-        QuickCheck,
+        cardano-crypto-class,
+        cardano-strict-containers,
         generic-random,
-        cardano-crypto-class
+        nothunks
diff --git a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs
index 54d1c279765..487ffc62ba7 100644
--- a/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs
+++ b/libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/OCert.hs
@@ -156,11 +156,7 @@ kesPeriod (SlotNo s) =
 data OCertSignable c
   = OCertSignable !(VerKeyKES c) !Word64 !KESPeriod
 
-instance
-  forall c.
-  Crypto c =>
-  SignableRepresentation (OCertSignable c)
-  where
+instance Crypto c => SignableRepresentation (OCertSignable c) where
   getSignableRepresentation (OCertSignable vk counter period) =
     runByteBuilder
       ( fromIntegral $
diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/KES.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/KES.hs
new file mode 100644
index 00000000000..0f856fac7d4
--- /dev/null
+++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/KES.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Test.Cardano.Protocol.Crypto.KES (
+  KESKeyPair (..),
+) where
+
+import qualified Cardano.Crypto.KES.Class as KES
+import Cardano.Ledger.Crypto
+import Cardano.Ledger.Keys (
+  SignKeyKES,
+  VerKeyKES,
+ )
+
+data KESKeyPair c = KESKeyPair
+  { kesSignKey :: !(SignKeyKES c)
+  , kesVerKey :: !(VerKeyKES c)
+  }
+
+deriving instance (Show (KES.SignKeyKES (KES c)), Show (KES.VerKeyKES (KES c))) => Show (KESKeyPair c)
diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF.hs
new file mode 100644
index 00000000000..900b6ab992e
--- /dev/null
+++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF.hs
@@ -0,0 +1,22 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Test.Cardano.Protocol.Crypto.VRF (
+  VRFKeyPair (..),
+) where
+
+import qualified Cardano.Crypto.VRF.Class as VRF
+import Cardano.Ledger.Crypto
+import Cardano.Ledger.Keys (
+  SignKeyVRF,
+  VerKeyVRF,
+ )
+
+data VRFKeyPair c = VRFKeyPair
+  { vrfSignKey :: !(SignKeyVRF c)
+  , vrfVerKey :: !(VerKeyVRF c)
+  }
+
+deriving instance (Show (VRF.SignKeyVRF (VRF c)), Show (VRF.VerKeyVRF (VRF c))) => Show (VRFKeyPair c)
diff --git a/eras/shelley/test-suite/src/Test/Cardano/Crypto/VRF/Fake.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs
similarity index 88%
rename from eras/shelley/test-suite/src/Test/Cardano/Crypto/VRF/Fake.hs
rename to libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs
index 64bdc12e8fc..0290aa22893 100644
--- a/eras/shelley/test-suite/src/Test/Cardano/Crypto/VRF/Fake.hs
+++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/Crypto/VRF/Fake.hs
@@ -11,7 +11,8 @@
 
 -- | Fake implementation of VRF, where the random value isn't random but given
 -- by the creator.
-module Test.Cardano.Crypto.VRF.Fake (
+module Test.Cardano.Protocol.Crypto.VRF.Fake (
+  NatNonce (..),
   FakeVRF,
   VerKeyVRF (..),
   SignKeyVRF (..),
@@ -48,6 +49,14 @@ import Data.Proxy (Proxy (..))
 import Data.Word (Word16, Word64)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
+import Numeric.Natural
+
+-- | We provide our own nonces to 'mkBlock', which we then wish to recover as
+-- the output of the VRF functions. In general, however, we just derive them
+-- from a natural. Since the nonce is a hash, we do not want to recover it to
+-- find a preimage. In testing, therefore, we just wrap the raw natural, which
+-- we then encode into the fake VRF implementation.
+newtype NatNonce = NatNonce Natural
 
 data FakeVRF
 
@@ -103,12 +112,12 @@ instance VRFAlgorithm FakeVRF where
 
   genKeyVRF seed = SignKeyFakeVRF $ runMonadRandomWithSeed seed getRandomWord64
   deriveVerKeyVRF (SignKeyFakeVRF n) = VerKeyFakeVRF n
-  evalVRF () a sk = evalVRF' a sk
+  evalVRF () a sk = evalFakeVRF a sk
 
   -- This implementation of `verifyVRF` checks the real result, which is hidden
   -- in the certificate, but ignores the produced value, which is set to be the
   -- result of the sneaking.
-  verifyVRF () (VerKeyFakeVRF n) a c = snd (evalVRF' a (SignKeyFakeVRF n)) == snd c
+  verifyVRF () (VerKeyFakeVRF n) a c = snd (evalFakeVRF a (SignKeyFakeVRF n)) == snd c
 
   sizeVerKeyVRF _ = 8
   sizeSignKeyVRF _ = 8
@@ -142,12 +151,12 @@ instance VRFAlgorithm FakeVRF where
     | otherwise =
         Nothing
 
-evalVRF' ::
+evalFakeVRF ::
   SneakilyContainResult a =>
   a ->
   SignKeyVRF FakeVRF ->
   (OutputVRF FakeVRF, CertVRF FakeVRF)
-evalVRF' a sk@(SignKeyFakeVRF n) =
+evalFakeVRF a sk@(SignKeyFakeVRF n) =
   let y = sneakilyExtractResult a sk
       p = unsneakilyExtractPayload a
       realValue =
diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs
index 736083665ce..0e6a7d20ce5 100644
--- a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs
+++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Arbitrary.hs
@@ -10,30 +10,38 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-module Test.Cardano.Protocol.TPraos.Arbitrary () where
+module Test.Cardano.Protocol.TPraos.Arbitrary (
+  genBHeader,
+  genBlock,
+  genCoherentBlock,
+) where
 
+import qualified Cardano.Crypto.DSIGN.Class as DSIGN (Signable)
 import qualified Cardano.Crypto.KES as KES
 import Cardano.Crypto.Util (SignableRepresentation)
 import qualified Cardano.Crypto.VRF as VRF
+import Cardano.Ledger.BaseTypes (BlockNo (..), Nonce, Seed, SlotNo (..))
 import Cardano.Ledger.Block (Block (Block))
-import Cardano.Ledger.Core (Era, EraSegWits, Tx, toTxSeq)
-import Cardano.Ledger.Crypto (Crypto (KES, VRF))
+import Cardano.Ledger.Core
+import Cardano.Ledger.Crypto (Crypto (KES, VRF), DSIGN)
 import Cardano.Ledger.Keys (signedKES)
+import Cardano.Protocol.TPraos.API (PraosCrypto)
 import Cardano.Protocol.TPraos.BHeader (
   BHBody (BHBody),
   BHeader (BHeader),
   HashHeader (HashHeader),
   PrevHash (BlockHash, GenesisHash),
  )
-import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod), OCert (..))
+import Cardano.Protocol.TPraos.OCert (KESPeriod (KESPeriod), OCert (..), OCertSignable (..))
 import Cardano.Protocol.TPraos.Rules.Overlay (OBftSlot)
 import Cardano.Protocol.TPraos.Rules.Prtcl (PrtclState)
 import Cardano.Protocol.TPraos.Rules.Tickn (TicknState)
 import Generic.Random (genericArbitraryU)
 import Test.Cardano.Ledger.Binary.Arbitrary ()
+import Test.Cardano.Ledger.Common
 import Test.Cardano.Ledger.Core.Arbitrary ()
 import Test.Cardano.Ledger.Shelley.Arbitrary ()
-import Test.QuickCheck (Arbitrary, arbitrary, frequency, genericShrink, shrink)
+import Test.Cardano.Protocol.TPraos.Create (AllIssuerKeys, mkBHBody, mkBHeader, mkBlock, mkOCert)
 
 instance Crypto c => Arbitrary (HashHeader c) where
   arbitrary = HashHeader <$> arbitrary
@@ -63,6 +71,30 @@ instance
     let sig = signedKES () 1 bhBody hotKey
     pure $ BHeader bhBody sig
 
+genBHeader ::
+  ( DSIGN.Signable (DSIGN c) (OCertSignable c)
+  , VRF.Signable (VRF c) Seed
+  , KES.Signable (KES c) (BHBody c)
+  , Crypto c
+  ) =>
+  [AllIssuerKeys c r] ->
+  Gen (BHeader c)
+genBHeader aiks = do
+  prevHash <- arbitrary
+  allPoolKeys <- elements aiks
+  slotNo <- arbitrary
+  blockNo <- arbitrary
+  epochNonce <- arbitrary
+  bodySize <- arbitrary
+  bodyHash <- arbitrary
+  protVer <- arbitrary
+  let kesPeriod = 1
+      keyRegKesPeriod = 1
+      oCert = mkOCert allPoolKeys 1 (KESPeriod kesPeriod)
+      bhBody =
+        mkBHBody protVer prevHash allPoolKeys slotNo blockNo epochNonce oCert bodySize bodyHash
+  return $ mkBHeader allPoolKeys kesPeriod keyRegKesPeriod bhBody
+
 instance
   ( Crypto c
   , VRF.Signable (VRF c) ~ SignableRepresentation
@@ -99,8 +131,8 @@ instance Crypto c => Arbitrary (OCert c) where
 deriving newtype instance Arbitrary KESPeriod
 
 instance
-  ( Crypto c
-  , Era era
+  ( Era era
+  , c ~ EraCrypto era
   , EraSegWits era
   , KES.Signable (KES c) ~ SignableRepresentation
   , VRF.Signable (VRF c) ~ SignableRepresentation
@@ -108,7 +140,57 @@ instance
   ) =>
   Arbitrary (Block (BHeader c) era)
   where
-  arbitrary =
-    Block
-      <$> arbitrary
-      <*> (toTxSeq @era <$> arbitrary)
+  arbitrary = Block <$> arbitrary <*> (toTxSeq <$> arbitrary)
+
+-- | Use supplied keys to generate a Block.
+genBlock ::
+  ( DSIGN.Signable (DSIGN c) (OCertSignable c)
+  , VRF.Signable (VRF c) Seed
+  , KES.Signable (KES c) (BHBody c)
+  , EraSegWits era
+  , Arbitrary (Tx era)
+  , c ~ EraCrypto era
+  ) =>
+  [AllIssuerKeys c r] ->
+  Gen (Block (BHeader c) era)
+genBlock aiks = Block <$> genBHeader aiks <*> (toTxSeq <$> arbitrary)
+
+-- | For some purposes, a totally random block generator may not be suitable.
+-- There are tests in the ouroboros-network repository, for instance, that
+-- perform some integrity checks on the generated blocks.
+--
+-- For other purposes, such as the serialization tests in this repository,
+-- 'genBlock' is more appropriate.
+--
+-- This generator uses 'mkBlock' provide more coherent blocks.
+genCoherentBlock ::
+  forall era r.
+  ( EraSegWits era
+  , Arbitrary (Tx era)
+  , KES.Signable (KES (EraCrypto era)) ~ SignableRepresentation
+  , DSIGN.Signable (DSIGN (EraCrypto era)) ~ SignableRepresentation
+  , PraosCrypto (EraCrypto era)
+  ) =>
+  [AllIssuerKeys (EraCrypto era) r] ->
+  Gen (Block (BHeader (EraCrypto era)) era)
+genCoherentBlock aiks = do
+  prevHash <- arbitrary :: Gen (HashHeader (EraCrypto era))
+  allPoolKeys <- elements aiks
+  txs <- arbitrary
+  curSlotNo <- SlotNo <$> choose (0, 10)
+  curBlockNo <- BlockNo <$> choose (0, 100)
+  epochNonce <- arbitrary :: Gen Nonce
+  let kesPeriod = 1
+      keyRegKesPeriod = 1
+      ocert = mkOCert allPoolKeys 1 (KESPeriod kesPeriod)
+  return $
+    mkBlock
+      prevHash
+      allPoolKeys
+      txs
+      curSlotNo
+      curBlockNo
+      epochNonce
+      kesPeriod
+      keyRegKesPeriod
+      ocert
diff --git a/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Create.hs b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Create.hs
new file mode 100644
index 00000000000..d1d5cd325d0
--- /dev/null
+++ b/libs/cardano-protocol-tpraos/testlib/Test/Cardano/Protocol/TPraos/Create.hs
@@ -0,0 +1,294 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE UndecidableInstances #-}
+
+module Test.Cardano.Protocol.TPraos.Create (
+  AllIssuerKeys (..),
+  KESKeyPair (..),
+  VRFKeyPair (..),
+  mkOCert,
+  mkBHBody,
+  mkBHBodyFakeVRF,
+  mkBHeader,
+  mkBlock,
+  mkBlockFakeVRF,
+  evolveKESUntil,
+) where
+
+import Cardano.Crypto.DSIGN (Signable)
+import qualified Cardano.Crypto.KES.Class as KES
+import qualified Cardano.Crypto.VRF.Class as VRF
+import Cardano.Ledger.BaseTypes (
+  BlockNo,
+  Nonce,
+  ProtVer (..),
+  Seed,
+  SlotNo,
+  UnitInterval,
+  unboundRational,
+ )
+import Cardano.Ledger.Block
+import Cardano.Ledger.Core
+import Cardano.Ledger.Crypto
+import Cardano.Ledger.Keys (
+  HasKeyRole (coerceKeyRole),
+  Hash,
+  KeyHash,
+  KeyRole (..),
+  signedDSIGN,
+  signedKES,
+ )
+import Cardano.Protocol.TPraos.BHeader (
+  BHBody (..),
+  BHeader (..),
+  HashHeader,
+  PrevHash (BlockHash),
+  mkSeed,
+  seedEta,
+  seedL,
+ )
+import Cardano.Protocol.TPraos.OCert (
+  KESPeriod (..),
+  OCert (..),
+  OCertSignable (..),
+ )
+import Data.Coerce
+import Data.List.NonEmpty as NE
+import Data.Ratio (denominator, numerator, (%))
+import Data.Sequence.Strict as StrictSeq
+import Data.Word
+import Numeric.Natural
+import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
+import Test.Cardano.Protocol.Crypto.KES (KESKeyPair (..))
+import Test.Cardano.Protocol.Crypto.VRF (VRFKeyPair (..))
+import Test.Cardano.Protocol.Crypto.VRF.Fake (NatNonce (..), WithResult (..))
+
+data AllIssuerKeys v (r :: KeyRole) = AllIssuerKeys
+  { aikCold :: KeyPair r v
+  , aikVrf :: VRFKeyPair v
+  , aikHot :: NonEmpty (KESPeriod, KESKeyPair v)
+  , aikColdKeyHash :: KeyHash r v
+  }
+  deriving (Show)
+
+mkOCert ::
+  forall c r.
+  (Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
+  AllIssuerKeys c r ->
+  Word64 ->
+  KESPeriod ->
+  OCert c
+mkOCert pKeys kesPeriod keyRegKesPeriod =
+  let vKeyHot = kesVerKey $ snd $ NE.head $ aikHot pKeys
+      sKeyCold = sKey $ aikCold pKeys
+   in OCert
+        { ocertVkHot = vKeyHot
+        , ocertN = kesPeriod
+        , ocertKESPeriod = keyRegKesPeriod
+        , ocertSigma = signedDSIGN @c sKeyCold (OCertSignable vKeyHot kesPeriod keyRegKesPeriod)
+        }
+
+mkBHBody ::
+  ( VRF.ContextVRF (VRF v) ~ ()
+  , VRF.Signable (VRF v) Seed
+  , VRF.VRFAlgorithm (VRF v)
+  ) =>
+  ProtVer ->
+  HashHeader v ->
+  AllIssuerKeys v r ->
+  SlotNo ->
+  BlockNo ->
+  Nonce ->
+  OCert v ->
+  Natural ->
+  Hash v EraIndependentBlockBody ->
+  BHBody v
+mkBHBody = mkBHBodyWithVRF (VRF.evalCertified ()) (VRF.evalCertified ())
+
+mkBHBodyFakeVRF ::
+  ( VRF.ContextVRF (VRF v) ~ ()
+  , VRF.Signable (VRF v) (WithResult Seed)
+  , VRF.VRFAlgorithm (VRF v)
+  ) =>
+  NatNonce ->
+  UnitInterval ->
+  ProtVer ->
+  HashHeader v ->
+  AllIssuerKeys v r ->
+  SlotNo ->
+  BlockNo ->
+  Nonce ->
+  OCert v ->
+  Natural ->
+  Hash v EraIndependentBlockBody ->
+  BHBody v
+mkBHBodyFakeVRF (NatNonce bnonce) l =
+  mkBHBodyWithVRF
+    (\nonce -> VRF.evalCertified () (WithResult nonce (fromIntegral bnonce)))
+    (\nonce -> VRF.evalCertified () (WithResult nonce (unitIntervalToWord64 l)))
+
+-- | Try to map the unit interval to a 64bit natural number. We don't care whether
+-- this is surjective. But it should be right inverse to `fromNatural` - that
+-- is, one should be able to recover the `UnitInterval` value used here.
+unitIntervalToWord64 :: UnitInterval -> Word64
+unitIntervalToWord64 ui =
+  toWord64 ((toInteger (maxBound :: Word64) % 1) * unboundRational ui)
+  where
+    toWord64 r = fromInteger (numerator r `quot` denominator r)
+
+mkBHBodyWithVRF ::
+  ( Coercible a (VRF.CertifiedVRF (VRF c) Nonce)
+  , Coercible b (VRF.CertifiedVRF (VRF c) Natural)
+  ) =>
+  (Seed -> VRF.SignKeyVRF (VRF c) -> a) ->
+  (Seed -> VRF.SignKeyVRF (VRF c) -> b) ->
+  ProtVer ->
+  HashHeader c ->
+  AllIssuerKeys c r ->
+  SlotNo ->
+  BlockNo ->
+  Nonce ->
+  OCert c ->
+  Natural ->
+  Hash c EraIndependentBlockBody ->
+  BHBody c
+mkBHBodyWithVRF mkVrfEta mkVrfL protVer prev pKeys slotNo blockNo enonce oCert bodySize bodyHash =
+  let nonceNonce = mkSeed seedEta slotNo enonce
+      leaderNonce = mkSeed seedL slotNo enonce
+      vKeyCold = vKey $ aikCold pKeys
+   in BHBody
+        { bheaderBlockNo = blockNo
+        , bheaderSlotNo = slotNo
+        , bheaderPrev = BlockHash prev
+        , bheaderVk = coerceKeyRole vKeyCold
+        , bheaderVrfVk = vrfVerKey $ aikVrf pKeys
+        , bheaderEta = coerce $ mkVrfEta nonceNonce (vrfSignKey $ aikVrf pKeys)
+        , bheaderL = coerce $ mkVrfL leaderNonce (vrfSignKey $ aikVrf pKeys)
+        , bsize = bodySize
+        , bhash = bodyHash
+        , bheaderOCert = oCert
+        , bprotver = protVer
+        }
+
+mkBHeader ::
+  (Crypto c, KES.Signable (KES c) (BHBody c)) =>
+  AllIssuerKeys c r ->
+  Word ->
+  -- | KES period of key registration
+  Word ->
+  BHBody c ->
+  BHeader c
+mkBHeader pKeys kesPeriod keyRegKesPeriod bhBody =
+  let sHot = kesSignKey $ snd $ NE.head $ aikHot pKeys
+      kpDiff = kesPeriod - keyRegKesPeriod
+      hotKey = case evolveKESUntil sHot (KESPeriod 0) (KESPeriod kpDiff) of
+        Nothing ->
+          error $
+            mconcat
+              [ "Could not evolve key to iteration. "
+              , "keyRegKesPeriod: " ++ show keyRegKesPeriod
+              , "kesPeriod: " ++ show kesPeriod
+              , "kpDiff: " ++ show kpDiff
+              ]
+        Just hKey -> hKey
+      sig = signedKES () kpDiff bhBody hotKey
+   in BHeader bhBody sig
+
+-- | Try to evolve KES key until specific KES period is reached, given the
+-- current KES period.
+evolveKESUntil ::
+  (KES.KESAlgorithm v, KES.ContextKES v ~ ()) =>
+  KES.SignKeyKES v ->
+  -- | Current KES period
+  KESPeriod ->
+  -- | Target KES period
+  KESPeriod ->
+  Maybe (KES.SignKeyKES v)
+evolveKESUntil sk1 (KESPeriod current) (KESPeriod target) = go sk1 current target
+  where
+    go !_ c t | t < c = Nothing
+    go !sk c t | c == t = Just sk
+    go !sk c t = case KES.updateKES () sk c of
+      Nothing -> Nothing
+      Just sk' -> go sk' (c + 1) t
+
+mkBlock ::
+  forall era r.
+  ( EraSegWits era
+  , VRF.Signable (VRF (EraCrypto era)) Seed
+  , KES.Signable (KES (EraCrypto era)) (BHBody (EraCrypto era))
+  ) =>
+  -- | Hash of previous block
+  HashHeader (EraCrypto era) ->
+  -- | All keys in the stake pool
+  AllIssuerKeys (EraCrypto era) r ->
+  -- | Transactions to record
+  [Tx era] ->
+  -- | Current slot
+  SlotNo ->
+  -- | Block number/chain length/chain "difficulty"
+  BlockNo ->
+  -- | EpochNo nonce
+  Nonce ->
+  -- | Period of KES (key evolving signature scheme)
+  Word ->
+  -- | KES period of key registration
+  Word ->
+  -- | Operational certificate
+  OCert (EraCrypto era) ->
+  Block (BHeader (EraCrypto era)) era
+mkBlock prev pKeys txns slotNo blockNo enonce kesPeriod keyRegKesPeriod oCert =
+  let protVer = ProtVer (eraProtVerHigh @era) 0
+      txseq = toTxSeq @era (StrictSeq.fromList txns)
+      bodySize = fromIntegral $ bBodySize protVer txseq
+      bodyHash = hashTxSeq @era txseq
+      bhBody = mkBHBody protVer prev pKeys slotNo blockNo enonce oCert bodySize bodyHash
+      bHeader = mkBHeader pKeys kesPeriod keyRegKesPeriod bhBody
+   in Block bHeader txseq
+
+-- | Create a block with a faked VRF result.
+mkBlockFakeVRF ::
+  forall era r.
+  ( EraSegWits era
+  , VRF.Signable (VRF (EraCrypto era)) (WithResult Seed)
+  , KES.Signable (KES (EraCrypto era)) (BHBody (EraCrypto era))
+  ) =>
+  -- | Hash of previous block
+  HashHeader (EraCrypto era) ->
+  -- | All keys in the stake pool
+  AllIssuerKeys (EraCrypto era) r ->
+  -- | Transactions to record
+  [Tx era] ->
+  -- | Current slot
+  SlotNo ->
+  -- | Block number\/chain length\/chain "difficulty"
+  BlockNo ->
+  -- | EpochNo nonce
+  Nonce ->
+  -- | Block nonce
+  NatNonce ->
+  -- | Praos leader value
+  UnitInterval ->
+  -- | Period of KES (key evolving signature scheme)
+  Word ->
+  -- | KES period of key registration
+  Word ->
+  -- | Operational certificate
+  OCert (EraCrypto era) ->
+  Block (BHeader (EraCrypto era)) era
+mkBlockFakeVRF prev pKeys txns slotNo blockNo enonce bnonce l kesPeriod keyRegKesPeriod oCert =
+  let protVer = ProtVer (eraProtVerHigh @era) 0
+      txSeq = toTxSeq @era (StrictSeq.fromList txns)
+      bodySize = fromIntegral $ bBodySize protVer txSeq
+      bodyHash = hashTxSeq txSeq
+      bhBody =
+        mkBHBodyFakeVRF bnonce l protVer prev pKeys slotNo blockNo enonce oCert bodySize bodyHash
+      bHeader = mkBHeader pKeys kesPeriod keyRegKesPeriod bhBody
+   in Block bHeader txSeq