[wip] STAB-1400: reproduce fetchHistory issue

sdk/package.yaml

@@ -153,6 +153,7 @@ tests:
       AsyncCompletionSpec,
       DurationSpec,
       IntegrationSpec,
+      IntegrationSpec.FetchHistory,
       IntegrationSpec.HangingWorkflow,
       IntegrationSpec.NoOpWorkflow,
       IntegrationSpec.TimeoutsInWorkflows,

sdk/temporal-sdk.cabal

@@ -157,7 +157,7 @@ test-suite temporal-sdk-tests
   type: exitcode-stdio-1.0
   main-is: Main.hs
   other-modules:
-      Spec, ConcurrentAccessSpec, AsyncCompletionSpec, DurationSpec, IntegrationSpec, IntegrationSpec.HangingWorkflow, IntegrationSpec.NoOpWorkflow, IntegrationSpec.TimeoutsInWorkflows, IntegrationSpec.Updates, MockActivityEnvironmentSpec, IntegrationSpec.TimeSkipping, Common, RegisterWorkflowsSpec, THCompiles
+      Spec, ConcurrentAccessSpec, AsyncCompletionSpec, DurationSpec, IntegrationSpec, IntegrationSpec.FetchHistory, IntegrationSpec.HangingWorkflow, IntegrationSpec.NoOpWorkflow, IntegrationSpec.TimeoutsInWorkflows, IntegrationSpec.Updates, MockActivityEnvironmentSpec, IntegrationSpec.TimeSkipping, Common, RegisterWorkflowsSpec, THCompiles
   hs-source-dirs:
       test
   default-extensions:

sdk/test/IntegrationSpec.hs

@@ -36,6 +36,7 @@ import Data.Int
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromJust, isJust)
+import Data.ProtoLens.Field (field)
 import Data.Text (Text)
 import qualified Data.Text as Text
 import Data.Time (Day (ModifiedJulianDay), diffUTCTime, getCurrentTime)
@@ -47,6 +48,7 @@ import qualified Data.Vector as V
 import DiscoverInstances (discoverInstances)
 import GHC.Generics
 import GHC.Stack (SrcLoc (..), callStack, fromCallSiteList)
+import IntegrationSpec.FetchHistory (NoopActivity (..), NoopWorkflow (..))
 import IntegrationSpec.HangingWorkflow
 import IntegrationSpec.NoOpWorkflow
 import IntegrationSpec.Signals
@@ -1077,6 +1079,19 @@ needsClient = do
       specify "fail" $ const pending
       specify "async fail signal?" $ const pending
       specify "always delivered" $ const pending
+
+    describe "fetchHistory" do
+      it "correctly paginates workflow history" \TestEnv {..} -> do
+        let defns = (workflowDefinition NoopWorkflow, activityDefinition NoopActivity)
+            conf = configure () defns $ baseConf
+        withWorker conf $ do
+          let opts = C.startWorkflowOptions taskQueue
+          wfHandle <- useClient $ C.start NoopWorkflow "fetchhistory-test" opts
+          res <- C.waitWorkflowResult wfHandle
+          history <- C.fetchHistory wfHandle
+          (length $ view (field @"vec'events") history)
+            `shouldBe` 399
+
     describe "Query" $ do
       specify "works" $ \TestEnv {..} -> do
         tp <- getGlobalTracerProvider

sdk/test/IntegrationSpec/FetchHistory.hs

@@ -0,0 +1,36 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE OverloadedRecordDot #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+
+module IntegrationSpec.FetchHistory where
+
+import Data.ProtoLens.Field ()
+import RequireCallStack (provideCallStack)
+import Data.Foldable (for_)
+import Temporal.Activity (Activity)
+import Temporal.Duration (seconds)
+import qualified Temporal.TH as TH
+import Temporal.Workflow (Workflow, StartToClose(..))
+import qualified Temporal.Workflow as Workflow
+
+noopActivity :: Activity () ()
+noopActivity = pure ()
+
+TH.registerActivity 'noopActivity
+
+noopWorkflow :: Workflow ()
+noopWorkflow = provideCallStack do
+  for_ [(1 :: Int)..200] \_ ->
+    Workflow.executeActivity NoopActivity $ Workflow.defaultStartActivityOptions $ StartToClose $ seconds 1
+
+TH.registerWorkflow 'noopWorkflow