Introduce a test case to exercise skip history feature

hydra-node/src/Hydra/API/Server.hs

@@ -19,7 +19,7 @@ import Control.Concurrent.STM.TVar (TVar, modifyTVar', newTVarIO, readTVar)
 import Control.Exception (IOException)
 import qualified Data.Aeson as Aeson
 import Hydra.API.ClientInput (ClientInput)
-import Hydra.API.ServerOutput (ServerOutput (Greetings, InvalidInput), TimedServerOutput (..))
+import Hydra.API.ServerOutput (ServerOutput (Greetings, InvalidInput), TimedServerOutput (..), replaceTxToCBOR)
 import Hydra.Chain (IsChainState)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Network (IP, PortNumber)
@@ -133,18 +133,26 @@ runAPIServer host port party tracer history callback responseChannel = do
       con <- acceptRequest pending
       chan <- STM.atomically $ dupTChan responseChannel
       traceWith tracer NewAPIConnection
+      displayCBORTx <- shouldDisplayTxCBOR queryParams
       dontServeHistory <- shouldNotServeHistory queryParams
       if dontServeHistory
         then do
           time <- getCurrentTime
-          let greetingMsg =
-                TimedServerOutput {time, seq = 0, output = Greetings party :: ServerOutput tx}
-          sendTextData con $ Aeson.encode greetingMsg
+          sendTextData con $ Aeson.encode (greetingMsg time)
         else forwardHistory con
       withPingThread con 30 (pure ()) $
-        race_ (receiveInputs con) (sendOutputs chan con)
+        race_ (receiveInputs con) (sendOutputs chan con displayCBORTx)
  where
-
+  greetingMsg time =
+    TimedServerOutput
+      { time
+      , seq = 0
+      , output = Greetings party :: ServerOutput tx
+      }
+  shouldDisplayTxCBOR qp = do
+    k <- mkQueryKey "tx-output"
+    v <- mkQueryValue "cbor"
+    pure $ (QueryParam k v) `elem` qp
   -- we want to serve the history unless client specifically asks us not to
   shouldNotServeHistory qp = do
     k <- mkQueryKey "history"
@@ -159,9 +167,10 @@ runAPIServer host port party tracer history callback responseChannel = do
         , port
         }
 
-  sendOutputs chan con = forever $ do
+  sendOutputs chan con displayCBORTx = forever $ do
     response <- STM.atomically $ readTChan chan
-    let sentResponse = Aeson.encode response
+    let sentResponse = prepareResponse displayCBORTx response
+
     sendTextData con sentResponse
     traceWith tracer (APIOutputSent $ toJSON response)
 
@@ -185,6 +194,12 @@ runAPIServer host port party tracer history callback responseChannel = do
     hist <- STM.atomically (readTVar history)
     let encodeAndReverse xs serverOutput = Aeson.encode serverOutput : xs
     sendTextDatas con $ foldl' encodeAndReverse [] hist
+  prepareResponse displayCBORTx response =
+    let encodedResponse = Aeson.encode response
+    in
+      if displayCBORTx
+        then replaceTxToCBOR response encodedResponse
+        else encodedResponse
 
 data RunServerException = RunServerException
   { ioException :: IOException

hydra-node/test/Hydra/API/ServerSpec.hs

@@ -17,7 +17,7 @@ import Control.Monad.Class.MonadSTM (
  )
 import qualified Data.Aeson as Aeson
 import Hydra.API.Server (Server (Server, sendOutput), withAPIServer)
-import Hydra.API.ServerOutput (ServerOutput (Greetings, InvalidInput), TimedServerOutput (..), input)
+import Hydra.API.ServerOutput (ServerOutput (Greetings, InvalidInput, RolledBack), TimedServerOutput (..), input)
 import Hydra.Ledger.Simple (SimpleTx)
 import Hydra.Logging (nullTracer, showLogsOnFailure)
 import Hydra.Persistence (PersistenceIncremental (..), createPersistenceIncremental)
@@ -112,17 +112,32 @@ spec = parallel $ do
       monitor $ cover 0.1 (null outputs) "no message when reconnecting"
       monitor $ cover 0.1 (length outputs == 1) "only one message when reconnecting"
       monitor $ cover 1 (length outputs > 1) "more than one message when reconnecting"
-      run . failAfter 15 $ do
+      run . failAfter 5 $ do
         withFreePort $ \port ->
           withAPIServer @SimpleTx "127.0.0.1" (fromIntegral port) alice mockPersistence nullTracer noop $ \Server{sendOutput} -> do
+            -- send arbitrary outputs from the server (which should be ignored by the client)
             mapM_ sendOutput outputs
             -- start client that doesn't want to see the history
-            withClient port defaultPath $ \conn -> do
+            withClient port (defaultPath <> "?history=0") $ \conn -> do
+              -- receive only one message which should be the greeting one
+              receivedGreeting <- replicateM 1 (receiveData conn)
+
+              case traverse Aeson.eitherDecode receivedGreeting of
+                Left{} -> failure $ "Failed to decode messages:\n" <> show receivedGreeting
+                Right timedOutputs -> do
+                  (output <$> timedOutputs) `shouldBe` [greeting]
+
+              -- send another message from server
+              sendOutput RolledBack
+              -- Receive one more message and expect it to be 'RolledBack'.
+              -- This means other messages we sent after the 'Greeting' are ignored as expected.
               received <- replicateM 1 (receiveData conn)
+
               case traverse Aeson.eitherDecode received of
                 Left{} -> failure $ "Failed to decode messages:\n" <> show received
-                Right timedOutputs -> do
-                  (output <$> timedOutputs) `shouldBe` [greeting]
+                Right timedOutputs' -> do
+                  (output <$> timedOutputs') `shouldBe` [RolledBack :: ServerOutput SimpleTx]
+              return ()
 
   it "sequence numbers are continuous and strictly monotonically increasing" $
     monadicIO $ do