diff --git a/cabal.project b/cabal.project index eb6b2fd25f..d0ae38ad58 100644 --- a/cabal.project +++ b/cabal.project @@ -161,8 +161,8 @@ source-repository-package source-repository-package type: git location: https://github.com/IntersectMBO/ouroboros-network.git - tag: 613f8a13cc1c11b2568a627d6eb900058e355d30 - --sha256: sha256-G5oVYskwZTc0EeFlQHE41xIjmFhMYV7VmX48kNGuc/c= + tag: b47dbc2c29108e593cc47524cffb75008b88fe90 + --sha256: sha256-7TwcI1/m6aEBmiGYPXKHbIWlxzRja4qFyqr+apcR9p4= subdir: ./cardano-diffusion ./monoidal-synchronisation diff --git a/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs index adc8ce7e7c..6c1d3563cb 100644 --- a/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Compatible/StakePool/Run.hs @@ -6,13 +6,18 @@ module Cardano.CLI.Compatible.StakePool.Run ( runCompatibleStakePoolCmds + , stakePoolRelayToAddr ) where +import Control.Tracer (nullTracer, (>$<)) +import Data.IP (IP (..)) +import Data.ByteString.Char8 qualified as BSC + import Cardano.Api import Cardano.Api.Compatible.Certificate import Cardano.Api.Experimental qualified as Exp -import Cardano.Api.Experimental.Certificate (StakePoolParameters (..), toShelleyPoolParams) +import Cardano.Api.Experimental.Certificate (StakePoolParameters (..), StakePoolRelay (..), toShelleyPoolParams) import Cardano.CLI.Compatible.Exception import Cardano.CLI.Compatible.StakePool.Command @@ -24,6 +29,8 @@ import Cardano.CLI.Type.Common import Cardano.CLI.Type.Error.StakePoolCmdError import Cardano.CLI.Type.Key (readVerificationKeyOrFile) +import Cardano.Network.Ping qualified as Ping + import Control.Monad runCompatibleStakePoolCmds @@ -53,6 +60,32 @@ runStakePoolRegistrationCertificateCmd , outFile } = shelleyBasedEraConstraints sbe $ do + + let pingOpts = + Ping.PingOpts { + Ping.pingOptsCount = 1, + Ping.pingOptsMagic = toNetworkMagic network, + Ping.pingOptsJson = Ping.AsText, + Ping.pingOptsQuiet = True, + Ping.pingOptsSRVPrefix = "_cardano._tcp", + Ping.pingOptsColor = Ping.ColorNever, + Ping.pingOptsMode = Ping.TipMode + } + pingErrs <- liftIO $ do + stderr <- Ping.mkStdErrTracer + headerTracer <- Ping.mkHeaderTracer pingOpts stderr + Ping.pingClients' + (Ping.format Ping.AsText >$< stderr) + nullTracer + headerTracer + (Ping.toText >$< stderr) + pingOpts + Ping.AddressIsNotAFilePath + (concatMap stakePoolRelayToAddr relays) + + unless (null pingErrs) $ + throwCliError (StakePoolCmdRelayPingErrors pingErrs) + -- Pool verification key stakePoolVerKey <- getVerificationKeyFromStakePoolVerificationKeySource poolVerificationKeyOrFile let stakePoolId' = anyStakePoolVerificationKeyHash stakePoolVerKey @@ -100,3 +133,18 @@ runStakePoolRegistrationCertificateCmd where registrationCertDesc :: TextEnvelopeDescr registrationCertDesc = "Stake Pool Registration Certificate" + + +stakePoolRelayToAddr + :: StakePoolRelay + -> [Ping.Address (Ping.Unresolved Ping.SRVOrFilePathUnresolved)] +stakePoolRelayToAddr (StakePoolRelayIp (Just ipv4) Nothing (Just port)) = [Ping.IP (IPv4 ipv4) (fromIntegral port)] +stakePoolRelayToAddr (StakePoolRelayIp Nothing (Just ipv6) (Just port)) = [Ping.IP (IPv6 ipv6) (fromIntegral port)] +stakePoolRelayToAddr (StakePoolRelayIp (Just ipv4) (Just ipv6) (Just port)) = [Ping.IP (IPv6 ipv6) (fromIntegral port), Ping.IP (IPv4 ipv4) (fromIntegral port)] +-- the pSingHostAddress parser always includes a port number +stakePoolRelayToAddr (StakePoolRelayIp _ _ Nothing) = error "unexpected happend" +-- the pSingHostAddress parser always includes at least one ip address +stakePoolRelayToAddr (StakePoolRelayIp Nothing Nothing _) = error "unexpected happend" +stakePoolRelayToAddr (StakePoolRelayDnsARecord dns (Just port)) = [Ping.mkAddress (BSC.unpack dns ++ ":" ++ show port)] +stakePoolRelayToAddr (StakePoolRelayDnsARecord dns Nothing) = [Ping.mkAddress (BSC.unpack dns)] +stakePoolRelayToAddr (StakePoolRelayDnsSrvRecord srv) = [Ping.mkAddress (BSC.unpack srv)] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs index 2da5c31d0f..b206a960aa 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs @@ -2627,7 +2627,7 @@ pMultiHostName = pSingleHostName :: Parser StakePoolRelay pSingleHostName = - StakePoolRelayDnsARecord <$> pDNSName <*> optional pPort + StakePoolRelayDnsARecord <$> pDNSName <*> (Just <$> pPort) where pDNSName :: Parser ByteString pDNSName = diff --git a/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs index 6258298819..6145fda834 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/StakePool/Run.hs @@ -27,6 +27,7 @@ import Cardano.Api.Experimental.Certificate import Cardano.Api.Ledger qualified as L import Cardano.CLI.Compatible.Exception +import Cardano.CLI.Compatible.StakePool.Run (stakePoolRelayToAddr) import Cardano.CLI.EraBased.StakePool.Command import Cardano.CLI.EraBased.StakePool.Command qualified as Cmd import Cardano.CLI.EraBased.StakePool.Internal.Metadata (carryHashChecks) @@ -42,6 +43,10 @@ import Cardano.CLI.Type.Error.HashCmdError (FetchURLError (..)) import Cardano.CLI.Type.Error.StakePoolCmdError import Cardano.CLI.Type.Key (readVerificationKeyOrFile) +import Cardano.Network.Ping qualified as Ping + +import Control.Tracer (nullTracer, (>$<)) +import Control.Monad (unless) import Data.ByteString.Char8 qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.Function ((&)) @@ -86,6 +91,31 @@ runStakePoolRegistrationCertificateCmd , outFile } = obtainCommonConstraints era $ do + let pingOpts = + Ping.PingOpts { + Ping.pingOptsCount = 1, + Ping.pingOptsMagic = toNetworkMagic network, + Ping.pingOptsJson = Ping.AsText, + Ping.pingOptsQuiet = True, + Ping.pingOptsSRVPrefix = "_cardano._tcp", + Ping.pingOptsColor = Ping.ColorNever, + Ping.pingOptsMode = Ping.TipMode + } + pingErrs <- liftIO $ do + stderr <- Ping.mkStdErrTracer + headerTracer <- Ping.mkHeaderTracer pingOpts stderr + Ping.pingClients' + (Ping.format Ping.AsText >$< stderr) + nullTracer + headerTracer + (Ping.toText >$< stderr) + pingOpts + Ping.AddressIsNotAFilePath + (concatMap stakePoolRelayToAddr relays) + + unless (null pingErrs) $ + throwCliError (StakePoolCmdRelayPingErrors pingErrs) + -- Pool verification key stakePoolVerKey <- getVerificationKeyFromStakePoolVerificationKeySource poolVerificationKeyOrFile let stakePoolId' = anyStakePoolVerificationKeyHash stakePoolVerKey diff --git a/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs b/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs index 4c29bf54f2..1eb4d52bd0 100644 --- a/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs +++ b/cardano-cli/src/Cardano/CLI/Type/Error/StakePoolCmdError.hs @@ -8,6 +8,9 @@ module Cardano.CLI.Type.Error.StakePoolCmdError ) where +import Control.Exception (displayException) +import Prettyprinter qualified as PP + import Cardano.Api import Cardano.Api.Experimental.Certificate ( Hash (StakePoolMetadataHash) @@ -17,6 +20,8 @@ import Cardano.Api.Experimental.Certificate import Cardano.CLI.Type.Error.HashCmdError (FetchURLError) +import Cardano.Network.Ping (PingException) + data StakePoolCmdError = StakePoolCmdReadFileError !(FileError TextEnvelopeError) | StakePoolCmdWriteFileError !(FileError ()) @@ -27,6 +32,7 @@ data StakePoolCmdError !(Hash StakePoolMetadata) -- ^ Actual hash | StakePoolCmdFetchURLError !FetchURLError + | StakePoolCmdRelayPingErrors ![PingException] deriving Show instance Error StakePoolCmdError where @@ -47,3 +53,7 @@ instance Error StakePoolCmdError where <+> pretty (show actualHash) StakePoolCmdFetchURLError fetchErr -> "Error fetching stake pool metadata: " <> prettyException fetchErr + StakePoolCmdRelayPingErrors errs -> + PP.vsep ["Errors validating stake pool relays:" + , PP.indent 2 $ PP.vsep (PP.pretty . displayException <$> errs) + ]