{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}

module Cardano.CLI.Run.Mnemonic (generateMnemonic, extendedSigningKeyFromMnemonicImpl) where

import Cardano.Api
  ( AsType
      ( AsCommitteeColdExtendedKey
      , AsCommitteeHotExtendedKey
      , AsDRepExtendedKey
      , AsPaymentExtendedKey
      , AsStakeExtendedKey
      )
  , ExceptT
  , File
  , FileDirection (Out)
  , HasTextEnvelope
  , Key (SigningKey)
  , MnemonicSize (..)
  , MnemonicToSigningKeyError
  , MonadIO (..)
  , SerialiseAsBech32
  , except
  , findMnemonicWordsWithPrefix
  , firstExceptT
  , left
  , newExceptT
  , readTextFile
  , serialiseToBech32
  , signingKeyFromMnemonic
  , signingKeyFromMnemonicWithPaymentKeyIndex
  , textEnvelopeToJSON
  , writeLazyByteStringFile
  , writeTextFile
  )
import Cardano.Api qualified as Api

import Cardano.CLI.EraIndependent.Key.Command qualified as Cmd
import Cardano.CLI.Type.Common (KeyOutputFormat (..), SigningKeyFile)
import Cardano.CLI.Type.Error.KeyCmdError
  ( KeyCmdError
      ( KeyCmdMnemonicError
      , KeyCmdReadMnemonicFileError
      , KeyCmdWriteFileError
      , KeyCmdWrongNumOfMnemonics
      )
  )
import Cardano.Prelude (isSpace)

import Control.Monad (when)
import Data.Bifunctor (Bifunctor (..))
import Data.Text (Text)
import Data.Text qualified as T
import Data.Word (Word32)
import System.Console.Haskeline
  ( Completion
  , InputT
  , Settings (..)
  , completeWord'
  , defaultBehavior
  , defaultPrefs
  , getInputLineWithInitial
  , runInputTBehaviorWithPrefs
  , simpleCompletion
  )
import System.Console.Haskeline.Completion (CompletionFunc)

-- | Generate a mnemonic and write it to a file or stdout.
generateMnemonic
  :: MonadIO m
  => MnemonicSize
  -- ^ The number of words in the mnemonic.
  -> Maybe (File () Out)
  -- ^ The file to write the mnemonic to. If 'Nothing', write to stdout.
  -> ExceptT KeyCmdError m ()
generateMnemonic :: forall (m :: * -> *).
MonadIO m =>
MnemonicSize -> Maybe (File () 'Out) -> ExceptT KeyCmdError m ()
generateMnemonic MnemonicSize
mnemonicWords Maybe (File () 'Out)
mnemonicOutputFormat = do
  [Text]
mnemonic <- (MnemonicToSigningKeyError -> KeyCmdError)
-> ExceptT MnemonicToSigningKeyError m [Text]
-> ExceptT KeyCmdError m [Text]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT MnemonicToSigningKeyError -> KeyCmdError
KeyCmdMnemonicError (ExceptT MnemonicToSigningKeyError m [Text]
 -> ExceptT KeyCmdError m [Text])
-> ExceptT MnemonicToSigningKeyError m [Text]
-> ExceptT KeyCmdError m [Text]
forall a b. (a -> b) -> a -> b
$ MnemonicSize -> ExceptT MnemonicToSigningKeyError m [Text]
forall (m :: * -> *). MonadIO m => MnemonicSize -> m [Text]
Api.generateMnemonic MnemonicSize
mnemonicWords
  let expectedNumOfMnemonicWords :: Int
expectedNumOfMnemonicWords = MnemonicSize -> Int
mnemonicSizeToInt MnemonicSize
mnemonicWords
      obtainedNumOfMnemonicWords :: Int
obtainedNumOfMnemonicWords = [Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
mnemonic
  Bool -> ExceptT KeyCmdError m () -> ExceptT KeyCmdError m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
obtainedNumOfMnemonicWords Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expectedNumOfMnemonicWords) (ExceptT KeyCmdError m () -> ExceptT KeyCmdError m ())
-> ExceptT KeyCmdError m () -> ExceptT KeyCmdError m ()
forall a b. (a -> b) -> a -> b
$
    KeyCmdError -> ExceptT KeyCmdError m ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (KeyCmdError -> ExceptT KeyCmdError m ())
-> KeyCmdError -> ExceptT KeyCmdError m ()
forall a b. (a -> b) -> a -> b
$
      Int -> Int -> KeyCmdError
KeyCmdWrongNumOfMnemonics Int
expectedNumOfMnemonicWords Int
obtainedNumOfMnemonicWords
  case Maybe (File () 'Out)
mnemonicOutputFormat of
    Just File () 'Out
outFile ->
      (FileError () -> KeyCmdError)
-> ExceptT (FileError ()) m () -> ExceptT KeyCmdError m ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> KeyCmdError
KeyCmdWriteFileError (ExceptT (FileError ()) m () -> ExceptT KeyCmdError m ())
-> (m (Either (FileError ()) ()) -> ExceptT (FileError ()) m ())
-> m (Either (FileError ()) ())
-> ExceptT KeyCmdError m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Either (FileError ()) ()) -> ExceptT (FileError ()) m ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (m (Either (FileError ()) ()) -> ExceptT KeyCmdError m ())
-> m (Either (FileError ()) ()) -> ExceptT KeyCmdError m ()
forall a b. (a -> b) -> a -> b
$
        File () 'Out -> Text -> m (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile File () 'Out
outFile ([Text] -> Text
T.unwords [Text]
mnemonic)
    Maybe (File () 'Out)
Nothing -> IO () -> ExceptT KeyCmdError m ()
forall a. IO a -> ExceptT KeyCmdError m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT KeyCmdError m ())
-> IO () -> ExceptT KeyCmdError m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack ([Text] -> Text
T.unwords [Text]
mnemonic)
 where
  mnemonicSizeToInt :: MnemonicSize -> Int
  mnemonicSizeToInt :: MnemonicSize -> Int
mnemonicSizeToInt MnemonicSize
MS12 = Int
12
  mnemonicSizeToInt MnemonicSize
MS15 = Int
15
  mnemonicSizeToInt MnemonicSize
MS18 = Int
18
  mnemonicSizeToInt MnemonicSize
MS21 = Int
21
  mnemonicSizeToInt MnemonicSize
MS24 = Int
24

-- | Derive an extended signing key from a mnemonic and write it to a file.
extendedSigningKeyFromMnemonicImpl
  :: KeyOutputFormat
  -- ^ The format in which to write the signing key.
  -> Cmd.ExtendedSigningType
  -- ^ The type of the extended signing key to derive with an optional payment key index.
  -> Word32
  -- ^ The account index.
  -> Cmd.MnemonicSource
  -- ^ The source of the mnemonic (either file or stdin).
  -> SigningKeyFile Out
  -- ^ The file to write the signing key to.
  -> ExceptT KeyCmdError IO ()
extendedSigningKeyFromMnemonicImpl :: KeyOutputFormat
-> ExtendedSigningType
-> Word32
-> MnemonicSource
-> SigningKeyFile 'Out
-> ExceptT KeyCmdError IO ()
extendedSigningKeyFromMnemonicImpl KeyOutputFormat
keyOutputFormat ExtendedSigningType
derivedExtendedSigningKeyType Word32
derivationAccountNo MnemonicSource
mnemonicSource SigningKeyFile 'Out
signingKeyFileOut =
  do
    let writeKeyToFile
          :: (HasTextEnvelope (SigningKey a), SerialiseAsBech32 (SigningKey a))
          => SigningKey a -> ExceptT KeyCmdError IO ()
        writeKeyToFile :: forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
SigningKey a -> ExceptT KeyCmdError IO ()
writeKeyToFile = KeyOutputFormat
-> SigningKeyFile 'Out -> SigningKey a -> ExceptT KeyCmdError IO ()
forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
KeyOutputFormat
-> SigningKeyFile 'Out -> SigningKey a -> ExceptT KeyCmdError IO ()
writeSigningKeyFile KeyOutputFormat
keyOutputFormat SigningKeyFile 'Out
signingKeyFileOut

        wrapException :: Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a
        wrapException :: forall a.
Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a
wrapException = Either KeyCmdError a -> ExceptT KeyCmdError IO a
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either KeyCmdError a -> ExceptT KeyCmdError IO a)
-> (Either MnemonicToSigningKeyError a -> Either KeyCmdError a)
-> Either MnemonicToSigningKeyError a
-> ExceptT KeyCmdError IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MnemonicToSigningKeyError -> KeyCmdError)
-> Either MnemonicToSigningKeyError a -> Either KeyCmdError a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first MnemonicToSigningKeyError -> KeyCmdError
KeyCmdMnemonicError

    [Text]
mnemonicWords <- MnemonicSource -> ExceptT KeyCmdError IO [Text]
readMnemonic MnemonicSource
mnemonicSource

    case ExtendedSigningType
derivedExtendedSigningKeyType of
      Cmd.ExtendedSigningPaymentKey Word32
paymentKeyNo ->
        SigningKey PaymentExtendedKey -> ExceptT KeyCmdError IO ()
forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
SigningKey a -> ExceptT KeyCmdError IO ()
writeKeyToFile
          (SigningKey PaymentExtendedKey -> ExceptT KeyCmdError IO ())
-> ExceptT KeyCmdError IO (SigningKey PaymentExtendedKey)
-> ExceptT KeyCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either MnemonicToSigningKeyError (SigningKey PaymentExtendedKey)
-> ExceptT KeyCmdError IO (SigningKey PaymentExtendedKey)
forall a.
Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a
wrapException
            ( AsType PaymentExtendedKey
-> [Text]
-> Word32
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey PaymentExtendedKey)
forall keyrole.
IndexedSigningKeyFromRootKey keyrole =>
AsType keyrole
-> [Text]
-> Word32
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithPaymentKeyIndex
                AsType PaymentExtendedKey
AsPaymentExtendedKey
                [Text]
mnemonicWords
                Word32
derivationAccountNo
                Word32
paymentKeyNo
            )
      Cmd.ExtendedSigningStakeKey Word32
paymentKeyNo ->
        SigningKey StakeExtendedKey -> ExceptT KeyCmdError IO ()
forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
SigningKey a -> ExceptT KeyCmdError IO ()
writeKeyToFile
          (SigningKey StakeExtendedKey -> ExceptT KeyCmdError IO ())
-> ExceptT KeyCmdError IO (SigningKey StakeExtendedKey)
-> ExceptT KeyCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either MnemonicToSigningKeyError (SigningKey StakeExtendedKey)
-> ExceptT KeyCmdError IO (SigningKey StakeExtendedKey)
forall a.
Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a
wrapException
            ( AsType StakeExtendedKey
-> [Text]
-> Word32
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey StakeExtendedKey)
forall keyrole.
IndexedSigningKeyFromRootKey keyrole =>
AsType keyrole
-> [Text]
-> Word32
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonicWithPaymentKeyIndex
                AsType StakeExtendedKey
AsStakeExtendedKey
                [Text]
mnemonicWords
                Word32
derivationAccountNo
                Word32
paymentKeyNo
            )
      ExtendedSigningType
Cmd.ExtendedSigningDRepKey ->
        SigningKey DRepExtendedKey -> ExceptT KeyCmdError IO ()
forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
SigningKey a -> ExceptT KeyCmdError IO ()
writeKeyToFile
          (SigningKey DRepExtendedKey -> ExceptT KeyCmdError IO ())
-> ExceptT KeyCmdError IO (SigningKey DRepExtendedKey)
-> ExceptT KeyCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either MnemonicToSigningKeyError (SigningKey DRepExtendedKey)
-> ExceptT KeyCmdError IO (SigningKey DRepExtendedKey)
forall a.
Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a
wrapException (AsType DRepExtendedKey
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey DRepExtendedKey)
forall keyrole.
SigningKeyFromRootKey keyrole =>
AsType keyrole
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonic AsType DRepExtendedKey
AsDRepExtendedKey [Text]
mnemonicWords Word32
derivationAccountNo)
      ExtendedSigningType
Cmd.ExtendedSigningCCColdKey ->
        SigningKey CommitteeColdExtendedKey -> ExceptT KeyCmdError IO ()
forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
SigningKey a -> ExceptT KeyCmdError IO ()
writeKeyToFile
          (SigningKey CommitteeColdExtendedKey -> ExceptT KeyCmdError IO ())
-> ExceptT KeyCmdError IO (SigningKey CommitteeColdExtendedKey)
-> ExceptT KeyCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either
  MnemonicToSigningKeyError (SigningKey CommitteeColdExtendedKey)
-> ExceptT KeyCmdError IO (SigningKey CommitteeColdExtendedKey)
forall a.
Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a
wrapException
            (AsType CommitteeColdExtendedKey
-> [Text]
-> Word32
-> Either
     MnemonicToSigningKeyError (SigningKey CommitteeColdExtendedKey)
forall keyrole.
SigningKeyFromRootKey keyrole =>
AsType keyrole
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonic AsType CommitteeColdExtendedKey
AsCommitteeColdExtendedKey [Text]
mnemonicWords Word32
derivationAccountNo)
      ExtendedSigningType
Cmd.ExtendedSigningCCHotKey ->
        SigningKey CommitteeHotExtendedKey -> ExceptT KeyCmdError IO ()
forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
SigningKey a -> ExceptT KeyCmdError IO ()
writeKeyToFile
          (SigningKey CommitteeHotExtendedKey -> ExceptT KeyCmdError IO ())
-> ExceptT KeyCmdError IO (SigningKey CommitteeHotExtendedKey)
-> ExceptT KeyCmdError IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Either
  MnemonicToSigningKeyError (SigningKey CommitteeHotExtendedKey)
-> ExceptT KeyCmdError IO (SigningKey CommitteeHotExtendedKey)
forall a.
Either MnemonicToSigningKeyError a -> ExceptT KeyCmdError IO a
wrapException
            (AsType CommitteeHotExtendedKey
-> [Text]
-> Word32
-> Either
     MnemonicToSigningKeyError (SigningKey CommitteeHotExtendedKey)
forall keyrole.
SigningKeyFromRootKey keyrole =>
AsType keyrole
-> [Text]
-> Word32
-> Either MnemonicToSigningKeyError (SigningKey keyrole)
signingKeyFromMnemonic AsType CommitteeHotExtendedKey
AsCommitteeHotExtendedKey [Text]
mnemonicWords Word32
derivationAccountNo)
 where
  writeSigningKeyFile
    :: (HasTextEnvelope (SigningKey a), SerialiseAsBech32 (SigningKey a))
    => KeyOutputFormat -> SigningKeyFile Out -> SigningKey a -> ExceptT KeyCmdError IO ()
  writeSigningKeyFile :: forall a.
(HasTextEnvelope (SigningKey a),
 SerialiseAsBech32 (SigningKey a)) =>
KeyOutputFormat
-> SigningKeyFile 'Out -> SigningKey a -> ExceptT KeyCmdError IO ()
writeSigningKeyFile KeyOutputFormat
fmt SigningKeyFile 'Out
sKeyPath SigningKey a
skey =
    (FileError () -> KeyCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT KeyCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> KeyCmdError
KeyCmdWriteFileError (ExceptT (FileError ()) IO () -> ExceptT KeyCmdError IO ())
-> ExceptT (FileError ()) IO () -> ExceptT KeyCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      case KeyOutputFormat
fmt of
        KeyOutputFormat
KeyOutputFormatTextEnvelope ->
          IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
            SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
sKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
              Maybe TextEnvelopeDescr -> SigningKey a -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing SigningKey a
skey
        KeyOutputFormat
KeyOutputFormatBech32 ->
          IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$
            SigningKeyFile 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile SigningKeyFile 'Out
sKeyPath (Text -> IO (Either (FileError ()) ()))
-> Text -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
              SigningKey a -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey a
skey

  readMnemonic :: Cmd.MnemonicSource -> ExceptT KeyCmdError IO [Text]
  readMnemonic :: MnemonicSource -> ExceptT KeyCmdError IO [Text]
readMnemonic (Cmd.MnemonicFromFile File () 'In
filePath) = do
    Text
fileText <- (FileError () -> KeyCmdError)
-> ExceptT (FileError ()) IO Text -> ExceptT KeyCmdError IO Text
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> KeyCmdError
KeyCmdReadMnemonicFileError (ExceptT (FileError ()) IO Text -> ExceptT KeyCmdError IO Text)
-> ExceptT (FileError ()) IO Text -> ExceptT KeyCmdError IO Text
forall a b. (a -> b) -> a -> b
$ Either (FileError ()) Text -> ExceptT (FileError ()) IO Text
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either (FileError ()) Text -> ExceptT (FileError ()) IO Text)
-> ExceptT (FileError ()) IO (Either (FileError ()) Text)
-> ExceptT (FileError ()) IO Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< File () 'In
-> ExceptT (FileError ()) IO (Either (FileError ()) Text)
forall (m :: * -> *) content e.
MonadIO m =>
File content 'In -> m (Either (FileError e) Text)
readTextFile File () 'In
filePath
    [Text] -> ExceptT KeyCmdError IO [Text]
forall a. a -> ExceptT KeyCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> ExceptT KeyCmdError IO [Text])
-> [Text] -> ExceptT KeyCmdError IO [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
fileText
  readMnemonic MnemonicSource
Cmd.MnemonicFromInteractivePrompt =
    IO [Text] -> ExceptT KeyCmdError IO [Text]
forall a. IO a -> ExceptT KeyCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> ExceptT KeyCmdError IO [Text])
-> IO [Text] -> ExceptT KeyCmdError IO [Text]
forall a b. (a -> b) -> a -> b
$ do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
        [String] -> String
unlines
          [ String
""
          , String
"Please enter your mnemonic sentence."
          , String
""
          , String
" - It should consist of either: 12, 15, 18, 21, or 24 words."
          , String
" - To terminate, press enter on an empty line."
          , String
" - To abort you can press CTRL+C."
          , String
""
          , String
"(If your terminal supports it, you can use the TAB key for word completion.)"
          , String
""
          ]
      Behavior -> Prefs -> Settings IO -> InputT IO [Text] -> IO [Text]
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Behavior -> Prefs -> Settings m -> InputT m a -> m a
runInputTBehaviorWithPrefs Behavior
defaultBehavior Prefs
defaultPrefs Settings IO
forall (m :: * -> *). Monad m => Settings m
settings ((String, String) -> [Text] -> InputT IO [Text]
inputT (String
"", String
"") [])
   where
    settings :: Monad m => Settings m
    settings :: forall (m :: * -> *). Monad m => Settings m
settings =
      Settings
        { complete :: CompletionFunc m
complete = CompletionFunc m
forall (m :: * -> *). Monad m => CompletionFunc m
completionFunc
        , historyFile :: Maybe String
historyFile = Maybe String
forall a. Maybe a
Nothing
        , autoAddHistory :: Bool
autoAddHistory = Bool
False
        }

    completionFunc :: Monad m => CompletionFunc m
    completionFunc :: forall (m :: * -> *). Monad m => CompletionFunc m
completionFunc = Maybe Char
-> (Char -> Bool) -> (String -> m [Completion]) -> CompletionFunc m
forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool) -> (String -> m [Completion]) -> CompletionFunc m
completeWord' Maybe Char
forall a. Maybe a
Nothing Char -> Bool
isSpace String -> m [Completion]
forall (m :: * -> *). Monad m => String -> m [Completion]
completeMnemonicWord

    completeMnemonicWord :: Monad m => String -> m [Completion]
    completeMnemonicWord :: forall (m :: * -> *). Monad m => String -> m [Completion]
completeMnemonicWord String
prefix = [Completion] -> m [Completion]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Completion] -> m [Completion]) -> [Completion] -> m [Completion]
forall a b. (a -> b) -> a -> b
$ ((Text, Int) -> Completion) -> [(Text, Int)] -> [Completion]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Completion
simpleCompletion (String -> Completion)
-> ((Text, Int) -> String) -> (Text, Int) -> Completion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> ((Text, Int) -> Text) -> (Text, Int) -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Int) -> Text
forall a b. (a, b) -> a
fst) ([(Text, Int)] -> [Completion]) -> [(Text, Int)] -> [Completion]
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, Int)]
findMnemonicWordsWithPrefix (String -> Text
T.pack String
prefix)

    inputT :: (String, String) -> [Text] -> InputT IO [Text]
    inputT :: (String, String) -> [Text] -> InputT IO [Text]
inputT (String, String)
prefill [Text]
mnemonic = do
      Maybe String
minput <- String -> (String, String) -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> (String, String) -> InputT m (Maybe String)
getInputLineWithInitial (Int -> String
forall a. Show a => a -> String
show ([Text] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Text]
mnemonic Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". ") (String, String)
prefill
      case Maybe String
minput of
        Maybe String
Nothing -> [Text] -> InputT IO [Text]
forall a. a -> InputT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> InputT IO [Text]) -> [Text] -> InputT IO [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
mnemonic
        Just String
"" -> [Text] -> InputT IO [Text]
forall a. a -> InputT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> InputT IO [Text]) -> [Text] -> InputT IO [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
mnemonic
        Just String
input ->
          let newWords :: [Text]
newWords = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Text
T.toLower (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack) ([String] -> [Text]) -> [String] -> [Text]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
words String
input
           in case (Text -> Bool) -> [Text] -> ([Text], [Text])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Text -> Bool
isValidMnemonicWord [Text]
newWords of
                ([Text]
allWords, []) -> (String, String) -> [Text] -> InputT IO [Text]
inputT (String
"", String
"") ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
allWords [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
mnemonic)
                ([Text]
validWords, Text
invalidWord : [Text]
notValidatedWords) -> do
                  IO () -> InputT IO ()
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> InputT IO ()) -> IO () -> InputT IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"The word \"" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
invalidWord String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\" is not in the memonic dictionary"
                  let textBeforeCursor :: String
textBeforeCursor = [String] -> String
unwords ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
validWords [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [Text -> String
T.unpack Text
invalidWord])
                      textAfterCursor :: String
textAfterCursor =
                        if [Text] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
notValidatedWords
                          then String
""
                          else Char
' ' Char -> String -> String
forall a. a -> [a] -> [a]
: [String] -> String
unwords ((Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [Text]
notValidatedWords)
                  (String, String) -> [Text] -> InputT IO [Text]
inputT (String
textBeforeCursor, String
textAfterCursor) [Text]
mnemonic

    isValidMnemonicWord :: Text -> Bool
    isValidMnemonicWord :: Text -> Bool
isValidMnemonicWord Text
word = Text
word Text -> [Text] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ((Text, Int) -> Text) -> [(Text, Int)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Int) -> Text
forall a b. (a, b) -> a
fst (Text -> [(Text, Int)]
findMnemonicWordsWithPrefix Text
word)