diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,20 @@ # Changelog +## 0.3.0.0 — 2026-11-14 + +### Breaking Changes + +- Require kansoku-api ^>=0.3.0.0; exported client records follow its revised route types. + +### New Features + +- Add `analysesClient` for account-owned analysis documents with revision-checked editing. +- Add `retentionClient` for calendar retention with independent start and return activity selections. + +### Other Changes + +- Cover analysis pagination through the Relay client contract. + ## 0.2.0.0 — 2026-11-12 ### Breaking Changes diff --git a/kansoku-client.cabal b/kansoku-client.cabal --- a/kansoku-client.cabal +++ b/kansoku-client.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: kansoku-client -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Haskell server SDK for Kansoku analytics. description: A lightweight client package for emitting Kansoku analytics events from @@ -45,7 +45,7 @@ http-client, http-client-tls, http-types, - kansoku-api ^>=0.2.0.0, + kansoku-api ^>=0.3.0.0, lens ^>=5.3, servant, servant-client, @@ -80,9 +80,11 @@ hspec, http-client, http-types, - kansoku-api ^>=0.2.0.0, + kansoku-api ^>=0.3.0.0, kansoku-client, process, + relay-pagination, + relay-pagination-servant, servant, servant-client, stm, diff --git a/src/Kansoku/Client/Metrics.hs b/src/Kansoku/Client/Metrics.hs --- a/src/Kansoku/Client/Metrics.hs +++ b/src/Kansoku/Client/Metrics.hs @@ -5,17 +5,20 @@ -- | Typed servant-client access to Kansoku's experiment metrics. module Kansoku.Client.Metrics ( pathsClient, + retentionClient, experimentConversionClient, experimentFunnelClient, experimentsClient, kansokuMetricsCredential, metricsClient, cohortsClient, + analysesClient, metricDefinitionsClient, ) where import Data.Time (Day) +import Kansoku.Analysis.Api (Analyses) import Kansoku.Api.Response (KansokuResult) import Kansoku.Auth.Api (MetricsAuth) import Kansoku.Cohort.Api (Cohorts) @@ -64,3 +67,11 @@ metricDefinitionsClient :: MetricDefinitions (AsClientT ClientM) metricDefinitionsClient = ServantClient.client (Proxy @(NamedRoutes MetricDefinitions)) + +-- | Account-owned opaque analysis documents and revision-checked editing. +analysesClient :: Analyses (AsClientT ClientM) +analysesClient = ServantClient.client (Proxy @(NamedRoutes Analyses)) + +-- | Calendar retention with independent starting and returning activity selections. +retentionClient :: AuthenticatedRequest MetricsAuth -> Day -> Day -> Maybe Text -> Maybe TimeGrain -> [MetricFilter] -> Maybe Text -> Maybe Metrics.RetentionMode -> Maybe Metrics.CohortMode -> Maybe Bool -> Maybe Metrics.AggregateBy -> Maybe Metrics.OrganizationAttribution -> Maybe Metrics.RetentionPeriod -> Maybe Text -> Maybe Text -> [MetricFilter] -> [MetricFilter] -> ClientM (KansokuResult MetricResult) +retentionClient = Metrics.retention metricsClient diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -18,11 +18,14 @@ import Data.Text qualified as Text import Data.Time.Format (defaultTimeLocale, formatTime) import GHC.Clock (getMonotonicTime) +import Kansoku.Analysis.Api qualified as Analysis +import Kansoku.Analysis.Types qualified as Analysis import Kansoku.Api.Response (KansokuResult (..), problem) import Kansoku.Api.Response qualified as Response import Kansoku.Client import Kansoku.Client qualified as Client import Kansoku.Client.Metrics +import Kansoku.Cohort.Api (PageResult (..)) import Kansoku.Event import Kansoku.Ingest.Api (BatchAck (..), BeaconAPI, BeaconEnvelope (..), PlainTextJSON, ingestEvent) import Kansoku.Metrics.Api (MetricResult (..), TimeGrain (Day)) @@ -34,6 +37,8 @@ import Network.HTTP.Types.Header (hAuthorization, hContentType) import Network.Wai (Application, Request, pathInfo, queryString, requestHeaders, requestMethod, responseLBS, strictRequestBody) import Network.Wai.Handler.Warp qualified as Warp +import Relay.Pagination qualified as Relay +import Relay.Pagination.Servant qualified as RelayClient import Servant.API (JSON) import Servant.Client (mkClientEnv, parseBaseUrl, runClientM) import Servant.Client qualified as SC @@ -349,6 +354,105 @@ Warp.testWithApplication (pure schemaRecorderApp) $ \port -> withClient (testConfig port) $ \client -> fetchSchemaCatalog client `shouldReturn` Right (schemaCatalog defaultRegistry) + + it "live integration retention counts the seeded weekly signup/document cohort" $ do + required <- lookupEnv "KANSOKU_REQUIRED_INTEGRATION" + server <- lookupEnv "KANSOKU_SERVER_URL" + credential <- lookupEnv "KANSOKU_RETENTION_SERVICE_TOKEN" + source <- lookupEnv "KANSOKU_RETENTION_SOURCE" + case (server, credential, source) of + (Just url, Just token, Just selection) -> do + manager <- HTTP.newManager HTTP.defaultManagerSettings + base <- parseBaseUrl url + predicate <- either (fail . Text.unpack) pure (Filter.mkMetricFilter "source_service" Filter.FilterEq (Just (Aeson.String (Text.pack selection)))) + result <- runClientM (retentionClient (kansokuMetricsCredential (Text.pack token)) (read "2026-07-06") (read "2026-07-27") Nothing Nothing [predicate] (Just "1,2") Nothing Nothing Nothing Nothing Nothing (Just Metrics.RetentionWeek) (Just "signup_completed") (Just "document_created") [] []) (mkClientEnv manager base) + case result of + Right (KansokuOk value) -> do + let values = [(Map.lookup "cohort" (point ^. #group), Map.lookup "offset" (point ^. #group), point ^. #value) | point <- value ^. #points] + values `shouldBe` [(Just (Just cohort), Just (Just offset), amount) | (cohort, offset, amount) <- [("2026-07-06", "0", 4), ("2026-07-06", "1", 2), ("2026-07-06", "2", 2), ("2026-07-13", "0", 1), ("2026-07-13", "1", 1), ("2026-07-20", "0", 1)]] + other -> expectationFailure (show other) + _ | required == Just "1" -> expectationFailure "required retention integration coordinates are missing" + _ -> pendingWith "retention integration requires the owned public fixture" + + it "derived retention clients omit optional parameters and preserve separate repeatable side filters" $ do + captured <- newTVarIO [] + let app request respond = do + lookup hAuthorization (requestHeaders request) `shouldBe` Just "Bearer test-service-token" + pathInfo request `shouldBe` ["metrics", "retention"] + atomically (modifyTVar' captured (<> [queryString request])) + respond (responseLBS status200 [(hContentType, "application/json")] (Aeson.encode (MetricResult "retention" []))) + Warp.testWithApplication (pure app) $ \port -> do + manager <- HTTP.newManager HTTP.defaultManagerSettings + base <- parseBaseUrl ("http://127.0.0.1:" <> show port) + let env = mkClientEnv manager base + query = retentionClient (kansokuMetricsCredential "test-service-token") (read "2026-07-06") (read "2026-07-27") Nothing Nothing + runClientM (query [] Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing [] []) env `shouldReturn` Right (KansokuOk (MetricResult "retention" [])) + f <- either (fail . Text.unpack) pure (Filter.mkMetricFilter "country_code" Filter.FilterEq (Just (Aeson.String "US"))) + runClientM (query [f] (Just "1,2") Nothing Nothing Nothing Nothing Nothing (Just Metrics.RetentionWeek) (Just "signup_completed") (Just "document_created") [f, f] [f, f]) env `shouldReturn` Right (KansokuOk (MetricResult "retention" [])) + [legacy, selected] <- readTVarIO captured + map fst legacy `shouldBe` ["from", "to"] + lookup "period" selected `shouldBe` Just (Just "week") + lookup "startEvent" selected `shouldBe` Just (Just "signup_completed") + lookup "returnEvent" selected `shouldBe` Just (Just "document_created") + length (filter ((== "filter") . fst) selected) `shouldBe` 1 + length (filter ((== "startFilter") . fst) selected) `shouldBe` 2 + length (filter ((== "returnFilter") . fst) selected) `shouldBe` 2 + + it "live integration saved analysis clients round-trip and decode typed conflicts" $ do + required <- lookupEnv "KANSOKU_REQUIRED_INTEGRATION" + server <- lookupEnv "KANSOKU_SERVER_URL" + credential <- lookupEnv "KANSOKU_ANALYSES_SERVICE_TOKEN" + writeKey <- lookupEnv "KANSOKU_API_KEY" + case (server, credential) of + (Just url, Just token) -> do + manager <- HTTP.newManager HTTP.defaultManagerSettings + base <- parseBaseUrl url + let env = mkClientEnv manager base + auth = kansokuMetricsCredential (Text.pack token) + input = Analysis.AnalysisInput "client analysis" Nothing Analysis.Funnel 1 (Aeson.object ["nested" Aeson..= [Aeson.Null, Aeson.String "雪\0"]]) + run :: SC.ClientM a -> IO a + run action = runClientM action env >>= either (fail . show) pure + created <- + run (Analysis.createAnalysis analysesClient auth input) >>= \case + Analysis.AnalysisOk saved -> pure saved + failure -> fail (show failure) + let ident = created ^. #id + replacement = Analysis.AnalysisReplace "client replacement" Nothing Analysis.Retention 2 (input ^. #document) (Analysis.Revision 1) + run (Analysis.getAnalysis analysesClient auth ident) `shouldReturn` Analysis.AnalysisOk created + run (Analysis.listAnalyses analysesClient auth (Just Analysis.Funnel) (RelayClient.forwardPage 100 Nothing)) >>= \case + PageOk page -> map (view #id . Relay.node) (Relay.edges page) `shouldContain` [ident] + _ -> expectationFailure "analysis client page failed" + changed <- + run (Analysis.replaceAnalysis analysesClient auth ident replacement) >>= \case + Analysis.AnalysisOk saved -> pure saved + failure -> fail (show failure) + changed ^. #revision `shouldBe` Analysis.Revision 2 + changed ^. #document `shouldBe` input ^. #document + run (Analysis.replaceAnalysis analysesClient auth ident replacement) >>= \case + Analysis.AnalysisConflict problem -> do + Response.code problem `shouldBe` "analysis_revision_conflict" + Response.status problem `shouldBe` 409 + Response.retryable problem `shouldBe` False + failure -> expectationFailure (show failure) + run (Analysis.deleteAnalysis analysesClient auth ident (Analysis.Revision 1)) >>= \case + Analysis.AnalysisConflict problem -> Response.code problem `shouldBe` "analysis_revision_conflict" + failure -> expectationFailure (show failure) + run (Analysis.deleteAnalysis analysesClient auth ident (Analysis.Revision 2)) `shouldReturn` Analysis.AnalysisOk True + run (Analysis.getAnalysis analysesClient auth ident) >>= \case + Analysis.AnalysisNotFound problem -> Response.code problem `shouldBe` "analysis_not_found" + failure -> expectationFailure (show failure) + runClientM (Analysis.getAnalysis analysesClient (kansokuMetricsCredential "invalid") ident) env >>= \case + Left (SC.FailureResponse _ response) -> do + statusCode (SC.responseStatusCode response) `shouldBe` 401 + fmap Response.code (Aeson.eitherDecode (SC.responseBody response)) `shouldBe` Right "unauthorized" + result -> expectationFailure (show result) + case writeKey of + Just key -> + runClientM (Analysis.getAnalysis analysesClient (kansokuMetricsCredential (Text.pack key)) ident) env >>= \case + Left (SC.FailureResponse _ response) -> statusCode (SC.responseStatusCode response) `shouldBe` 403 + result -> expectationFailure (show result) + Nothing -> expectationFailure "required live write key missing" + _ -> if required == Just "1" then expectationFailure "required live analysis endpoint/credential missing" else pendingWith "live analysis endpoint not configured" it "skips the live integration test unless KANSOKU_SERVER_URL is set" $ do required <- lookupEnv "KANSOKU_REQUIRED_INTEGRATION"