never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE FlexibleContexts #-}
3 {-# LANGUAGE LambdaCase #-}
4 {-# LANGUAGE TypeApplications #-}
5
6 {-# OPTIONS_HADDOCK hide #-}
7 {-# OPTIONS_GHC -fno-warn-deprecations #-}
8
9 module Options.Applicative.Style
10 (
11 -- * Type
12 Style(..)
13 , Passphrase (..)
14 , PassphraseInfo (..)
15 , PassphraseInputMode (..)
16 , PassphraseInput (..)
17 , generateRootKey
18
19 -- * Applicative Parser
20 , styleArg
21 , passphraseInfoOpt
22 , passphraseInputModeOpt
23 , fileOpt
24 ) where
25
26 import Prelude
27
28 import Cardano.Address.Derivation
29 ( XPrv )
30 import Cardano.Mnemonic
31 ( SomeMnemonic, someMnemonicToBytes )
32 import Control.Applicative
33 ( (<|>) )
34 import Data.ByteArray
35 ( ScrubbedBytes )
36 import Data.ByteString
37 ( ByteString )
38 import Data.Char
39 ( toLower )
40 import Data.List
41 ( intercalate )
42 import Options.Applicative
43 ( Parser
44 , argument
45 , completer
46 , eitherReader
47 , flag'
48 , help
49 , listCompleter
50 , long
51 , metavar
52 , option
53 )
54
55 import qualified Cardano.Address.Style.Byron as Byron
56 import qualified Cardano.Address.Style.Icarus as Icarus
57 import qualified Cardano.Address.Style.Shared as Shared
58 import qualified Cardano.Address.Style.Shelley as Shelley
59 import qualified Data.ByteArray as BA
60
61 --
62 -- Type
63 --
64
65 -- | Represent a style of wallet.
66 data Style
67 = Byron
68 | Icarus
69 | Shelley
70 | Shared
71 deriving (Eq, Show, Enum, Bounded)
72
73 -- | User chosen passphrase for the generation phase
74 --
75 -- @since 3.13.0
76 data Passphrase =
77 FromMnemonic SomeMnemonic | FromEncoded ByteString
78 deriving (Eq, Show)
79
80 data PassphraseInfo =
81 Mnemonic | Hex | Base64 | Utf8 | Octets
82 deriving (Eq, Show)
83
84 data PassphraseInputMode =
85 Sensitive | Silent | Explicit
86 deriving (Eq, Show)
87
88 data PassphraseInput =
89 Interactive | FromFile FilePath
90 deriving (Eq, Show)
91
92 toSndFactor :: Maybe Passphrase -> ScrubbedBytes
93 toSndFactor = \case
94 Nothing -> mempty
95 Just (FromMnemonic mnemonic) -> someMnemonicToBytes mnemonic
96 Just (FromEncoded bs) -> BA.convert bs
97
98 -- | Generate an extended root private key from a mnemonic sentence, in the
99 -- given style.
100 generateRootKey :: SomeMnemonic -> Maybe Passphrase -> Style -> IO XPrv
101 generateRootKey mw passwd = \case
102 Byron -> do
103 let rootK = Byron.genMasterKeyFromMnemonic mw
104 pure $ Byron.getKey rootK
105 Icarus -> do
106 let sndFactor = toSndFactor passwd
107 let rootK = Icarus.genMasterKeyFromMnemonic mw sndFactor
108 pure $ Icarus.getKey rootK
109 Shelley -> do
110 let sndFactor = toSndFactor passwd
111 let rootK = Shelley.genMasterKeyFromMnemonic mw sndFactor
112 pure $ Shelley.getKey rootK
113 Shared -> do
114 let sndFactor = toSndFactor passwd
115 let rootK = Shared.genMasterKeyFromMnemonic mw sndFactor
116 pure $ Shared.getKey rootK
117
118 --
119 -- Applicative Parser
120 --
121
122 -- | Parse a 'Style' from the command-line, as an argument.
123 styleArg :: Parser Style
124 styleArg = argument (eitherReader reader) $ mempty
125 <> metavar "STYLE"
126 <> help styles'
127 <> completer (listCompleter styles)
128 where
129 styles :: [String]
130 styles = show @Style <$> [minBound .. maxBound]
131
132 styles' = intercalate " | " styles
133
134 reader :: String -> Either String Style
135 reader str = case toLower <$> str of
136 "byron" -> Right Byron
137 "icarus" -> Right Icarus
138 "shelley" -> Right Shelley
139 "shared" -> Right Shared
140 _ -> Left $ "Unknown style; expecting one of " <> styles'
141
142 passphraseInfoReader :: String -> Either String PassphraseInfo
143 passphraseInfoReader s = maybe (Left err) Right (readPassphraseInfoMaybe s)
144 where
145 err = "Invalid passphrase input type. Must be one of the \
146 \allowed keywords: from-mnemonic, from-hex, from-base64, from-octets or from-utf8."
147 readPassphraseInfoMaybe str
148 | str == mempty = pure Utf8
149 | str == "from-mnemonic" = pure Mnemonic
150 | str == "from-hex" = pure Hex
151 | str == "from-base64" = pure Base64
152 | str == "from-utf8" = pure Utf8
153 | str == "from-octets" = pure Octets
154 | otherwise = Nothing
155
156 passphraseInfoOpt :: Parser PassphraseInfo
157 passphraseInfoOpt = option (eitherReader passphraseInfoReader) $ mempty
158 <> long "passphrase"
159 <> metavar "FORMAT"
160 <> help helpDoc
161 where
162 helpDoc =
163 "(from-mnemonic | from-hex | from-base64 | from-utf8 | from-octets) " ++
164 "User chosen passphrase to be read from stdin for the generation phase. " ++
165 "Valid for Icarus, Shelley and Shared styles. Accepting mnemonic " ++
166 "(9- or 12 words) or arbitrary passphrase encoded as base16, base64, plain utf8 " ++
167 "or raw bytes in the form of octet array."
168
169 -- | Parse an 'PassphraseInputMode' from the command-line, if there is proper flag then sensitive is set.
170 passphraseInputModeOpt :: Parser PassphraseInputMode
171 passphraseInputModeOpt = sensitive <|> silent <|> pure Explicit
172 where
173 sensitive = flag' Sensitive (long "sensitive" <> help ("Input is shown as * in interactive mode."))
174 silent = flag' Silent (long "silent" <> help ("Input is not shown in interactive mode."))
175
176 fileOpt :: Parser FilePath
177 fileOpt = option (eitherReader Right) $ mempty
178 <> long "from-file"
179 <> metavar "FILE"
180 <> help ("Passphrase from specified filepath.")