1
+ {-# LANGUAGE LambdaCase #-}
2
+
1
3
module Cardano.CLI.Shelley.Run.StakeAddress
2
4
( ShelleyStakeAddressCmdError (ShelleyStakeAddressCmdReadKeyFileError )
3
5
, renderShelleyStakeAddressCmdError
@@ -88,50 +90,23 @@ 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 <- getStakeAddressFromVerifier 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 <- getStakeCredentialFromVerifier stakeVerifier
108
+ writeRegistrationCert stakeCred
109
+
135
110
where
136
111
writeRegistrationCert
137
112
:: StakeCredential
@@ -159,19 +134,9 @@ runStakeCredentialDelegationCert stakeVerifier poolVKeyOrHashOrFile (OutputFile
159
134
firstExceptT
160
135
ShelleyStakeAddressCmdReadKeyFileError
161
136
(newExceptT $ readVerificationKeyOrHashOrFile AsStakePoolKey poolVKeyOrHashOrFile)
137
+ stakeCred <- getStakeCredentialFromVerifier 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 <- getStakeCredentialFromVerifier stakeVerifier
161
+ writeDeregistrationCert stakeCred
162
+
207
163
where
208
164
writeDeregistrationCert
209
165
:: StakeCredential
@@ -216,3 +172,31 @@ runStakeCredentialDeRegistrationCert stakeVerifier (OutputFile oFp) =
216
172
217
173
deregCertDesc :: TextEnvelopeDescr
218
174
deregCertDesc = " Stake Address Deregistration Certificate"
175
+
176
+
177
+ getStakeCredentialFromVerifier
178
+ :: StakeVerifier -> ExceptT ShelleyStakeAddressCmdError IO StakeCredential
179
+ getStakeCredentialFromVerifier = \ case
180
+ StakeVerifierScriptFile (ScriptFile sFile) -> do
181
+ ScriptInAnyLang _ script <-
182
+ firstExceptT ShelleyStakeAddressCmdReadScriptFileError $
183
+ readFileScriptInAnyLang sFile
184
+ pure $ StakeCredentialByScript $ hashScript script
185
+
186
+ StakeVerifierKey stakeVerKeyOrFile -> do
187
+ stakeVerKey <-
188
+ firstExceptT ShelleyStakeAddressCmdReadKeyFileError
189
+ . newExceptT
190
+ $ readVerificationKeyOrFile AsStakeKey stakeVerKeyOrFile
191
+ pure $ StakeCredentialByKey $ verificationKeyHash stakeVerKey
192
+
193
+ StakeVerifierAddress stakeAddr -> pure $ stakeAddressCredential stakeAddr
194
+
195
+ getStakeAddressFromVerifier
196
+ :: NetworkId
197
+ -> StakeVerifier
198
+ -> ExceptT ShelleyStakeAddressCmdError IO StakeAddress
199
+ getStakeAddressFromVerifier networkId = \ case
200
+ StakeVerifierAddress stakeAddr -> pure stakeAddr
201
+ stakeVerifier ->
202
+ makeStakeAddress networkId <$> getStakeCredentialFromVerifier stakeVerifier
0 commit comments