{-# 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           Data.Word (Word64)
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)

import qualified Cardano.Crypto.KES as Relative (Period)

import           Ouroboros.Consensus.Block.Forging (UpdateInfo (..))
import           Ouroboros.Consensus.Util.IOLike

import           Cardano.Ledger.Crypto (Crypto)
import qualified Cardano.Ledger.Keys as SL
import qualified Cardano.Protocol.TPraos.OCert as Absolute (KESPeriod (..))

{-------------------------------------------------------------------------------
  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 -> KESEvolution
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
showList :: [KESInfo] -> ShowS
$cshowList :: [KESInfo] -> ShowS
show :: KESInfo -> String
$cshow :: KESInfo -> String
showsPrec :: Int -> KESInfo -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep KESInfo x -> KESInfo
$cfrom :: forall x. KESInfo -> Rep KESInfo x
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
showTypeOf :: Proxy KESInfo -> String
$cshowTypeOf :: Proxy KESInfo -> String
wNoThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
noThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> KESInfo -> IO (Maybe ThunkInfo)
NoThunks)

-- | Return the absolute KES period
kesAbsolutePeriod :: KESInfo -> Absolute.KESPeriod
kesAbsolutePeriod :: KESInfo -> KESPeriod
kesAbsolutePeriod KESInfo { KESPeriod
kesStartPeriod :: KESPeriod
kesStartPeriod :: KESInfo -> KESPeriod
kesStartPeriod, KESEvolution
kesEvolution :: KESEvolution
kesEvolution :: KESInfo -> KESEvolution
kesEvolution } =
    KESEvolution -> KESPeriod
Absolute.KESPeriod (KESEvolution -> KESPeriod) -> KESEvolution -> KESPeriod
forall a b. (a -> b) -> a -> b
$ KESEvolution
start KESEvolution -> KESEvolution -> KESEvolution
forall a. Num a => a -> a -> a
+ KESEvolution
kesEvolution
  where
    Absolute.KESPeriod KESEvolution
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 KESEvolution
lo)
                  , kesEndPeriod :: KESInfo -> KESPeriod
kesEndPeriod   = hi' :: KESPeriod
hi'@(Absolute.KESPeriod KESEvolution
hi)
                  }
          cur' :: KESPeriod
cur'@(Absolute.KESPeriod KESEvolution
cur)
    | KESEvolution
cur KESEvolution -> KESEvolution -> Bool
forall a. Ord a => a -> a -> Bool
<  KESEvolution
lo = KESPeriod -> KESPeriod -> KESStatus
BeforeKESStart KESPeriod
cur' KESPeriod
lo'
    | KESEvolution
cur KESEvolution -> KESEvolution -> Bool
forall a. Ord a => a -> a -> Bool
>= KESEvolution
hi = KESPeriod -> KESPeriod -> KESStatus
AfterKESEnd KESPeriod
cur' KESPeriod
hi'
    | Bool
otherwise = KESEvolution -> KESStatus
InKESRange (KESEvolution
cur KESEvolution -> KESEvolution -> KESEvolution
forall a. Num a => a -> a -> a
- KESEvolution
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
showList :: [KESEvolutionError] -> ShowS
$cshowList :: [KESEvolutionError] -> ShowS
show :: KESEvolutionError -> String
$cshow :: KESEvolutionError -> String
showsPrec :: Int -> KESEvolutionError -> ShowS
$cshowsPrec :: Int -> 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.
      HotKey c m -> KESPeriod -> m KESEvolutionInfo
evolve     :: Absolute.KESPeriod -> m KESEvolutionInfo
      -- | Return 'KESInfo' of the signing key.
    , HotKey c m -> m KESInfo
getInfo    :: m KESInfo
      -- | Return 'True' when the signing key is poisoned because it expired.
    , 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.
    , HotKey c m
-> forall toSign.
   (KESignable c toSign, HasCallStack) =>
   toSign -> m (SignedKES c toSign)
sign_      :: forall toSign. (SL.KESignable c toSign, HasCallStack)
                 => toSign -> m (SL.SignedKES c toSign)
    }

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

-- | The actual KES key, unless it expired, in which case it is replaced by
-- \"poison\".
data KESKey c =
    KESKey !(SL.SignKeyKES 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
$cto :: forall c x. Rep (KESKey c) x -> KESKey c
$cfrom :: forall c x. KESKey c -> Rep (KESKey c) x
Generic)

instance Crypto c => NoThunks (KESKey c)

kesKeyIsPoisoned :: KESKey c -> Bool
kesKeyIsPoisoned :: KESKey c -> Bool
kesKeyIsPoisoned KESKey c
KESKeyPoisoned = Bool
True
kesKeyIsPoisoned (KESKey SignKeyKES c
_)     = Bool
False

data KESState c = KESState {
      KESState c -> KESInfo
kesStateInfo :: !KESInfo
    , 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
$cto :: forall c x. Rep (KESState c) x -> KESState c
$cfrom :: forall c x. KESState c -> Rep (KESState c) x
Generic)

instance Crypto c => NoThunks (KESState c)

mkHotKey ::
     forall m c. (Crypto c, IOLike m)
  => SL.SignKeyKES c
  -> Absolute.KESPeriod  -- ^ Start period
  -> Word64              -- ^ Max KES evolutions
  -> m (HotKey c m)
mkHotKey :: SignKeyKES c -> KESPeriod -> Word64 -> m (HotKey c m)
mkHotKey SignKeyKES c
initKey startPeriod :: KESPeriod
startPeriod@(Absolute.KESPeriod KESEvolution
start) Word64
maxKESEvolutions = do
    StrictMVar m (KESState c)
varKESState <- KESState c -> m (StrictMVar m (KESState c))
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack, NoThunks a) =>
a -> m (StrictMVar m a)
newMVar KESState c
initKESState
    HotKey c m -> m (HotKey c m)
forall (m :: * -> *) a. Monad m => a -> m a
return HotKey :: forall c (m :: * -> *).
(KESPeriod -> m KESEvolutionInfo)
-> m KESInfo
-> m Bool
-> (forall toSign.
    (KESignable c toSign, HasCallStack) =>
    toSign -> m (SignedKES c toSign))
-> HotKey c m
HotKey {
        evolve :: KESPeriod -> m KESEvolutionInfo
evolve     = StrictMVar m (KESState c) -> KESPeriod -> m KESEvolutionInfo
forall (m :: * -> *) c.
(Crypto c, IOLike m) =>
StrictMVar m (KESState c) -> KESPeriod -> m KESEvolutionInfo
evolveKey StrictMVar m (KESState c)
varKESState
      , getInfo :: m KESInfo
getInfo    = KESState c -> KESInfo
forall c. KESState c -> KESInfo
kesStateInfo (KESState c -> KESInfo) -> m (KESState c) -> m KESInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMVar m (KESState c) -> m (KESState c)
forall (m :: * -> *) a. MonadSTM m => StrictMVar m a -> m a
readMVar StrictMVar m (KESState c)
varKESState
      , isPoisoned :: m Bool
isPoisoned = KESKey c -> Bool
forall c. KESKey c -> Bool
kesKeyIsPoisoned (KESKey c -> Bool)
-> (KESState c -> KESKey c) -> KESState c -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KESState c -> KESKey c
forall c. KESState c -> KESKey c
kesStateKey (KESState c -> Bool) -> m (KESState c) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictMVar m (KESState c) -> m (KESState c)
forall (m :: * -> *) a. MonadSTM m => StrictMVar m a -> m a
readMVar StrictMVar m (KESState c)
varKESState
      , sign_ :: forall toSign.
(KESignable c toSign, HasCallStack) =>
toSign -> m (SignedKES c toSign)
sign_      = \toSign
toSign -> do
          KESState { KESInfo
kesStateInfo :: KESInfo
kesStateInfo :: forall c. KESState c -> KESInfo
kesStateInfo, KESKey c
kesStateKey :: KESKey c
kesStateKey :: forall c. KESState c -> KESKey c
kesStateKey } <- StrictMVar m (KESState c) -> m (KESState c)
forall (m :: * -> *) a. MonadSTM m => StrictMVar m a -> m a
readMVar StrictMVar m (KESState c)
varKESState
          case KESKey c
kesStateKey of
            KESKey c
KESKeyPoisoned -> String -> m (SignedKES c toSign)
forall a. HasCallStack => String -> a
error String
"trying to sign with a poisoned key"
            KESKey SignKeyKES c
key     -> do
              let evolution :: KESEvolution
evolution = KESInfo -> KESEvolution
kesEvolution KESInfo
kesStateInfo
                  signed :: SignedKES c toSign
signed    = ContextKES (KES c)
-> KESEvolution -> toSign -> SignKeyKES c -> SignedKES c toSign
forall v a.
(KESAlgorithm v, Signable v a) =>
ContextKES v -> KESEvolution -> a -> SignKeyKES v -> SignedKES v a
SL.signedKES () KESEvolution
evolution toSign
toSign SignKeyKES 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 c toSign -> m (SignedKES c toSign)
forall (m :: * -> *) a. MonadEvaluate m => a -> m a
evaluate SignedKES c toSign
signed
      }
  where
    initKESState :: KESState c
    initKESState :: KESState c
initKESState = KESState :: forall c. KESInfo -> KESKey c -> KESState c
KESState {
        kesStateInfo :: KESInfo
kesStateInfo = KESInfo :: KESPeriod -> KESPeriod -> KESEvolution -> KESInfo
KESInfo {
            kesStartPeriod :: KESPeriod
kesStartPeriod = KESPeriod
startPeriod
          , kesEndPeriod :: KESPeriod
kesEndPeriod   = KESEvolution -> KESPeriod
Absolute.KESPeriod (KESEvolution
start KESEvolution -> KESEvolution -> KESEvolution
forall a. Num a => a -> a -> a
+ Word64 -> KESEvolution
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 :: KESEvolution
kesEvolution   = KESEvolution
0
          }
      , kesStateKey :: KESKey c
kesStateKey = SignKeyKES c -> KESKey c
forall c. SignKeyKES c -> KESKey c
KESKey SignKeyKES 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 :: 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.
(MonadSTM m, MonadCatch m, HasCallStack) =>
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 (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 (m :: * -> *) a. Monad m => a -> m a
return (KESState c
kesState, KESEvolutionError -> KESEvolutionInfo
forall updated failed. failed -> UpdateInfo updated failed
UpdateFailed KESEvolutionError
err)

      KESKey SignKeyKES 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 (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 (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 KESEvolution
targetEvolution
          -- No evolving needed
          | KESEvolution
targetEvolution KESEvolution -> KESEvolution -> Bool
forall a. Ord a => a -> a -> Bool
<= KESInfo -> KESEvolution
kesEvolution KESInfo
info
          -> (KESState c, KESEvolutionInfo) -> m (KESState c, KESEvolutionInfo)
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
<$>
               KESEvolution -> KESInfo -> SignKeyKES c -> m (KESState c)
go KESEvolution
targetEvolution KESInfo
info SignKeyKES c
key

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

    -- | PRECONDITION:
    --
    -- > targetEvolution >= curEvolution
    go :: KESEvolution -> KESInfo -> SL.SignKeyKES c -> m (KESState c)
    go :: KESEvolution -> KESInfo -> SignKeyKES c -> m (KESState c)
go KESEvolution
targetEvolution KESInfo
info SignKeyKES c
key
      | KESEvolution
targetEvolution KESEvolution -> KESEvolution -> Bool
forall a. Ord a => a -> a -> Bool
<= KESEvolution
curEvolution
      = KESState c -> m (KESState c)
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 :: forall c. KESInfo -> KESKey c -> KESState c
KESState { kesStateInfo :: KESInfo
kesStateInfo = KESInfo
info, kesStateKey :: KESKey c
kesStateKey = SignKeyKES c -> KESKey c
forall c. SignKeyKES c -> KESKey c
KESKey SignKeyKES c
key }
      | Bool
otherwise
      = case ContextKES (KES c)
-> SignKeyKES c -> KESEvolution -> Maybe (SignKeyKES c)
forall v.
(KESAlgorithm v, HasCallStack) =>
ContextKES v
-> SignKeyKES v -> KESEvolution -> Maybe (SignKeyKES v)
SL.updateKES () SignKeyKES c
key KESEvolution
curEvolution of
          -- This cannot happen
          Maybe (SignKeyKES c)
Nothing    -> String -> m (KESState c)
forall a. HasCallStack => String -> a
error String
"Could not update KES key"
          Just !SignKeyKES c
key' -> do
            -- Clear the memory associated with the old key
            SignKeyKES c -> m ()
forall (m :: * -> *) v.
(IOLike m, KESAlgorithm v) =>
SignKeyKES v -> m ()
forgetSignKeyKES SignKeyKES c
key
            let info' :: KESInfo
info' = KESInfo
info { kesEvolution :: KESEvolution
kesEvolution = KESEvolution
curEvolution KESEvolution -> KESEvolution -> KESEvolution
forall a. Num a => a -> a -> a
+ KESEvolution
1 }
            KESEvolution -> KESInfo -> SignKeyKES c -> m (KESState c)
go KESEvolution
targetEvolution KESInfo
info' SignKeyKES c
key'
      where
        curEvolution :: KESEvolution
curEvolution = KESInfo -> KESEvolution
kesEvolution KESInfo
info