From b3c76f08aa25283fbf1e321ee2c7a9319b3e2297 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Thu, 6 Jul 2023 11:10:45 +0200 Subject: [PATCH] Log dropped messages --- hydra-node/exe/hydra-node/Main.hs | 4 +- hydra-node/src/Hydra/Network/Authenticate.hs | 38 ++++++++++++++----- hydra-node/src/Hydra/Node.hs | 2 + .../test/Hydra/Network/AuthenticateSpec.hs | 38 +++++++++++-------- 4 files changed, 56 insertions(+), 26 deletions(-) diff --git a/hydra-node/exe/hydra-node/Main.hs b/hydra-node/exe/hydra-node/Main.hs index 669e3c1e5cf..f6854f489f8 100644 --- a/hydra-node/exe/hydra-node/Main.hs +++ b/hydra-node/exe/hydra-node/Main.hs @@ -108,7 +108,7 @@ main = do RunOptions{apiHost, apiPort} = opts apiPersistence <- createPersistenceIncremental $ persistenceDir <> "/server-output" withAPIServer apiHost apiPort party apiPersistence (contramap APIServer tracer) chain (putEvent . ClientEvent) $ \server -> do - withNetwork (contramap Network tracer) server signingKey otherParties host port peers nodeId putNetworkEvent $ \hn -> do + withNetwork tracer server signingKey otherParties host port peers nodeId putNetworkEvent $ \hn -> do let RunOptions{ledgerConfig} = opts withCardanoLedger ledgerConfig chainConfig $ \ledger -> runHydraNode (contramap Node tracer) $ @@ -125,7 +125,7 @@ main = do connectionMessages = \case Connected nodeid -> sendOutput $ PeerConnected nodeid Disconnected nodeid -> sendOutput $ PeerDisconnected nodeid - in withAuthentication signingKey parties $ withHeartbeat nodeId connectionMessages $ withOuroborosNetwork tracer localhost peers + in withAuthentication tracer signingKey parties $ withHeartbeat nodeId connectionMessages $ withOuroborosNetwork (contramap Network tracer) localhost peers withCardanoLedger ledgerConfig chainConfig action = do let DirectChainConfig{networkId, nodeSocket} = chainConfig diff --git a/hydra-node/src/Hydra/Network/Authenticate.hs b/hydra-node/src/Hydra/Network/Authenticate.hs index 4c3098d563e..b95707adbfe 100644 --- a/hydra-node/src/Hydra/Network/Authenticate.hs +++ b/hydra-node/src/Hydra/Network/Authenticate.hs @@ -4,7 +4,9 @@ module Hydra.Network.Authenticate where import Cardano.Crypto.Util (SignableRepresentation) import Control.Tracer (Tracer) +import qualified Data.Aeson as Aeson import Hydra.Crypto (HydraKey, Key (SigningKey), Signature, sign, verify) +import Hydra.Logging (traceWith) import Hydra.Network (Network (Network, broadcast), NetworkComponent) import Hydra.Party (Party (Party, vkey)) import Hydra.Prelude @@ -44,8 +46,8 @@ instance FromCBOR msg => FromCBOR (Signed msg) where -- Only verified messages are pushed downstream to the internal network for the -- node to consume and process. Non-verified messages get discarded. withAuthentication :: - ( MonadAsync m - , SignableRepresentation msg + ( SignableRepresentation msg + , ToJSON msg ) => Tracer m AuthLog -> -- The party signing key @@ -59,12 +61,30 @@ withAuthentication :: withAuthentication tracer signingKey parties withRawNetwork callback action = do withRawNetwork checkSignature authenticate where - checkSignature (Signed msg sig party@Party{vkey = partyVkey}) = do - when (verify partyVkey sig msg && elem party parties) $ - callback $ - Authenticated msg party + checkSignature (Signed msg sig party@Party{vkey = partyVkey}) = + if verify partyVkey sig msg && elem party parties + then callback $ Authenticated msg party + else traceWith tracer (mkAuthLog msg sig party) + authenticate = \Network{broadcast} -> - action $ Network{broadcast = \(Authenticated msg party) -> broadcast (Signed msg (sign signingKey msg) party)} + action $ + Network + { broadcast = \(Authenticated msg party) -> + broadcast (Signed msg (sign signingKey msg) party) + } + +-- | Smart constructor for 'MessageDropped' +mkAuthLog :: (ToJSON msg, Show signature) => msg -> signature -> Party -> AuthLog +mkAuthLog message signature party = + MessageDropped + { message = decodeUtf8 $ Aeson.encode message + , signature = show signature + , party + } + +data AuthLog = MessageDropped {message :: Text, signature :: Text, party :: Party} + deriving stock (Eq, Show, Generic) + deriving anyclass (ToJSON, FromJSON) -data AuthLog = AuthLog - deriving stock (Eq, Show) +instance Arbitrary AuthLog where + arbitrary = genericArbitrary diff --git a/hydra-node/src/Hydra/Node.hs b/hydra-node/src/Hydra/Node.hs index e9ef2b547f5..b6c5c767909 100644 --- a/hydra-node/src/Hydra/Node.hs +++ b/hydra-node/src/Hydra/Node.hs @@ -32,6 +32,7 @@ import Hydra.Node.EventQueue (EventQueue (..), Queued (..)) import Hydra.Options (ChainConfig (..), RunOptions (..)) import Hydra.Party (Party (..), deriveParty) import Hydra.Persistence (Persistence (..)) +import Hydra.Network.Authenticate (AuthLog) -- * Environment Handling @@ -69,6 +70,7 @@ data HydraNodeLog tx | BeginEffect {by :: Party, eventId :: Word64, effectId :: Word32, effect :: Effect tx} | EndEffect {by :: Party, eventId :: Word64, effectId :: Word32} | LogicOutcome {by :: Party, outcome :: Outcome tx} + | Authentication { authentication :: AuthLog} deriving stock (Generic) deriving instance (IsTx tx, IsChainState tx) => Eq (HydraNodeLog tx) diff --git a/hydra-node/test/Hydra/Network/AuthenticateSpec.hs b/hydra-node/test/Hydra/Network/AuthenticateSpec.hs index 19fcd20394a..d14593d034d 100644 --- a/hydra-node/test/Hydra/Network/AuthenticateSpec.hs +++ b/hydra-node/test/Hydra/Network/AuthenticateSpec.hs @@ -7,15 +7,18 @@ import Control.Concurrent.Class.MonadSTM (MonadSTM (readTVarIO), modifyTVar', ne import Control.Monad.IOSim (runSimOrThrow) import Data.ByteString (pack) import Hydra.Crypto (sign) +import Hydra.Ledger.Simple (SimpleTx) import Hydra.Logging (Envelope (message), nullTracer, traceInTVar) import Hydra.Network (Network (..)) -import Hydra.Network.Authenticate (AuthLog (AuthLog), Authenticated (..), Signed (Signed), withAuthentication) +import Hydra.Network.Authenticate (Authenticated (..), Signed (Signed), mkAuthLog, withAuthentication) import Hydra.Network.HeartbeatSpec (noop) +import Hydra.Network.Message (Message (ReqTx)) import Hydra.NetworkSpec (prop_canRoundtripCBOREncoding) import Hydra.Prelude import Test.Hydra.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk) import Test.Hydra.Prelude import Test.QuickCheck (listOf) +import Test.QuickCheck.Gen (generate) spec :: Spec spec = parallel $ do @@ -25,16 +28,17 @@ spec = parallel $ do captureIncoming receivedMessages msg = atomically $ modifyTVar' receivedMessages (msg :) + msg <- runIO $ generate @(Message SimpleTx) arbitrary it "pass the authenticated messages around" $ do let receivedMsgs = runSimOrThrow $ do - receivedMessages <- newTVarIO ([] :: [Authenticated ByteString]) + receivedMessages <- newTVarIO [] withAuthentication nullTracer aliceSk [bob] ( \incoming _ -> do - incoming (Signed "1" (sign bobSk "1") bob) + incoming (Signed msg (sign bobSk msg) bob) ) (captureIncoming receivedMessages) $ \_ -> @@ -42,19 +46,20 @@ spec = parallel $ do readTVarIO receivedMessages - receivedMsgs `shouldBe` [Authenticated "1" bob] + receivedMsgs `shouldBe` [Authenticated msg bob] it "drop message coming from unknown party" $ do + unexpectedMessage <- ReqTx <$> generate arbitrary let receivedMsgs = runSimOrThrow $ do - receivedMessages <- newTVarIO ([] :: [Authenticated ByteString]) + receivedMessages <- newTVarIO [] withAuthentication nullTracer aliceSk [bob] ( \incoming _ -> do - incoming (Signed "1" (sign bobSk "1") bob) - incoming (Signed "2" (sign aliceSk "2") alice) + incoming (Signed msg (sign bobSk msg) bob) + incoming (Signed unexpectedMessage (sign aliceSk unexpectedMessage) alice) ) (captureIncoming receivedMessages) $ \_ -> @@ -62,18 +67,18 @@ spec = parallel $ do readTVarIO receivedMessages - receivedMsgs `shouldBe` [Authenticated "1" bob] + receivedMsgs `shouldBe` [Authenticated msg bob] it "drop message coming from party with wrong signature" $ do let receivedMsgs = runSimOrThrow $ do - receivedMessages <- newTVarIO ([] :: [Authenticated ByteString]) + receivedMessages <- newTVarIO [] withAuthentication nullTracer aliceSk [bob, carol] ( \incoming _ -> do - incoming (Signed "1" (sign carolSk "1") bob) + incoming (Signed msg (sign carolSk msg) bob) ) (captureIncoming receivedMessages) $ \_ -> @@ -84,9 +89,9 @@ spec = parallel $ do receivedMsgs `shouldBe` [] it "authenticate the message to broadcast" $ do - let someMessage = Authenticated "1" bob + let someMessage = Authenticated msg bob sentMsgs = runSimOrThrow $ do - sentMessages <- newTVarIO ([] :: [Signed ByteString]) + sentMessages <- newTVarIO [] withAuthentication nullTracer bobSk [] (captureOutgoing sentMessages) noop $ \Network{broadcast} -> do threadDelay 0.6 @@ -95,18 +100,21 @@ spec = parallel $ do readTVarIO sentMessages - sentMsgs `shouldBe` [Signed "1" (sign bobSk "1") bob] + sentMsgs `shouldBe` [Signed msg (sign bobSk msg) bob] it "logs dropped messages" $ do + let signature = sign carolSk msg + let signedMsg = Signed msg signature bob let traced = runSimOrThrow $ do traces <- newTVarIO [] + let tracer = traceInTVar traces - withAuthentication @_ @ByteString tracer aliceSk [bob, carol] (\incoming _ -> incoming (Signed "1" (sign carolSk "1") bob)) noop $ \_ -> + withAuthentication tracer aliceSk [bob, carol] (\incoming _ -> incoming signedMsg) noop $ \_ -> threadDelay 1 readTVarIO traces - (message <$> traced) `shouldContain` [AuthLog] + (message <$> traced) `shouldContain` [mkAuthLog msg signature bob] describe "Serialization" $ do prop "can roundtrip CBOR encoding/decoding of Signed Hydra Message" $