Skip to content

Commit f9afaad

Browse files
cootcoot
committed
cardano-cli stake-pool registration
Validate address information passed through: * --single-host-pool-relay, --pool-relay-port * --multip-host-pool-relay with `cardano-diffusion:ping`.
1 parent 0d47ae9 commit f9afaad

4 files changed

Lines changed: 91 additions & 3 deletions

File tree

‎cabal.project‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -161,8 +161,8 @@ source-repository-package
161161
source-repository-package
162162
type: git
163163
location: https://github.com/IntersectMBO/ouroboros-network.git
164-
tag: 613f8a13cc1c11b2568a627d6eb900058e355d30
165-
--sha256: sha256-G5oVYskwZTc0EeFlQHE41xIjmFhMYV7VmX48kNGuc/c=
164+
tag: b7ff21d2f0d2599065ab7b48fec2da4a043d1d37
165+
--sha256: sha256-+3i85sYyTeEWexUWJhfQvORzdhtO4AtFrGOCApkLnu8=
166166
subdir:
167167
./cardano-diffusion
168168
./monoidal-synchronisation

‎cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs‎

Lines changed: 49 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,13 +6,18 @@
66

77
module Cardano.CLI.Compatible.StakePool.Run
88
( runCompatibleStakePoolCmds
9+
, stakePoolRelayToAddr
910
)
1011
where
1112

13+
import Control.Tracer (nullTracer, (>$<))
14+
import Data.IP (IP (..))
15+
import Data.ByteString.Char8 qualified as BSC
16+
1217
import Cardano.Api
1318
import Cardano.Api.Compatible.Certificate
1419
import Cardano.Api.Experimental qualified as Exp
15-
import Cardano.Api.Experimental.Certificate (StakePoolParameters (..), toShelleyPoolParams)
20+
import Cardano.Api.Experimental.Certificate (StakePoolParameters (..), StakePoolRelay (..), toShelleyPoolParams)
1621

1722
import Cardano.CLI.Compatible.Exception
1823
import Cardano.CLI.Compatible.StakePool.Command
@@ -24,6 +29,8 @@ import Cardano.CLI.Type.Common
2429
import Cardano.CLI.Type.Error.StakePoolCmdError
2530
import Cardano.CLI.Type.Key (readVerificationKeyOrFile)
2631

32+
import Cardano.Network.Ping qualified as Ping
33+
2734
import Control.Monad
2835

2936
runCompatibleStakePoolCmds
@@ -53,6 +60,32 @@ runStakePoolRegistrationCertificateCmd
5360
, outFile
5461
} =
5562
shelleyBasedEraConstraints sbe $ do
63+
64+
let pingOpts =
65+
Ping.PingOpts {
66+
Ping.pingOptsCount = 1,
67+
Ping.pingOptsMagic = toNetworkMagic network,
68+
Ping.pingOptsJson = Ping.AsText,
69+
Ping.pingOptsQuiet = True,
70+
Ping.pingOptsSRVPrefix = "_cardano._tcp",
71+
Ping.pingOptsColor = Ping.ColorNever,
72+
Ping.pingOptsMode = Ping.TipMode
73+
}
74+
pingErrs <- liftIO $ do
75+
stderr <- Ping.mkStdErrTracer
76+
headerTracer <- Ping.mkHeaderTracer pingOpts stderr
77+
Ping.pingClients'
78+
(Ping.format Ping.AsText >$< stderr)
79+
nullTracer
80+
headerTracer
81+
(Ping.toText >$< stderr)
82+
pingOpts
83+
Ping.AddressIsNotAFilePath
84+
(concatMap stakePoolRelayToAddr relays)
85+
86+
unless (null pingErrs) $
87+
throwCliError (StakePoolCmdRelayPingErrors pingErrs)
88+
5689
-- Pool verification key
5790
stakePoolVerKey <- getVerificationKeyFromStakePoolVerificationKeySource poolVerificationKeyOrFile
5891
let stakePoolId' = anyStakePoolVerificationKeyHash stakePoolVerKey
@@ -100,3 +133,18 @@ runStakePoolRegistrationCertificateCmd
100133
where
101134
registrationCertDesc :: TextEnvelopeDescr
102135
registrationCertDesc = "Stake Pool Registration Certificate"
136+
137+
138+
stakePoolRelayToAddr
139+
:: StakePoolRelay
140+
-> [Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved)]
141+
stakePoolRelayToAddr (StakePoolRelayIp (Just ipv4) Nothing (Just port)) = [Ping.IP (IPv4 ipv4) (fromIntegral port)]
142+
stakePoolRelayToAddr (StakePoolRelayIp Nothing (Just ipv6) (Just port)) = [Ping.IP (IPv6 ipv6) (fromIntegral port)]
143+
stakePoolRelayToAddr (StakePoolRelayIp (Just ipv4) (Just ipv6) (Just port)) = [Ping.IP (IPv6 ipv6) (fromIntegral port), Ping.IP (IPv4 ipv4) (fromIntegral port)]
144+
-- the pSingHostAddress parser always includes a port number
145+
stakePoolRelayToAddr (StakePoolRelayIp _ _ Nothing) = error "unexpected happend"
146+
-- the pSingHostAddress parser always includes at least one ip address
147+
stakePoolRelayToAddr (StakePoolRelayIp Nothing Nothing _) = error "unexpected happend"
148+
stakePoolRelayToAddr (StakePoolRelayDnsARecord dns (Just port)) = [Ping.mkAddress (BSC.unpack dns ++ ":" ++ show port)]
149+
stakePoolRelayToAddr (StakePoolRelayDnsARecord dns Nothing) = [Ping.mkAddress (BSC.unpack dns)]
150+
stakePoolRelayToAddr (StakePoolRelayDnsSrvRecord srv) = [Ping.mkAddress (BSC.unpack srv)]

‎cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs‎

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,7 @@ import Cardano.Api.Experimental.Certificate
2727
import Cardano.Api.Ledger qualified as L
2828

2929
import Cardano.CLI.Compatible.Exception
30+
import Cardano.CLI.Compatible.StakePool.Run (stakePoolRelayToAddr)
3031
import Cardano.CLI.EraBased.StakePool.Command
3132
import Cardano.CLI.EraBased.StakePool.Command qualified as Cmd
3233
import Cardano.CLI.EraBased.StakePool.Internal.Metadata (carryHashChecks)
@@ -42,6 +43,10 @@ import Cardano.CLI.Type.Error.HashCmdError (FetchURLError (..))
4243
import Cardano.CLI.Type.Error.StakePoolCmdError
4344
import Cardano.CLI.Type.Key (readVerificationKeyOrFile)
4445

46+
import Cardano.Network.Ping qualified as Ping
47+
48+
import Control.Tracer (nullTracer, (>$<))
49+
import Control.Monad (unless)
4550
import Data.ByteString.Char8 qualified as BS
4651
import Data.ByteString.Lazy qualified as LBS
4752
import Data.Function ((&))
@@ -86,6 +91,31 @@ runStakePoolRegistrationCertificateCmd
8691
, outFile
8792
} =
8893
obtainCommonConstraints era $ do
94+
let pingOpts =
95+
Ping.PingOpts {
96+
Ping.pingOptsCount = 1,
97+
Ping.pingOptsMagic = toNetworkMagic network,
98+
Ping.pingOptsJson = Ping.AsText,
99+
Ping.pingOptsQuiet = True,
100+
Ping.pingOptsSRVPrefix = "_cardano._tcp",
101+
Ping.pingOptsColor = Ping.ColorNever,
102+
Ping.pingOptsMode = Ping.TipMode
103+
}
104+
pingErrs <- liftIO $ do
105+
stderr <- Ping.mkStdErrTracer
106+
headerTracer <- Ping.mkHeaderTracer pingOpts stderr
107+
Ping.pingClients'
108+
(Ping.format Ping.AsText >$< stderr)
109+
nullTracer
110+
headerTracer
111+
(Ping.toText >$< stderr)
112+
pingOpts
113+
Ping.AddressIsNotAFilePath
114+
(concatMap stakePoolRelayToAddr relays)
115+
116+
unless (null pingErrs) $
117+
throwCliError (StakePoolCmdRelayPingErrors pingErrs)
118+
89119
-- Pool verification key
90120
stakePoolVerKey <- getVerificationKeyFromStakePoolVerificationKeySource poolVerificationKeyOrFile
91121
let stakePoolId' = anyStakePoolVerificationKeyHash stakePoolVerKey

‎cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs‎

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,9 @@ module Cardano.CLI.Type.Error.StakePoolCmdError
88
)
99
where
1010

11+
import Control.Exception (displayException)
12+
import Prettyprinter qualified as PP
13+
1114
import Cardano.Api
1215
import Cardano.Api.Experimental.Certificate
1316
( Hash (StakePoolMetadataHash)
@@ -17,6 +20,8 @@ import Cardano.Api.Experimental.Certificate
1720

1821
import Cardano.CLI.Type.Error.HashCmdError (FetchURLError)
1922

23+
import Cardano.Network.Ping (PingException)
24+
2025
data StakePoolCmdError
2126
= StakePoolCmdReadFileError !(FileError TextEnvelopeError)
2227
| StakePoolCmdWriteFileError !(FileError ())
@@ -27,6 +32,7 @@ data StakePoolCmdError
2732
!(Hash StakePoolMetadata)
2833
-- ^ Actual hash
2934
| StakePoolCmdFetchURLError !FetchURLError
35+
| StakePoolCmdRelayPingErrors ![PingException]
3036
deriving Show
3137

3238
instance Error StakePoolCmdError where
@@ -47,3 +53,7 @@ instance Error StakePoolCmdError where
4753
<+> pretty (show actualHash)
4854
StakePoolCmdFetchURLError fetchErr ->
4955
"Error fetching stake pool metadata: " <> prettyException fetchErr
56+
StakePoolCmdRelayPingErrors errs ->
57+
PP.vsep ["Errors validating stake pool relays:"
58+
, PP.indent 2 $ PP.vsep (PP.pretty . displayException <$> errs)
59+
]

0 commit comments

Comments
 (0)