never executed always true always false
    1 {-# LANGUAGE FlexibleContexts #-}
    2 {-# LANGUAGE LambdaCase #-}
    3 {-# LANGUAGE NamedFieldPuns #-}
    4 {-# LANGUAGE OverloadedStrings #-}
    5 
    6 {-# OPTIONS_HADDOCK hide #-}
    7 
    8 module Command.Key.FromRecoveryPhrase
    9     ( Cmd (..)
   10     , mod
   11     , run
   12     ) where
   13 
   14 import Prelude hiding
   15     ( mod )
   16 
   17 import Cardano.Address.Derivation
   18     ( xprvToBytes )
   19 import Codec.Binary.Bech32
   20     ( HumanReadablePart )
   21 import Codec.Binary.Encoding
   22     ( AbstractEncoding (..) )
   23 import Options.Applicative
   24     ( CommandFields
   25     , Mod
   26     , command
   27     , footerDoc
   28     , helper
   29     , info
   30     , optional
   31     , progDesc
   32     )
   33 import Options.Applicative.Help.Pretty
   34     ( bold, indent, string, vsep )
   35 import Options.Applicative.Style
   36     ( Passphrase (..)
   37     , PassphraseInfo (..)
   38     , PassphraseInput (..)
   39     , PassphraseInputMode
   40     , Style (..)
   41     , fileOpt
   42     , generateRootKey
   43     , passphraseInfoOpt
   44     , passphraseInputModeOpt
   45     , styleArg
   46     )
   47 import System.IO
   48     ( stderr, stdin, stdout )
   49 import System.IO.Extra
   50     ( hGetPassphraseBytes
   51     , hGetPassphraseMnemonic
   52     , hGetSomeMnemonic
   53     , hGetSomeMnemonicInteractively
   54     , hPutBytes
   55     , progName
   56     )
   57 
   58 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
   59 
   60 
   61 data Cmd = FromRecoveryPhrase
   62     { style :: Style
   63     , passphraseInfo :: Maybe PassphraseInfo
   64     , passphraseInputMode :: PassphraseInputMode
   65     , passphraseFromFile :: Maybe FilePath
   66     } deriving (Show)
   67 
   68 mod :: (Cmd -> parent) -> Mod CommandFields parent
   69 mod liftCmd = command "from-recovery-phrase" $
   70     info (helper <*> fmap liftCmd parser) $ mempty
   71         <> progDesc "Convert a recovery phrase to an extended private key"
   72         <> footerDoc (Just $ vsep
   73             [ string "The recovery phrase without passphrase is read from stdin."
   74             , string ""
   75             , string "Example:"
   76             , indent 2 $ bold $ string $ "$ "<>progName<>" recovery-phrase generate \\"
   77             , indent 2 $ bold $ string $ "| "<>progName<>" key from-recovery-phrase Icarus"
   78             , string ""
   79             , string "The recovery phrase with passphrase can be entered interactively or from file."
   80             , string "In both cases passhrase can take form of mnemonic, base16, base64, utf8 or octet array."
   81             , string "In interactive case one can select explicit, sensitive or silent mode."
   82             , string ""
   83             , string "Example:"
   84             , indent 2 $ bold $ string $ "$ "<>progName<>" key from-recovery-phrase Shelley --passphrase from-mnemonic --sensitive"
   85             , indent 2 $ bold $ string "Please enter a [9, 12, 15, 18, 21, 24] word mnemonic:"
   86             , indent 2 $ bold $ string "**********************************************************************************************************"
   87             , indent 2 $ bold $ string "Please enter a 9–12 word second factor:"
   88             , indent 2 $ bold $ string "*************************************************************"
   89             , string ""
   90             , string "In case of passphrase reading from file the recovery phrase is read from stdin."
   91             , string ""
   92             , string "Example:"
   93             , indent 2 $ bold $ string "$ echo \"Secret Secondary Phrase\" > sndfactor.prv"
   94             , indent 2 $ bold $ string $ "$ "<>progName<>" recovery-phrase generate \\"
   95             , indent 2 $ bold $ string $ "| "<>progName<>" key from-recovery-phrase Shelley --from-file \"./sndfactor.prv\""
   96             , string ""
   97             , indent 2 $ bold $ string $ "$ "<>progName<>" recovery-phrase generate --size 12 > sndfactor.prv"
   98             , indent 2 $ bold $ string $ "$ "<>progName<>" recovery-phrase generate \\"
   99             , indent 2 $ bold $ string $ "| "<>progName<>" key from-recovery-phrase Shelley --passphrase from-mnemonic --from-file \"./sndfactor.prv\""
  100             ])
  101   where
  102     parser = FromRecoveryPhrase
  103         <$> styleArg
  104         <*> optional passphraseInfoOpt
  105         <*> passphraseInputModeOpt
  106         <*> optional fileOpt
  107 
  108 run :: Cmd -> IO ()
  109 run FromRecoveryPhrase{style,passphraseInfo, passphraseInputMode,passphraseFromFile} = do
  110     (someMnemonic, passphrase) <- case passphraseInfo of
  111         Nothing -> do
  112             mnemonic <- hGetSomeMnemonic stdin
  113             pure (mnemonic, Nothing)
  114         Just pinfo -> do
  115             mnemonic <- case passphraseFromFile of
  116                 Nothing -> do
  117                     let prompt = "Please enter a [9, 12, 15, 18, 21, 24] word mnemonic:"
  118                     hGetSomeMnemonicInteractively (stdin, stderr)
  119                         passphraseInputMode prompt
  120                 Just _ ->
  121                     hGetSomeMnemonic stdin
  122             let passphraseSrc =
  123                     maybe Interactive FromFile passphraseFromFile
  124             passwd <- handlePassphraseInfo passphraseSrc pinfo
  125             pure (mnemonic, Just passwd)
  126     rootK <- generateRootKey someMnemonic passphrase style
  127     hPutBytes stdout (xprvToBytes rootK) (EBech32 $ styleHrp style)
  128   where
  129     handlePassphraseInfo passphraseSrc = \case
  130         Mnemonic -> do
  131             let prompt = "Please enter a 9–12 word second factor:"
  132             p <- hGetPassphraseMnemonic (stdin, stderr)
  133                  passphraseInputMode passphraseSrc prompt
  134             pure $ FromMnemonic p
  135         Hex -> do
  136             let prompt = "Please enter hex-encoded passphrase:"
  137             p <- hGetPassphraseBytes (stdin, stderr)
  138                  passphraseInputMode passphraseSrc prompt Hex
  139             pure $ FromEncoded p
  140         Base64 -> do
  141             let prompt = "Please enter base64-encoded passphrase:"
  142             p <- hGetPassphraseBytes (stdin, stderr)
  143                  passphraseInputMode passphraseSrc prompt Base64
  144             pure $ FromEncoded p
  145         Utf8 -> do
  146             let prompt = "Please enter utf8-encoded passphrase:"
  147             p <- hGetPassphraseBytes (stdin, stderr)
  148                  passphraseInputMode passphraseSrc prompt Utf8
  149             pure $ FromEncoded p
  150         Octets -> do
  151             let prompt = "Please enter passphrase in the form of octet array:"
  152             p <- hGetPassphraseBytes (stdin, stderr)
  153                  passphraseInputMode passphraseSrc prompt Octets
  154             pure $ FromEncoded p
  155 
  156 styleHrp :: Style -> HumanReadablePart
  157 styleHrp Shared = CIP5.root_shared_xsk
  158 styleHrp _ = CIP5.root_xsk