/
Address.hs
205 lines (171 loc) · 8.69 KB
/
Address.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.CLI.Shelley.Run.Address
( ShelleyAddressCmdError(..)
, SomeAddressVerificationKey(..)
, buildShelleyAddress
, renderShelleyAddressCmdError
, runAddressCmd
, runAddressKeyGenToFile
, makeStakeAddressRef
) where
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Except.Extra (firstExceptT, left, newExceptT)
import qualified Data.ByteString.Char8 as BS
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import Cardano.Api
import Cardano.Api.Shelley
import Cardano.CLI.Shelley.Key (PaymentVerifier (..), StakeVerifier (..),
VerificationKeyTextOrFile, VerificationKeyTextOrFileError (..), generateKeyPair,
readVerificationKeyOrFile, readVerificationKeyTextOrFileAnyOf,
renderVerificationKeyTextOrFileError)
import Cardano.CLI.Shelley.Parsers (AddressCmd (..), AddressKeyType (..), OutputFile (..))
import Cardano.CLI.Shelley.Run.Address.Info (ShelleyAddressInfoError, runAddressInfo)
import Cardano.CLI.Shelley.Run.Read
import Cardano.CLI.Types
data ShelleyAddressCmdError
= ShelleyAddressCmdAddressInfoError !ShelleyAddressInfoError
| ShelleyAddressCmdReadKeyFileError !(FileError InputDecodeError)
| ShelleyAddressCmdReadScriptFileError !(FileError ScriptDecodeError)
| ShelleyAddressCmdVerificationKeyTextOrFileError !VerificationKeyTextOrFileError
| ShelleyAddressCmdWriteFileError !(FileError ())
| ShelleyAddressCmdExpectedPaymentVerificationKey SomeAddressVerificationKey
deriving Show
renderShelleyAddressCmdError :: ShelleyAddressCmdError -> Text
renderShelleyAddressCmdError err =
case err of
ShelleyAddressCmdAddressInfoError addrInfoErr ->
Text.pack (displayError addrInfoErr)
ShelleyAddressCmdReadKeyFileError fileErr ->
Text.pack (displayError fileErr)
ShelleyAddressCmdVerificationKeyTextOrFileError vkTextOrFileErr ->
renderVerificationKeyTextOrFileError vkTextOrFileErr
ShelleyAddressCmdReadScriptFileError fileErr ->
Text.pack (displayError fileErr)
ShelleyAddressCmdWriteFileError fileErr -> Text.pack (displayError fileErr)
ShelleyAddressCmdExpectedPaymentVerificationKey someAddress ->
"Expected payment verification key but got: " <> renderSomeAddressVerificationKey someAddress
runAddressCmd :: AddressCmd -> ExceptT ShelleyAddressCmdError IO ()
runAddressCmd cmd =
case cmd of
AddressKeyGen kt vkf skf -> runAddressKeyGenToFile kt vkf skf
AddressKeyHash vkf mOFp -> runAddressKeyHash vkf mOFp
AddressBuild paymentVerifier mbStakeVerifier nw mOutFp -> runAddressBuild paymentVerifier mbStakeVerifier nw mOutFp
AddressInfo txt mOFp -> firstExceptT ShelleyAddressCmdAddressInfoError $ runAddressInfo txt mOFp
runAddressKeyGenToFile
:: AddressKeyType
-> VerificationKeyFile
-> SigningKeyFile
-> ExceptT ShelleyAddressCmdError IO ()
runAddressKeyGenToFile kt vkf skf = case kt of
AddressKeyShelley -> generateAndWriteKeyFiles AsPaymentKey vkf skf
AddressKeyShelleyExtended -> generateAndWriteKeyFiles AsPaymentExtendedKey vkf skf
AddressKeyByron -> generateAndWriteKeyFiles AsByronKey vkf skf
generateAndWriteKeyFiles
:: Key keyrole
=> AsType keyrole
-> VerificationKeyFile
-> SigningKeyFile
-> ExceptT ShelleyAddressCmdError IO ()
generateAndWriteKeyFiles asType vkf skf = do
uncurry (writePaymentKeyFiles vkf skf) =<< liftIO (generateKeyPair asType)
writePaymentKeyFiles
:: Key keyrole
=> VerificationKeyFile
-> SigningKeyFile
-> VerificationKey keyrole
-> SigningKey keyrole
-> ExceptT ShelleyAddressCmdError IO ()
writePaymentKeyFiles (VerificationKeyFile vkeyPath) (SigningKeyFile skeyPath) vkey skey = do
firstExceptT ShelleyAddressCmdWriteFileError $ do
newExceptT $ writeFileTextEnvelope skeyPath (Just skeyDesc) skey
newExceptT $ writeFileTextEnvelope vkeyPath (Just vkeyDesc) vkey
where
skeyDesc, vkeyDesc :: TextEnvelopeDescr
skeyDesc = "Payment Signing Key"
vkeyDesc = "Payment Verification Key"
runAddressKeyHash :: VerificationKeyTextOrFile
-> Maybe OutputFile
-> ExceptT ShelleyAddressCmdError IO ()
runAddressKeyHash vkeyTextOrFile mOutputFp = do
vkey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $
newExceptT $ readVerificationKeyTextOrFileAnyOf vkeyTextOrFile
let hexKeyHash = foldSomeAddressVerificationKey
(serialiseToRawBytesHex . verificationKeyHash) vkey
case mOutputFp of
Just (OutputFile fpath) -> liftIO $ BS.writeFile fpath hexKeyHash
Nothing -> liftIO $ BS.putStrLn hexKeyHash
runAddressBuild :: PaymentVerifier
-> Maybe StakeVerifier
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyAddressCmdError IO ()
runAddressBuild paymentVerifier mbStakeVerifier nw mOutFp = do
outText <- case paymentVerifier of
PaymentVerifierKey payVkeyTextOrFile -> do
payVKey <- firstExceptT ShelleyAddressCmdVerificationKeyTextOrFileError $
newExceptT $ readVerificationKeyTextOrFileAnyOf payVkeyTextOrFile
addr <- case payVKey of
AByronVerificationKey vk ->
return (AddressByron (makeByronAddress nw vk))
APaymentVerificationKey vk ->
AddressShelley <$> buildShelleyAddress vk mbStakeVerifier nw
APaymentExtendedVerificationKey vk ->
AddressShelley <$> buildShelleyAddress (castVerificationKey vk) mbStakeVerifier nw
AGenesisUTxOVerificationKey vk ->
AddressShelley <$> buildShelleyAddress (castVerificationKey vk) mbStakeVerifier nw
nonPaymentKey ->
left $ ShelleyAddressCmdExpectedPaymentVerificationKey nonPaymentKey
return $ serialiseAddress (addr :: AddressAny)
PaymentVerifierScriptFile (ScriptFile fp) -> do
ScriptInAnyLang _lang script <-
firstExceptT ShelleyAddressCmdReadScriptFileError $
readFileScriptInAnyLang fp
let payCred = PaymentCredentialByScript (hashScript script)
stakeAddressReference <- maybe (return NoStakeAddress) makeStakeAddressRef mbStakeVerifier
return $ serialiseAddress . makeShelleyAddress nw payCred $ stakeAddressReference
case mOutFp of
Just (OutputFile fpath) -> liftIO $ Text.writeFile fpath outText
Nothing -> liftIO $ Text.putStr outText
makeStakeAddressRef
:: StakeVerifier
-> ExceptT ShelleyAddressCmdError IO StakeAddressReference
makeStakeAddressRef stakeVerifier = case stakeVerifier of
StakeVerifierKey stkVkeyOrFile -> do
stakeVKey <- firstExceptT ShelleyAddressCmdReadKeyFileError $
newExceptT $ readVerificationKeyOrFile AsStakeKey stkVkeyOrFile
return . StakeAddressByValue . StakeCredentialByKey . verificationKeyHash $ stakeVKey
StakeVerifierScriptFile (ScriptFile fp) -> do
ScriptInAnyLang _lang script <-
firstExceptT ShelleyAddressCmdReadScriptFileError $
readFileScriptInAnyLang fp
let stakeCred = StakeCredentialByScript (hashScript script)
return (StakeAddressByValue stakeCred)
StakeVerifierAddress stakeAddr ->
pure $ StakeAddressByValue $ stakeAddressCredential stakeAddr
buildShelleyAddress
:: VerificationKey PaymentKey
-> Maybe StakeVerifier
-> NetworkId
-> ExceptT ShelleyAddressCmdError IO (Address ShelleyAddr)
buildShelleyAddress vkey mbStakeVerifier nw =
makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash vkey)) <$> maybe (return NoStakeAddress) makeStakeAddressRef mbStakeVerifier
--
-- Handling the variety of address key types
--
foldSomeAddressVerificationKey :: (forall keyrole. Key keyrole =>
VerificationKey keyrole -> a)
-> SomeAddressVerificationKey -> a
foldSomeAddressVerificationKey f (AByronVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (APaymentVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (APaymentExtendedVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (AGenesisUTxOVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (AKesVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (AGenesisDelegateExtendedVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (AGenesisExtendedVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (AVrfVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (AStakeVerificationKey vk) = f vk
foldSomeAddressVerificationKey f (AStakeExtendedVerificationKey vk) = f vk