never executed always true always false
1 {-# LANGUAGE DataKinds #-}
2 {-# LANGUAGE DerivingStrategies #-}
3 {-# LANGUAGE FlexibleContexts #-}
4 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
5 {-# LANGUAGE OverloadedStrings #-}
6 {-# LANGUAGE TypeApplications #-}
7
8 {-# OPTIONS_HADDOCK hide #-}
9
10 module Options.Applicative.Derivation
11 (
12 -- * Derivation Path
13 -- ** Type
14 DerivationPath
15 , castDerivationPath
16 , derivationPathToString
17 , derivationPathFromString
18 -- ** Applicative Parser
19 , derivationPathArg
20
21 -- * Derivation Index
22 , DerivationIndex
23 , mkDerivationIndex
24 , firstHardened
25 , indexToInteger
26 , derivationIndexToString
27 , derivationIndexFromString
28
29 -- * XPub / Pub / XPrv / KeyHash
30 , xpubReader
31 , xpubOpt
32 , xpubArg
33 , keyhashReader
34 , pubReader
35
36 -- * Internal
37 , bech32Reader
38 ) where
39
40 import Prelude
41
42 import Cardano.Address.Derivation
43 ( DerivationType (..)
44 , Index
45 , Pub
46 , XPub
47 , pubFromBytes
48 , wholeDomainIndex
49 , xpubFromBytes
50 )
51 import Cardano.Address.Script
52 ( KeyHash (..), KeyRole (..), keyHashFromBytes )
53 import Codec.Binary.Bech32
54 ( HumanReadablePart, humanReadablePartToText )
55 import Codec.Binary.Encoding
56 ( fromBech32 )
57 import Control.Arrow
58 ( left )
59 import Control.Monad
60 ( unless )
61 import Data.ByteString
62 ( ByteString )
63 import Data.List
64 ( intercalate, isSuffixOf )
65 import Data.Word
66 ( Word32 )
67 import Options.Applicative
68 ( Parser
69 , argument
70 , completer
71 , eitherReader
72 , help
73 , listCompleter
74 , long
75 , metavar
76 , option
77 )
78 import Safe
79 ( readEitherSafe )
80 import System.IO.Extra
81 ( markCharsRedAtIndices )
82
83 import qualified Data.Text as T
84 import qualified Data.Text.Encoding as T
85
86
87 --
88 -- Derivation Path
89 --
90
91 -- | Represent a user-provided 'DerivationPath'.
92 newtype DerivationPath = DerivationPath [DerivationIndex]
93 deriving (Show, Eq)
94
95 derivationPathFromString :: String -> Either String DerivationPath
96 derivationPathFromString str =
97 DerivationPath
98 <$> mapM (derivationIndexFromString . T.unpack) (T.splitOn "/" txt)
99 where
100 txt = T.pack str
101
102 derivationPathToString :: DerivationPath -> String
103 derivationPathToString (DerivationPath xs) =
104 intercalate "/" $ map derivationIndexToString xs
105
106 castDerivationPath :: DerivationPath -> [Index 'WholeDomain depth]
107 castDerivationPath (DerivationPath xs) = map (wholeDomainIndex . getDerivationIndex) xs
108
109 derivationPathArg :: Parser DerivationPath
110 derivationPathArg = argument (eitherReader derivationPathFromString) $ mempty
111 <> metavar "DERIVATION-PATH"
112 <> help
113 "Slash-separated derivation path. Hardened indexes are marked with a \
114 \'H' (e.g. 1852H/1815H/0H/0)."
115 <> completer (listCompleter ["1852H/1815H/0H/", "44H/1815H/0H/"])
116
117 --
118 -- Derivation Index
119 --
120
121 newtype DerivationIndex = DerivationIndex { getDerivationIndex :: Word32 }
122 deriving stock (Show, Eq)
123 deriving newtype (Bounded, Ord)
124
125 -- | Safely cast a 'DerivationIndex' to an 'Integer'.
126 indexToInteger :: DerivationIndex -> Integer
127 indexToInteger (DerivationIndex ix) = fromIntegral ix
128
129 -- | Get the first 'DerivationIndex' considered /hardened/.
130 firstHardened :: DerivationIndex
131 firstHardened = DerivationIndex 0x80000000
132
133 -- | Smart-constructor for a 'DerivationIndex'
134 mkDerivationIndex :: Integer -> Either String DerivationIndex
135 mkDerivationIndex ix
136 | ix > fromIntegral (maxBound @Word32) =
137 Left $ show ix <> " is too high to be a derivation index."
138 | otherwise =
139 pure $ DerivationIndex $ fromIntegral ix
140
141 -- | Convert a string to a derivation index. String must be followed by a
142 -- capital /H/ to mark hardened index. For example @0@ refers to the first soft
143 -- index, whereas @0H@ refers to the first hardened index.
144 derivationIndexFromString :: String -> Either String DerivationIndex
145 derivationIndexFromString "" = Left "An empty string is not a derivation index!"
146 derivationIndexFromString str
147 | "H" `isSuffixOf` str = do
148 parseHardenedIndex (init str)
149 | otherwise = do
150 parseSoftIndex str
151 where
152 parseHardenedIndex txt = do
153 ix <- left (const msg) $ readEitherSafe txt
154 mkDerivationIndex $ ix + indexToInteger firstHardened
155 where
156 msg = mconcat
157 [ "Unable to parse hardened index. Hardened indexes are integer "
158 , "values, between "
159 , show (indexToInteger (minBound @DerivationIndex))
160 , " and "
161 , show (indexToInteger firstHardened)
162 , " ending with a capital 'H'. For example: \"42H\","
163 ]
164
165 parseSoftIndex txt = do
166 ix <- left (const msg) $ readEitherSafe txt
167 guardSoftIndex ix
168 mkDerivationIndex ix
169 where
170 guardSoftIndex ix
171 | ix >= indexToInteger firstHardened =
172 Left $ mconcat
173 [ show ix
174 , " is too high to be a soft derivation index. "
175 , "Did you mean \""
176 , show (ix - indexToInteger firstHardened)
177 , "H\"?"
178 ]
179 | otherwise =
180 pure ()
181
182 msg = mconcat
183 [ "Unable to parse soft index. Soft indexes are integer "
184 , "values, between "
185 , show (indexToInteger (minBound @DerivationIndex))
186 , " and "
187 , show (indexToInteger firstHardened)
188 , ". For example: \"14\"."
189 ]
190
191 -- | Convert a 'DerivationIndex' back to string.
192 derivationIndexToString :: DerivationIndex -> String
193 derivationIndexToString ix_@(DerivationIndex ix)
194 | ix_ >= firstHardened = show ix' ++ "H"
195 | otherwise = show ix
196 where
197 ix' = fromIntegral ix - indexToInteger firstHardened
198
199 --
200 -- XPub / Pub / XPrv
201 --
202
203 xpubReader :: [HumanReadablePart] -> String -> Either String XPub
204 xpubReader allowedPrefixes str = do
205 (_hrp, bytes) <- bech32Reader allowedPrefixes str
206 case xpubFromBytes bytes of
207 Just xpub -> pure xpub
208 Nothing -> Left
209 "Failed to convert bytes into a valid extended public key."
210
211 pubReader :: [HumanReadablePart] -> String -> Either String Pub
212 pubReader allowedPrefixes str = do
213 (_hrp, bytes) <- bech32Reader allowedPrefixes str
214 case pubFromBytes bytes of
215 Just pub -> pure pub
216 Nothing -> Left
217 "Failed to convert bytes into a valid non-extended public key."
218
219 xpubOpt :: [HumanReadablePart] -> String -> String -> Parser XPub
220 xpubOpt allowedPrefixes name helpDoc =
221 option (eitherReader (xpubReader allowedPrefixes)) $ mempty
222 <> long name
223 <> metavar "XPUB"
224 <> help helpDoc
225
226 xpubArg :: [HumanReadablePart] -> String -> Parser XPub
227 xpubArg allowedPrefixes helpDoc =
228 argument (eitherReader (xpubReader allowedPrefixes)) $ mempty
229 <> metavar "XPUB"
230 <> help helpDoc
231
232 keyhashReader :: (KeyRole, [HumanReadablePart]) -> String -> Either String KeyHash
233 keyhashReader (keyrole, allowedPrefixes) str = do
234 (_hrp, bytes) <- bech32Reader allowedPrefixes str
235 case keyHashFromBytes (keyrole, bytes) of
236 Just keyhash -> pure keyhash
237 Nothing -> Left
238 "Failed to convert bytes into a valid public key hash."
239
240 --
241 -- Internal
242 --
243
244 bech32Reader
245 :: [HumanReadablePart]
246 -> String
247 -> Either String (HumanReadablePart, ByteString)
248 bech32Reader allowedPrefixes str = do
249 (hrp, bytes) <- fromBech32 markCharsRedAtIndices (toBytes str)
250 unless (hrp `elem` allowedPrefixes) $ Left
251 $ "Invalid human-readable prefix. Prefix ought to be one of: "
252 <> show (showHrp <$> allowedPrefixes)
253 pure (hrp, bytes)
254 where
255 showHrp :: HumanReadablePart -> String
256 showHrp = T.unpack . humanReadablePartToText
257
258 toBytes :: String -> ByteString
259 toBytes = T.encodeUtf8 . T.pack