Log dropped messages

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

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

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)

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,55 +28,57 @@ 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)
             $ \_ ->
               threadDelay 1
 
           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)
             $ \_ ->
               threadDelay 1
 
           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" $