content: {-# LANGUAGE NamedFieldPuns #-}
  {-# LANGUAGE Rank2Types     #-}
  
  -- | VSS certificates and secrets related stuff.
  
  module Pos.Client.CLI.Secrets
         ( prepareUserSecret
         ) where
  
  import           Universum
  
  import           Control.Lens (ix)
  import           Crypto.Random (MonadRandom)
  
  import           Pos.Chain.Genesis (GeneratedSecrets (..), RichSecrets (..))
  import           Pos.Crypto (SecretKey, VssKeyPair, keyGen, runSecureRandom,
                       vssKeyGen)
  import           Pos.Util.Trace (Trace, traceWith)
  import           Pos.Util.UserSecret (UserSecret, usPrimKey, usVss,
                       writeUserSecret)
  
  import           Pos.Client.CLI.NodeOptions (CommonNodeArgs (..))
  
  -- | This function prepares 'UserSecret' for later usage by node. It
  -- ensures that primary key and VSS key are present in
  -- 'UserSecret'. They are either taken from generated secrets or
  -- generated by this function using secure source of randomness.
  prepareUserSecret
      :: (MonadIO m)
      => Trace m Text
      -> CommonNodeArgs
      -> Maybe GeneratedSecrets
      -> UserSecret
      -> m (SecretKey, UserSecret)
  prepareUserSecret logTrace CommonNodeArgs {devGenesisSecretI} mGeneratedSecrets userSecret = do
      (_, userSecretWithVss) <-
          fillUserSecretVSS logTrace (rsVssKeyPair <$> predefinedRichKeys) userSecret
      fillPrimaryKey logTrace (rsPrimaryKey <$> predefinedRichKeys) userSecretWithVss
    where
      predefinedRichKeys :: Maybe RichSecrets
      predefinedRichKeys = do
          i <- devGenesisSecretI
          case mGeneratedSecrets of
              Nothing -> error
                  $  "devGenesisSecretI is specified, but GeneratedSecrets are "
                  <> "missing from Genesis.Config. GenesisInitializer might be "
                  <> "incorrectly specified."
              Just generatedSecrets -> gsRichSecrets generatedSecrets ^? ix i
  
  -- Make sure UserSecret contains a primary key.
  fillPrimaryKey ::
         (MonadIO m)
      => Trace m Text
      -> Maybe SecretKey
      -> UserSecret
      -> m (SecretKey, UserSecret)
  fillPrimaryKey logTrace = fillUserSecretPart logTrace (snd <$> keyGen) usPrimKey "signing key"
  
  -- Make sure UserSecret contains a VSS key.
  fillUserSecretVSS ::
         (MonadIO m)
      => Trace m Text
      -> Maybe VssKeyPair
      -> UserSecret
      -> m (VssKeyPair, UserSecret)
  fillUserSecretVSS logTrace = fillUserSecretPart logTrace vssKeyGen usVss "VSS keypair"
  
  -- Make sure UserSecret contains something.
  fillUserSecretPart ::
         (MonadIO m)
      => Trace m Text
      -> (forall n. MonadRandom n =>
                        n a)
      -> (Lens' UserSecret (Maybe a))
      -> Text
      -> Maybe a
      -> UserSecret
      -> m (a, UserSecret)
  fillUserSecretPart logTrace genValue l description desiredValue userSecret = do
      toSet <- getValueToSet
      let newUS = userSecret & l .~ Just toSet
      (toSet, newUS) <$ writeUserSecret newUS
    where
      getValueToSet
          | Just desired <- desiredValue = pure desired
          | Just existing <- userSecret ^. l = pure existing
          | otherwise = do
              traceWith logTrace $
                  "Found no " <> description <>
                  " in keyfile, generating random one..."
              liftIO (runSecureRandom genValue)
  