1
+ {-# LANGUAGE LambdaCase #-}
2
+
1
3
module Cardano.CLI.Shelley.Run.StakeAddress
2
4
( ShelleyStakeAddressCmdError (ShelleyStakeAddressCmdReadKeyFileError )
3
5
, renderShelleyStakeAddressCmdError
@@ -88,51 +90,24 @@ runStakeAddressBuild
88
90
-> NetworkId
89
91
-> Maybe OutputFile
90
92
-> ExceptT ShelleyStakeAddressCmdError IO ()
91
- runStakeAddressBuild stakeVerifier network mOutputFp =
92
- case stakeVerifier of
93
- StakeVerifierScriptFile (ScriptFile sFile) -> do
94
- ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
95
- $ readFileScriptInAnyLang sFile
96
- let stakeCred = StakeCredentialByScript $ hashScript script
97
- stakeAddr = makeStakeAddress network stakeCred
98
- stakeAddrText = serialiseAddress stakeAddr
99
-
100
- case mOutputFp of
101
- Just (OutputFile fpath) -> liftIO $ Text. writeFile fpath stakeAddrText
102
- Nothing -> liftIO $ Text. putStrLn stakeAddrText
103
-
104
- StakeVerifierKey stakeVerKeyOrFile -> do
105
- stakeVerKey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
106
- . newExceptT
107
- $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
108
-
109
- let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVerKey)
110
- stakeAddr = makeStakeAddress network stakeCred
111
- stakeAddrText = serialiseAddress stakeAddr
112
-
113
- case mOutputFp of
114
- Just (OutputFile fpath) -> liftIO $ Text. writeFile fpath stakeAddrText
115
- Nothing -> liftIO $ Text. putStrLn stakeAddrText
93
+ runStakeAddressBuild stakeVerifier network mOutputFp = do
94
+ stakeAddr <- loadStakeAddressFromVerifier network stakeVerifier
95
+ let stakeAddrText = serialiseAddress stakeAddr
96
+ liftIO $
97
+ case mOutputFp of
98
+ Just (OutputFile fpath) -> Text. writeFile fpath stakeAddrText
99
+ Nothing -> Text. putStrLn stakeAddrText
116
100
117
101
118
102
runStakeCredentialRegistrationCert
119
103
:: StakeVerifier
120
104
-> OutputFile
121
105
-> ExceptT ShelleyStakeAddressCmdError IO ()
122
- runStakeCredentialRegistrationCert stakeVerifier (OutputFile oFp) =
123
- case stakeVerifier of
124
- StakeVerifierScriptFile (ScriptFile sFile) -> do
125
- ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
126
- $ readFileScriptInAnyLang sFile
127
- let stakeCred = StakeCredentialByScript $ hashScript script
128
- writeRegistrationCert stakeCred
129
- StakeVerifierKey stakeVerKeyOrFile -> do
130
- stakeVerKey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
131
- . newExceptT
132
- $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
133
- let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVerKey)
134
- writeRegistrationCert stakeCred
106
+ runStakeCredentialRegistrationCert stakeVerifier (OutputFile oFp) = do
107
+ stakeCred <- loadStakeCredentialFromVerifier stakeVerifier
108
+ writeRegistrationCert stakeCred
135
109
where
110
+
136
111
writeRegistrationCert
137
112
:: StakeCredential
138
113
-> ExceptT ShelleyStakeAddressCmdError IO ()
@@ -159,19 +134,9 @@ runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile
159
134
firstExceptT
160
135
ShelleyStakeAddressCmdReadKeyFileError
161
136
(newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
137
+ stakeCred <- loadStakeCredentialFromVerifier stakeVerifier
138
+ writeDelegationCert stakeCred poolStakeVKeyHash
162
139
163
- case stakeVerifier of
164
- StakeVerifierScriptFile (ScriptFile sFile) -> do
165
- ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
166
- $ readFileScriptInAnyLang sFile
167
- let stakeCred = StakeCredentialByScript $ hashScript script
168
- writeDelegationCert stakeCred poolStakeVKeyHash
169
- StakeVerifierKey stakeVerKeyOrFile -> do
170
- stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
171
- . newExceptT
172
- $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
173
- let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVkey)
174
- writeDelegationCert stakeCred poolStakeVKeyHash
175
140
where
176
141
writeDelegationCert
177
142
:: StakeCredential
@@ -191,19 +156,10 @@ runStakeCredentialDeRegistrationCert
191
156
:: StakeVerifier
192
157
-> OutputFile
193
158
-> ExceptT ShelleyStakeAddressCmdError IO ()
194
- runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) =
195
- case stakeVerifier of
196
- StakeVerifierScriptFile (ScriptFile sFile) -> do
197
- ScriptInAnyLang _ script <- firstExceptT ShelleyStakeAddressCmdReadScriptFileError
198
- $ readFileScriptInAnyLang sFile
199
- let stakeCred = StakeCredentialByScript $ hashScript script
200
- writeDeregistrationCert stakeCred
201
- StakeVerifierKey stakeVerKeyOrFile -> do
202
- stakeVkey <- firstExceptT ShelleyStakeAddressCmdReadKeyFileError
203
- . newExceptT
204
- $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
205
- let stakeCred = StakeCredentialByKey (verificationKeyHash stakeVkey)
206
- writeDeregistrationCert stakeCred
159
+ runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) = do
160
+ stakeCred <- loadStakeCredentialFromVerifier stakeVerifier
161
+ writeDeregistrationCert stakeCred
162
+
207
163
where
208
164
writeDeregistrationCert
209
165
:: StakeCredential
@@ -216,3 +172,44 @@ runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) =
216
172
217
173
deregCertDesc :: TextEnvelopeDescr
218
174
deregCertDesc = " Stake Address Deregistration Certificate"
175
+
176
+
177
+ loadStakeCredentialFromVerifier
178
+ :: StakeVerifier -> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
179
+ loadStakeCredentialFromVerifier stakeVerifier =
180
+ either stakeAddressCredential identity <$> loadStakeVerifier stakeVerifier
181
+
182
+ loadStakeAddressFromVerifier
183
+ :: NetworkId
184
+ -> StakeVerifier
185
+ -> ExceptT ShelleyStakeAddressCmdError IO StakeAddress
186
+ loadStakeAddressFromVerifier network stakeVerifier =
187
+ either identity (makeStakeAddress network) <$> loadStakeVerifier stakeVerifier
188
+
189
+ -- | Load 'StakeAddress' or 'StakeCredential' from 'StakeVerifier',
190
+ -- which one is closer.
191
+ --
192
+ -- For internal use in 'loadStakeCredentialFromVerifier' and
193
+ -- 'loadStakeAddressFromVerifier' only
194
+ loadStakeVerifier
195
+ :: StakeVerifier
196
+ -> ExceptT
197
+ ShelleyStakeAddressCmdError
198
+ IO
199
+ (Either StakeAddress StakeCredential )
200
+ loadStakeVerifier = \ case
201
+
202
+ StakeVerifierScriptFile (ScriptFile sFile) -> do
203
+ ScriptInAnyLang _ script <-
204
+ firstExceptT ShelleyStakeAddressCmdReadScriptFileError $
205
+ readFileScriptInAnyLang sFile
206
+ pure $ Right $ StakeCredentialByScript $ hashScript script
207
+
208
+ StakeVerifierKey stakeVerKeyOrFile -> do
209
+ stakeVerKey <-
210
+ firstExceptT ShelleyStakeAddressCmdReadKeyFileError
211
+ . newExceptT
212
+ $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
213
+ pure $ Right $ StakeCredentialByKey $ verificationKeyHash stakeVerKey
214
+
215
+ StakeVerifierAddress stakeAddr -> pure $ Left stakeAddr
0 commit comments