{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Hot key
--
-- Intended for qualified import
module Ouroboros.Consensus.Protocol.Ledger.HotKey (
    -- * KES Info
    KESEvolution
  , KESInfo (..)
  , kesAbsolutePeriod
    -- * KES Status
  , KESStatus (..)
  , kesStatus
    -- * Hot Key
  , HotKey (..)
  , KESEvolutionError (..)
  , KESEvolutionInfo
  , mkHotKey
  , sign
  ) where

import qualified Cardano.Crypto.KES as KES
import qualified Cardano.Crypto.KES as Relative (Period)
import           Cardano.Protocol.Crypto (Crypto (..))
import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..))
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)
import           Ouroboros.Consensus.Block.Forging (UpdateInfo (..))
import           Ouroboros.Consensus.Util.IOLike

{-------------------------------------------------------------------------------
  KES Info
-------------------------------------------------------------------------------}

-- | We call the relative periods that a KES key is valid its evolution, to
-- avoid confusion with absolute periods.
type KESEvolution = Relative.Period

data KESInfo = KESInfo {
      KESInfo -> KESPeriod
kesStartPeriod :: !Absolute.KESPeriod
   ,  KESInfo -> KESPeriod
kesEndPeriod   :: !Absolute.KESPeriod
      -- ^ Currently derived from 'TPraosParams':
      -- > kesEndPeriod = kesStartPeriod + tpraosMaxKESEvo
    , KESInfo -> Word
kesEvolution   :: !KESEvolution
      -- ^ Current evolution or /relative period/.
      --
      -- Invariant:
      -- > kesStartPeriod + kesEvolution in [kesStartPeriod, kesEndPeriod)
    }
  deriving (Int -> KESInfo -> ShowS
[KESInfo] -> ShowS
KESInfo -> String
(Int -> KESInfo -> ShowS)
-> (KESInfo -> String) -> ([KESInfo] -> ShowS) -> Show KESInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KESInfo -> ShowS
showsPrec :: Int -> KESInfo -> ShowS
$cshow :: KESInfo -> String
show :: KESInfo -> String
$cshowList :: [KESInfo] -> ShowS
showList :: [KESInfo] -> ShowS
Show, (forall x. KESInfo -> Rep KESInfo x)
-> (forall x. Rep KESInfo x -> KESInfo) -> Generic KESInfo
forall x. Rep KESInfo x -> KESInfo
forall x. KESInfo -> Rep KESInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KESInfo -> Rep KESInfo x
from :: forall x. KESInfo -> Rep KESInfo x
$cto :: forall x. Rep KESInfo x -> KESInfo
to :: forall x. Rep KESInfo x -> KESInfo
Generic, Context -> KESInfo -> IO (Maybe ThunkInfo)
Proxy KESInfo -> String
(Context -> KESInfo -> IO (Maybe ThunkInfo))
-> (Context -> KESInfo -> IO (Maybe ThunkInfo))
-> (Proxy KESInfo -> String)
-> NoThunks KESInfo
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
noThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy KESInfo -> String
showTypeOf :: Proxy KESInfo -> String
NoThunks)

-- | Return the absolute KES period
kesAbsolutePeriod :: KESInfo -> Absolute.KESPeriod
kesAbsolutePeriod :: KESInfo -> KESPeriod
kesAbsolutePeriod KESInfo { KESPeriod
kesStartPeriod :: KESInfo -> KESPeriod
kesStartPeriod :: KESPeriod
kesStartPeriod, Word
kesEvolution :: KESInfo -> Word
kesEvolution :: Word
kesEvolution } =
    Word -> KESPeriod
Absolute.KESPeriod (Word -> KESPeriod) -> Word -> KESPeriod
forall a b. (a -> b) -> a -> b
$ Word
start Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
kesEvolution
  where
    Absolute.KESPeriod Word
start = KESPeriod
kesStartPeriod

{-------------------------------------------------------------------------------
  KES Status
-------------------------------------------------------------------------------}

data KESStatus =
    -- | The given period is before the start period of the KES key.
    BeforeKESStart
      Absolute.KESPeriod  -- ^ Given period
      Absolute.KESPeriod  -- ^ Start period of the KES key

    -- | The given period is in the range of the KES key.
  | InKESRange
      KESEvolution  -- ^ Relative period or evolution corresponding to the
                    -- given absolute period

    -- | The given period is after the end period of the KES key.
  | AfterKESEnd
      Absolute.KESPeriod  -- ^ Given period
      Absolute.KESPeriod  -- ^ End period of the KES key

-- | Return the evolution of the given KES period, /when/ it falls within the
-- range of the 'HotKey' (@[hkStart, hkEnd)@).
--
-- Note that the upper bound is exclusive, the spec says:
-- > c0 <= kesPeriod s < c0 + MaxKESEvo
kesStatus :: KESInfo -> Absolute.KESPeriod -> KESStatus
kesStatus :: KESInfo -> KESPeriod -> KESStatus
kesStatus KESInfo { kesStartPeriod :: KESInfo -> KESPeriod
kesStartPeriod = lo' :: KESPeriod
lo'@(Absolute.KESPeriod Word
lo)
                  , kesEndPeriod :: KESInfo -> KESPeriod
kesEndPeriod   = hi' :: KESPeriod
hi'@(Absolute.KESPeriod Word
hi)
                  }
          cur' :: KESPeriod
cur'@(Absolute.KESPeriod Word
cur)
    | Word
cur Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<  Word
lo = KESPeriod -> KESPeriod -> KESStatus
BeforeKESStart KESPeriod
cur' KESPeriod
lo'
    | Word
cur Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
>= Word
hi = KESPeriod -> KESPeriod -> KESStatus
AfterKESEnd KESPeriod
cur' KESPeriod
hi'
    | Bool
otherwise = Word -> KESStatus
InKESRange (Word
cur Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
lo)

{-------------------------------------------------------------------------------
  Hot Key
-------------------------------------------------------------------------------}

-- | Failed to evolve the KES key.
data KESEvolutionError =
    -- | The KES key could not be evolved to the target period.
    KESCouldNotEvolve
      KESInfo
      Absolute.KESPeriod
        -- ^ Target period outside the range of the current KES key. Typically
        -- the current KES period according to the wallclock slot.

    -- | The KES key was already poisoned.
  | KESKeyAlreadyPoisoned
      KESInfo
      Absolute.KESPeriod
        -- ^ Target period outside the range of the current KES key. Typically
        -- the current KES period according to the wallclock slot.
  deriving (Int -> KESEvolutionError -> ShowS
[KESEvolutionError] -> ShowS
KESEvolutionError -> String
(Int -> KESEvolutionError -> ShowS)
-> (KESEvolutionError -> String)
-> ([KESEvolutionError] -> ShowS)
-> Show KESEvolutionError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KESEvolutionError -> ShowS
showsPrec :: Int -> KESEvolutionError -> ShowS
$cshow :: KESEvolutionError -> String
show :: KESEvolutionError -> String
$cshowList :: [KESEvolutionError] -> ShowS
showList :: [KESEvolutionError] -> ShowS
Show)

-- | Result of evolving the KES key.
type KESEvolutionInfo = UpdateInfo KESInfo KESEvolutionError

-- | API to interact with the key.
data HotKey c m = HotKey {
      -- | Evolve the KES signing key to the given absolute KES period.
      --
      -- When the key cannot evolve anymore, we poison it.
      forall c (m :: * -> *).
HotKey c m -> KESPeriod -> m KESEvolutionInfo
evolve     :: Absolute.KESPeriod -> m KESEvolutionInfo
      -- | Return 'KESInfo' of the signing key.
    , forall c (m :: * -> *). HotKey c m -> m KESInfo
getInfo    :: m KESInfo
      -- | Return 'True' when the signing key is poisoned because it expired.
    , forall c (m :: * -> *). HotKey c m -> m Bool
isPoisoned :: m Bool
      -- | Sign the given @toSign@ with the current signing key.
      --
      -- PRECONDITION: the key is not poisoned.
      --
      -- POSTCONDITION: the signature is in normal form.
    , forall c (m :: * -> *).
HotKey c m
-> forall toSign.
   (Signable (KES c) toSign, HasCallStack) =>
   toSign -> m (SignedKES (KES c) toSign)
sign_      :: forall toSign. (KES.Signable (KES c) toSign, HasCallStack)
                 => toSign -> m (KES.SignedKES (KES c) toSign)
    }

sign ::
     (KES.Signable (KES c) toSign, HasCallStack)
  => HotKey c m
  -> toSign -> m (KES.SignedKES (KES c) toSign)
sign :: forall c toSign (m :: * -> *).
(Signable (KES c) toSign, HasCallStack) =>
HotKey c m -> toSign -> m (SignedKES (KES c) toSign)
sign = HotKey c m -> toSign -> m (SignedKES (KES c) toSign)
HotKey c m
-> forall toSign.
   (Signable (KES c) toSign, HasCallStack) =>
   toSign -> m (SignedKES (KES c) toSign)
forall c (m :: * -> *).
HotKey c m
-> forall toSign.
   (Signable (KES c) toSign, HasCallStack) =>
   toSign -> m (SignedKES (KES c) toSign)
sign_

-- | The actual KES key, unless it expired, in which case it is replaced by
-- \"poison\".
data KESKey c =
    KESKey !(KES.UnsoundPureSignKeyKES (KES c))
  | KESKeyPoisoned
  deriving ((forall x. KESKey c -> Rep (KESKey c) x)
-> (forall x. Rep (KESKey c) x -> KESKey c) -> Generic (KESKey c)
forall x. Rep (KESKey c) x -> KESKey c
forall x. KESKey c -> Rep (KESKey c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (KESKey c) x -> KESKey c
forall c x. KESKey c -> Rep (KESKey c) x
$cfrom :: forall c x. KESKey c -> Rep (KESKey c) x
from :: forall x. KESKey c -> Rep (KESKey c) x
$cto :: forall c x. Rep (KESKey c) x -> KESKey c
to :: forall x. Rep (KESKey c) x -> KESKey c
Generic)

instance Crypto c => NoThunks (KESKey c)

kesKeyIsPoisoned :: KESKey c -> Bool
kesKeyIsPoisoned :: forall c. KESKey c -> Bool
kesKeyIsPoisoned KESKey c
KESKeyPoisoned = Bool
True
kesKeyIsPoisoned (KESKey UnsoundPureSignKeyKES (KES c)
_)     = Bool
False

data KESState c = KESState {
      forall c. KESState c -> KESInfo
kesStateInfo :: !KESInfo
    , forall c. KESState c -> KESKey c
kesStateKey  :: !(KESKey c)
    }
  deriving ((forall x. KESState c -> Rep (KESState c) x)
-> (forall x. Rep (KESState c) x -> KESState c)
-> Generic (KESState c)
forall x. Rep (KESState c) x -> KESState c
forall x. KESState c -> Rep (KESState c) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall c x. Rep (KESState c) x -> KESState c
forall c x. KESState c -> Rep (KESState c) x
$cfrom :: forall c x. KESState c -> Rep (KESState c) x
from :: forall x. KESState c -> Rep (KESState c) x
$cto :: forall c x. Rep (KESState c) x -> KESState c
to :: forall x. Rep (KESState c) x -> KESState c
Generic)

instance Crypto c => NoThunks (KESState c)

mkHotKey ::
     forall m c. (Crypto c, IOLike m)
  => KES.UnsoundPureSignKeyKES (KES c)
  -> Absolute.KESPeriod  -- ^ Start period
  -> Word64              -- ^ Max KES evolutions
  -> m (HotKey c m)
mkHotKey :: forall (m :: * -> *) c.
(Crypto c, IOLike m) =>
UnsoundPureSignKeyKES (KES c)
-> KESPeriod -> Word64 -> m (HotKey c m)
mkHotKey UnsoundPureSignKeyKES (KES c)
initKey startPeriod :: KESPeriod
startPeriod@(Absolute.KESPeriod Word
start) Word64
maxKESEvolutions = do
    varKESState <- KESState c -> m (StrictMVar m (KESState c))
forall (m :: * -> *) a.
(HasCallStack, MonadMVar m, NoThunks a) =>
a -> m (StrictMVar m a)
newMVar KESState c
initKESState
    return HotKey {
        evolve     = evolveKey varKESState
      , getInfo    = kesStateInfo <$> readMVar varKESState
      , isPoisoned = kesKeyIsPoisoned . kesStateKey <$> readMVar varKESState
      , sign_      = \toSign
toSign -> do
          KESState { kesStateInfo, kesStateKey } <- StrictMVar m (KESState c) -> m (KESState c)
forall (m :: * -> *) a. MonadMVar m => StrictMVar m a -> m a
readMVar StrictMVar m (KESState c)
varKESState
          case kesStateKey of
            KESKey c
KESKeyPoisoned -> String -> m (SignedKES (KES c) toSign)
forall a. HasCallStack => String -> a
error String
"trying to sign with a poisoned key"
            KESKey UnsoundPureSignKeyKES (KES c)
key     -> do
              let evolution :: Word
evolution = KESInfo -> Word
kesEvolution KESInfo
kesStateInfo
                  signed :: SignedKES (KES c) toSign
signed    = ContextKES (KES c)
-> Word
-> toSign
-> UnsoundPureSignKeyKES (KES c)
-> SignedKES (KES c) toSign
forall v a.
(UnsoundPureKESAlgorithm v, Signable v a) =>
ContextKES v
-> Word -> a -> UnsoundPureSignKeyKES v -> SignedKES v a
KES.unsoundPureSignedKES () Word
evolution toSign
toSign UnsoundPureSignKeyKES (KES c)
key
              -- Force the signature to WHNF (for 'SignedKES', WHNF implies
              -- NF) so that we don't have any thunks holding on to a key that
              -- might be destructively updated when evolved.
              SignedKES (KES c) toSign -> m (SignedKES (KES c) toSign)
forall a. a -> m a
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate SignedKES (KES c) toSign
signed
      }
  where
    initKESState :: KESState c
    initKESState :: KESState c
initKESState = KESState {
        kesStateInfo :: KESInfo
kesStateInfo = KESInfo {
            kesStartPeriod :: KESPeriod
kesStartPeriod = KESPeriod
startPeriod
          , kesEndPeriod :: KESPeriod
kesEndPeriod   = Word -> KESPeriod
Absolute.KESPeriod (Word
start Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
maxKESEvolutions)
            -- We always start from 0 as the key hasn't evolved yet.
          , kesEvolution :: Word
kesEvolution   = Word
0
          }
      , kesStateKey :: KESKey c
kesStateKey = UnsoundPureSignKeyKES (KES c) -> KESKey c
forall c. UnsoundPureSignKeyKES (KES c) -> KESKey c
KESKey UnsoundPureSignKeyKES (KES c)
initKey
      }

-- | Evolve the 'HotKey' so that its evolution matches the given KES period.
--
-- When the given KES period is after the end period of the 'HotKey', we
-- poison the key and return 'UpdateFailed'.
--
-- When the given KES period is before the start period of the 'HotKey' or
-- when the given period is before the key's period, we don't evolve the key
-- and return 'Updated'.
--
-- When the given KES period is within the range of the 'HotKey' and the given
-- period is after the key's period, we evolve the key and return 'Updated'.
--
-- When the key is poisoned, we always return 'UpdateFailed'.
evolveKey ::
     forall m c. (Crypto c, IOLike m)
  => StrictMVar m (KESState c) -> Absolute.KESPeriod -> m KESEvolutionInfo
evolveKey :: forall (m :: * -> *) c.
(Crypto c, IOLike m) =>
StrictMVar m (KESState c) -> KESPeriod -> m KESEvolutionInfo
evolveKey StrictMVar m (KESState c)
varKESState KESPeriod
targetPeriod = StrictMVar m (KESState c)
-> (KESState c -> m (KESState c, KESEvolutionInfo))
-> m KESEvolutionInfo
forall (m :: * -> *) a b.
(HasCallStack, MonadMVar m) =>
StrictMVar m a -> (a -> m (a, b)) -> m b
modifyMVar StrictMVar m (KESState c)
varKESState ((KESState c -> m (KESState c, KESEvolutionInfo))
 -> m KESEvolutionInfo)
-> (KESState c -> m (KESState c, KESEvolutionInfo))
-> m KESEvolutionInfo
forall a b. (a -> b) -> a -> b
$ \KESState c
kesState -> do
    let info :: KESInfo
info = KESState c -> KESInfo
forall c. KESState c -> KESInfo
kesStateInfo KESState c
kesState
    -- We mask the evolution process because if we got interrupted after
    -- calling 'forgetSignKeyKES', which destructively updates the current
    -- signing key, we would leave an erased key in the state, which might
    -- cause a segfault when used afterwards.
    m (KESState c, KESEvolutionInfo)
-> m (KESState c, KESEvolutionInfo)
forall a. m a -> m a
forall (m :: * -> *) a. MonadMask m => m a -> m a
uninterruptibleMask_ (m (KESState c, KESEvolutionInfo)
 -> m (KESState c, KESEvolutionInfo))
-> m (KESState c, KESEvolutionInfo)
-> m (KESState c, KESEvolutionInfo)
forall a b. (a -> b) -> a -> b
$ case KESState c -> KESKey c
forall c. KESState c -> KESKey c
kesStateKey KESState c
kesState of

      KESKey c
KESKeyPoisoned ->
        let err :: KESEvolutionError
err = KESInfo -> KESPeriod -> KESEvolutionError
KESKeyAlreadyPoisoned KESInfo
info KESPeriod
targetPeriod
        in (KESState c, KESEvolutionInfo) -> m (KESState c, KESEvolutionInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KESState c
kesState, KESEvolutionError -> KESEvolutionInfo
forall updated failed. failed -> UpdateInfo updated failed
UpdateFailed KESEvolutionError
err)

      KESKey UnsoundPureSignKeyKES (KES c)
key -> case KESInfo -> KESPeriod -> KESStatus
kesStatus KESInfo
info KESPeriod
targetPeriod of
        -- When the absolute period is before the start period, we can't
        -- update the key. 'checkCanForge' will say we can't forge because the
        -- key is not valid yet.
        BeforeKESStart {} ->
            (KESState c, KESEvolutionInfo) -> m (KESState c, KESEvolutionInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KESState c
kesState, KESInfo -> KESEvolutionInfo
forall updated failed. updated -> UpdateInfo updated failed
Updated KESInfo
info)

        -- When the absolute period is after the end period, we can't evolve
        -- anymore and poison the expired key.
        AfterKESEnd {} ->
            let err :: KESEvolutionError
err = KESInfo -> KESPeriod -> KESEvolutionError
KESCouldNotEvolve KESInfo
info KESPeriod
targetPeriod
            in (KESState c, KESEvolutionInfo) -> m (KESState c, KESEvolutionInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KESState c -> KESState c
poisonState KESState c
kesState, KESEvolutionError -> KESEvolutionInfo
forall updated failed. failed -> UpdateInfo updated failed
UpdateFailed KESEvolutionError
err)

        InKESRange Word
targetEvolution
          -- No evolving needed
          | Word
targetEvolution Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= KESInfo -> Word
kesEvolution KESInfo
info
          -> (KESState c, KESEvolutionInfo) -> m (KESState c, KESEvolutionInfo)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KESState c
kesState, KESInfo -> KESEvolutionInfo
forall updated failed. updated -> UpdateInfo updated failed
Updated KESInfo
info)

          -- Evolving needed
          | Bool
otherwise
          -> (\KESState c
s' -> (KESState c
s', KESInfo -> KESEvolutionInfo
forall updated failed. updated -> UpdateInfo updated failed
Updated (KESState c -> KESInfo
forall c. KESState c -> KESInfo
kesStateInfo KESState c
s'))) (KESState c -> (KESState c, KESEvolutionInfo))
-> m (KESState c) -> m (KESState c, KESEvolutionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
               Word -> KESInfo -> UnsoundPureSignKeyKES (KES c) -> m (KESState c)
go Word
targetEvolution KESInfo
info UnsoundPureSignKeyKES (KES c)
key

  where
    poisonState :: KESState c -> KESState c
    poisonState :: KESState c -> KESState c
poisonState KESState c
kesState = KESState c
kesState { kesStateKey = KESKeyPoisoned }

    -- | PRECONDITION:
    --
    -- > targetEvolution >= curEvolution
    go :: KESEvolution -> KESInfo -> KES.UnsoundPureSignKeyKES (KES c) -> m (KESState c)
    go :: Word -> KESInfo -> UnsoundPureSignKeyKES (KES c) -> m (KESState c)
go Word
targetEvolution KESInfo
info UnsoundPureSignKeyKES (KES c)
key
      | Word
targetEvolution Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
curEvolution
      = KESState c -> m (KESState c)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (KESState c -> m (KESState c)) -> KESState c -> m (KESState c)
forall a b. (a -> b) -> a -> b
$ KESState { kesStateInfo :: KESInfo
kesStateInfo = KESInfo
info, kesStateKey :: KESKey c
kesStateKey = UnsoundPureSignKeyKES (KES c) -> KESKey c
forall c. UnsoundPureSignKeyKES (KES c) -> KESKey c
KESKey UnsoundPureSignKeyKES (KES c)
key }
      | Bool
otherwise
      = case ContextKES (KES c)
-> UnsoundPureSignKeyKES (KES c)
-> Word
-> Maybe (UnsoundPureSignKeyKES (KES c))
forall v.
UnsoundPureKESAlgorithm v =>
ContextKES v
-> UnsoundPureSignKeyKES v
-> Word
-> Maybe (UnsoundPureSignKeyKES v)
KES.unsoundPureUpdateKES () UnsoundPureSignKeyKES (KES c)
key Word
curEvolution of
          -- This cannot happen
          Maybe (UnsoundPureSignKeyKES (KES c))
Nothing    -> String -> m (KESState c)
forall a. HasCallStack => String -> a
error String
"Could not update KES key"
          Just !UnsoundPureSignKeyKES (KES c)
key' -> do
            -- Clear the memory associated with the old key
            -- FIXME: Secure forgetting is not available through the unsound KES API,
            -- but we must restore this invocation when moving to the new mlocked KES
            -- API.
            -- forgetSignKeyKES key
            let info' :: KESInfo
info' = KESInfo
info { kesEvolution = curEvolution + 1 }
            Word -> KESInfo -> UnsoundPureSignKeyKES (KES c) -> m (KESState c)
go Word
targetEvolution KESInfo
info' UnsoundPureSignKeyKES (KES c)
key'
      where
        curEvolution :: Word
curEvolution = KESInfo -> Word
kesEvolution KESInfo
info