never executed always true always false
1 {-# LANGUAGE FlexibleContexts #-}
2 {-# LANGUAGE LambdaCase #-}
3 {-# LANGUAGE NamedFieldPuns #-}
4 {-# LANGUAGE OverloadedStrings #-}
5 {-# LANGUAGE TupleSections #-}
6
7 {-# OPTIONS_HADDOCK hide #-}
8
9 module Command.Key.Child
10 ( Cmd (..)
11 , mod
12 , run
13 ) where
14
15 import Prelude hiding
16 ( mod )
17
18 import Cardano.Address.Derivation
19 ( DerivationScheme (..)
20 , deriveXPrv
21 , deriveXPub
22 , indexToWord32
23 , xprvToBytes
24 , xpubToBytes
25 )
26 import Codec.Binary.Encoding
27 ( AbstractEncoding (..) )
28 import Control.Monad
29 ( foldM )
30 import Data.Functor.Identity
31 ( Identity (..) )
32 import Options.Applicative
33 ( CommandFields, Mod, command, footerDoc, helper, info, progDesc )
34 import Options.Applicative.Derivation
35 ( DerivationPath, castDerivationPath, derivationPathArg )
36 import Options.Applicative.Help.Pretty
37 ( string )
38 import System.IO
39 ( stdin, stdout )
40 import System.IO.Extra
41 ( hGetXP__, hPutBytes )
42
43 import qualified Cardano.Codec.Bech32.Prefixes as CIP5
44
45 newtype Cmd = Child
46 { path :: DerivationPath
47 } deriving (Show)
48
49 mod :: (Cmd -> parent) -> Mod CommandFields parent
50 mod liftCmd = command "child" $
51 info (helper <*> fmap liftCmd parser) $ mempty
52 <> progDesc "Derive child keys from a parent public/private key"
53 <> footerDoc (Just $ string $ mconcat
54 [ "The parent key is read from stdin."
55 ])
56 where
57 parser = Child
58 <$> derivationPathArg
59
60 run :: Cmd -> IO ()
61 run Child{path} = do
62 (hrp, child) <- hGetXP__ stdin allowedPrefixes >>= \case
63 Left (hrp, xpub) -> do
64 let ixs = castDerivationPath path
65 case foldM (deriveXPub DerivationScheme2) xpub ixs of
66 Just child ->
67 (,xpubToBytes child) <$> childHrpFor (indexToWord32 <$> ixs) hrp
68 Nothing ->
69 fail
70 "Couldn't derive child key. If you're trying to derive \
71 \children on a PUBLIC key, you must use soft indexes only."
72
73 Right (hrp, xprv) -> do
74 let ixs = castDerivationPath path
75 let scheme = if length ixs == 2 && hrp == CIP5.root_xsk
76 then DerivationScheme1
77 else DerivationScheme2
78 let Identity child = foldM (\k -> pure . deriveXPrv scheme k) xprv ixs
79 (,xprvToBytes child) <$> childHrpFor (indexToWord32 <$> ixs) hrp
80
81 hPutBytes stdout child (EBech32 hrp)
82 where
83 allowedPrefixes =
84 [ CIP5.root_xsk
85 , CIP5.acct_xsk
86 , CIP5.acct_xvk
87 , CIP5.root_shared_xsk
88 , CIP5.acct_shared_xsk
89 , CIP5.acct_shared_xvk
90 ]
91
92 -- As a reminder, we really have two scenarios:
93 --
94 -- Byron Legacy:
95 --
96 -- m / rnd_account' / rnd_address'
97 --
98 --
99 -- Icarus & Shelley:
100 --
101 -- m / purpose' / coin_type' / account' / role / index
102 --
103 -- We do not allow derivations to anywhere in the path to avoid people
104 -- shooting themselves in the foot.
105 -- Hence We only allow the following transformations:
106 --
107 -- root_xsk => addr_xsk: (legacy)
108 -- m => m / rnd_account' / rnd_address
109 --
110 -- root_xsk => acct_xsk: (hard derivation from root to account)
111 -- m => m / purpose' / coin_type' / account'
112 --
113 -- root_xsk => acct_xsk: (hard derivation from root to address)
114 -- m => m / purpose' / coin_type' / account' / role / index
115 --
116 -- purpose' = 1852H for shelley wallet addresses.
117 -- purpose' = 1854H for shelley wallet addresses that expose shared account.
118 --
119 -- acct_xsk => addr_xsk: (hard derivation from account to address)
120 -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index
121 --
122 -- acct_xvk => addr_xvk: (soft derivation from account to address)
123 -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index
124 --
125 --
126
127 -- Shared:
128 --
129 -- m / purpose' / coin_type' / account' / role / index
130 --
131 -- purpose' = 1854H for shared wallet addresses.
132 --
133 -- As with Icarus/Shelley sequential wallets, to prevent undiscoverable
134 -- addresses, we allow only the following transformations:
135 --
136 -- shared_root_xsk => shared_acct_xsk: (hard derivation from root to account)
137 -- m => m / purpose' / coin_type' / account'
138 --
139 -- shared_root_xsk => shared_acct_xsk: (hard derivation from root to address)
140 -- m => m / purpose' / coin_type' / account' / role / index
141 --
142 -- shared_acct_xsk => shared_addr_xsk: (hard derivation from account to address)
143 -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index
144 --
145 -- shared_acct_xvk => shared_addr_xvk: (soft derivation from account to address)
146 -- m / purpose' / coin_type' / account' => m / purpose' / coin_type' / account' / role / index
147 --
148 --
149 -- There's no use-case at the moment for accessing intermediate paths such
150 -- as m / purpose' or m / purpose' / coin_type' so we do not expose them.
151 childHrpFor [_,_,_,2,_] hrp
152 | hrp == CIP5.root_xsk = pure CIP5.stake_xsk
153 | hrp == CIP5.root_shared_xsk = pure CIP5.stake_shared_xsk
154
155 childHrpFor [p,_,_,_,_] hrp
156 | hrp == CIP5.root_xsk =
157 -- 2147485502 stands for 1854H
158 if p == 2147485502 then
159 pure CIP5.addr_shared_xsk
160 else
161 pure CIP5.addr_xsk
162 | hrp == CIP5.root_shared_xsk = pure CIP5.addr_shared_xsk
163
164 childHrpFor [p,_,_] hrp
165 | hrp == CIP5.root_xsk =
166 -- 2147485502 stands for 1854H
167 if p == 2147485502 then
168 pure CIP5.acct_shared_xsk
169 -- 2147485503 stands for 1855H
170 else if p == 2147485503 then
171 pure CIP5.policy_xsk
172 else
173 pure CIP5.acct_xsk
174 | hrp == CIP5.root_shared_xsk = pure CIP5.acct_shared_xsk
175
176 childHrpFor [2,_] hrp
177 | hrp == CIP5.acct_xsk = pure CIP5.stake_xsk
178 | hrp == CIP5.acct_xvk = pure CIP5.stake_xvk
179 | hrp == CIP5.acct_shared_xsk = pure CIP5.stake_shared_xsk
180 | hrp == CIP5.acct_shared_xvk = pure CIP5.stake_shared_xvk
181
182 childHrpFor [_,_] hrp
183 | hrp == CIP5.root_xsk = pure CIP5.addr_xsk
184 | hrp == CIP5.acct_xsk = pure CIP5.addr_xsk
185 | hrp == CIP5.acct_xvk = pure CIP5.addr_xvk
186 | hrp == CIP5.acct_shared_xsk = pure CIP5.addr_shared_xsk
187 | hrp == CIP5.acct_shared_xvk = pure CIP5.addr_shared_xvk
188
189 childHrpFor _ hrp
190 | hrp == CIP5.root_xsk = fail
191 "When deriving child keys from a parent root key, you must \
192 \provide either 2, 3 or 5 path segments. Provide 2 (account and \
193 \address) if you intend to derive a legacy Byron key. Provide 3 or 5 \
194 \(purpose, coin_type, account, role, index) if you're dealing with \
195 \anything else."
196
197 | hrp == CIP5.root_shared_xsk = fail
198 "When deriving child keys from a parent root key, you must \
199 \provide either 3 or 5 path segments. Provide 3 \
200 \(purpose, coin_type, account) or 5 \
201 \(purpose, coin_type, account, role, index)."
202
203 | otherwise = fail
204 "When deriving child keys from a parent account key, you must \
205 \provide exactly two path segments (role & index)."