kiroku-metrics 0.3.0.0 → 0.3.0.1
raw patch · 7 files changed
+25/−4 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +9/−0
- kiroku-metrics.cabal +1/−1
- src/Kiroku/Metrics/JSON.hs +3/−0
- test/Test/BrowseSpec.hs +9/−0
- test/Test/CheckpointsSpec.hs +1/−1
- test/Test/CorsSpec.hs +1/−1
- test/Test/DeadLettersSpec.hs +1/−1
CHANGELOG.md view
@@ -1,5 +1,14 @@ # Revision history for kiroku-metrics +## 0.3.0.1 — 2026-10-20++### Bug Fixes++- Keep sanitized 503 responses for typed `ConnectionLost`,+ `PoolAcquisitionTimeout` and `TransientTransactionFailure` store failures.+ Permanent server errors use the sanitized 500 response. Existing envelope+ fields, messages and route-specific unavailable codes are preserved.+ ## 0.3.0.0 — 2026-10-11 ### Breaking Changes
kiroku-metrics.cabal view
@@ -1,6 +1,6 @@ cabal-version: 3.0 name: kiroku-metrics-version: 0.3.0.0+version: 0.3.0.1 synopsis: Metrics, health, and event-streaming HTTP endpoints for Kiroku
src/Kiroku/Metrics/JSON.hs view
@@ -62,5 +62,8 @@ storeErrorResponse :: Text -> StoreError -> Response storeErrorResponse unavailableCode = \case ConnectionError _ -> errorResponse status503 unavailableCode "The event store is unavailable." Nothing+ ConnectionLost _ -> errorResponse status503 unavailableCode "The event store is unavailable." Nothing+ PoolAcquisitionTimeout -> errorResponse status503 unavailableCode "The event store is unavailable." Nothing+ TransientTransactionFailure _ _ -> errorResponse status503 unavailableCode "The event store is unavailable." Nothing EventDecodeFailed _ -> errorResponse status500 "event_decode_failed" "An event could not be decoded." Nothing _ -> errorResponse status500 "store_error" "The event store operation failed." Nothing
test/Test/BrowseSpec.hs view
@@ -8,6 +8,7 @@ import Data.Aeson (Value (..), object, (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.KeyMap qualified as KM+import Data.ByteString qualified as BS import Data.ByteString.Builder (toLazyByteString) import Data.ByteString.Lazy qualified as LBS import Data.Generics.Labels ()@@ -59,6 +60,14 @@ (disabled, _, disabledBody) <- capture browseNotConfiguredApp "GET" ["streams"] disabled `shouldBe` status404 code disabledBody `shouldBe` Just "store_browsing_not_configured"+ it "sanitizes typed transient and permanent failures on browse routes" $ do+ forM_ [(Store.ConnectionLost "secret", status503, "store_unavailable"), (Store.PoolAcquisitionTimeout, status503, "store_unavailable"), (Store.TransientTransactionFailure "40001" "secret", status503, "store_unavailable"), (Store.TransientTransactionFailure "40P01" "secret", status503, "store_unavailable"), (Store.UnexpectedServerError "42P01" "secret SQL", status500, "store_error")] $ \(err, expected, expectedCode) -> do+ let app = browseApp (StoreBrowser (\_ -> pure (Left err)) defaultBrowseLimits)+ (status, headers, responseBody) <- capture app "GET" ["events"]+ status `shouldBe` expected+ code responseBody `shouldBe` Just expectedCode+ responseBody `shouldSatisfy` (not . BS.isInfixOf "secret" . LBS.toStrict)+ capture app "HEAD" ["events"] `shouldReturn` (status, headers, "") it "serves all browse routes, names and exclusive pages through the shared server" $ withTestStore $ \store -> do append store "orders-1" 3 append store "orders-2" 1
test/Test/CheckpointsSpec.hs view
@@ -88,7 +88,7 @@ readIORef calls `shouldReturn` 2 it "sanitizes typed failures and preserves HEAD error status and headers" $ do- let failures = [(Store.ConnectionError "postgres://secret", status503, "checkpoint_inventory_unavailable"), (Store.StreamNotFound (Store.StreamName "secret"), status500, "store_error"), (Store.EventDecodeFailed (DecodeFailure (Store.EventId UUID.nil) "secret"), status500, "event_decode_failed")]+ let failures = [(Store.ConnectionError "postgres://secret", status503, "checkpoint_inventory_unavailable"), (Store.ConnectionLost "secret", status503, "checkpoint_inventory_unavailable"), (Store.PoolAcquisitionTimeout, status503, "checkpoint_inventory_unavailable"), (Store.TransientTransactionFailure "40001" "secret", status503, "checkpoint_inventory_unavailable"), (Store.TransientTransactionFailure "40P01" "secret", status503, "checkpoint_inventory_unavailable"), (Store.UnexpectedServerError "42P01" "secret SQL", status500, "store_error"), (Store.StreamNotFound (Store.StreamName "secret"), status500, "store_error"), (Store.EventDecodeFailed (DecodeFailure (Store.EventId UUID.nil) "secret"), status500, "event_decode_failed")] forM_ failures $ \(err, expected, expectedCode) -> do let app = checkpointsApp (pure (Left err)) (status, headers, body) <- capture app "GET"
test/Test/CorsSpec.hs view
@@ -173,7 +173,7 @@ errorEnvelope "origin_not_allowed" "Denied." Nothing `shouldBe` object ["error" .= object ["code" .= ("origin_not_allowed" :: Text), "message" .= ("Denied." :: Text)]] errorEnvelope "invalid_query_parameter" "Invalid." (Just (object ["parameter" .= ("limit" :: Text)])) `shouldBe` object ["error" .= object ["code" .= ("invalid_query_parameter" :: Text), "message" .= ("Invalid." :: Text), "details" .= object ["parameter" .= ("limit" :: Text)]]] it "sanitizes unavailable and other store errors" $ do- forM_ [(ConnectionError "postgres://secret", status503, "store_unavailable"), (StreamNotFound (StreamName "private"), status500, "store_error"), (EventDecodeFailed (DecodeFailure (EventId UUID.nil) "secret payload"), status500, "event_decode_failed")] $ \(err, expected, code) -> do+ forM_ [(ConnectionError "postgres://secret", status503, "store_unavailable"), (ConnectionLost "secret", status503, "store_unavailable"), (PoolAcquisitionTimeout, status503, "store_unavailable"), (TransientTransactionFailure "40001" "secret", status503, "store_unavailable"), (TransientTransactionFailure "40P01" "secret", status503, "store_unavailable"), (UnexpectedServerError "42P01" "secret SQL", status500, "store_error"), (StreamNotFound (StreamName "private"), status500, "store_error"), (EventDecodeFailed (DecodeFailure (EventId UUID.nil) "secret payload"), status500, "event_decode_failed")] $ \(err, expected, code) -> do (status, _, body) <- capture (\_ respond -> respond (storeErrorResponse "store_unavailable" err)) "GET" [] status `shouldBe` expected errorCode body `shouldBe` Just (String code)
test/Test/DeadLettersSpec.hs view
@@ -81,7 +81,7 @@ missing `shouldBe` status404 code body `shouldBe` Just "dead_letters_not_configured" it "sanitizes typed store failures and preserves HEAD error headers" $ do- forM_ [(Store.ConnectionError "postgres://secret", status503, "dead_letters_unavailable"), (Store.StreamNotFound (Store.StreamName "secret"), status500, "store_error"), (Store.EventDecodeFailed (Store.DecodeFailure (Store.EventId UUID.nil) "secret"), status500, "event_decode_failed")] $ \(err, expected, expectedCode) -> do+ forM_ [(Store.ConnectionError "postgres://secret", status503, "dead_letters_unavailable"), (Store.ConnectionLost "secret", status503, "dead_letters_unavailable"), (Store.PoolAcquisitionTimeout, status503, "dead_letters_unavailable"), (Store.TransientTransactionFailure "40001" "secret", status503, "dead_letters_unavailable"), (Store.TransientTransactionFailure "40P01" "secret", status503, "dead_letters_unavailable"), (Store.UnexpectedServerError "42P01" "secret SQL", status500, "store_error"), (Store.StreamNotFound (Store.StreamName "secret"), status500, "store_error"), (Store.EventDecodeFailed (Store.DecodeFailure (Store.EventId UUID.nil) "secret"), status500, "event_decode_failed")] $ \(err, expected, expectedCode) -> do let app = deadLettersApp (\_ -> pure (Left err)) (status, headers, body) <- capture app "GET" route [] status `shouldBe` expected