ms2k/nuthatch
SHA256
Watch
0
Code Releases Activity

Group configuration by component ownership

Browse source
This commit is contained in:
ms2k 2026-07-20 02:21:33 +09:00
commit 67cc0cb802
1 changed files with 486 additions and 258 deletions
Download patch file Download diff file Expand all files Collapse all files

30
test/ProtocolConformance.hs
View file

@ -74,10 +74,10 @@ main = do
case mode of
["pg-fence"] -> verifyPostgresUnavailable cfg
_ ->
withDb cfg $ \database -> do
migrate database "sql" cfg
withRedis cfg $ \redis -> do
store <- newS3 cfg
withDb (cfgPostgres cfg) $ \database -> do
migrate database "sql" (cfgProduct cfg)
withRedis (cfgRedis cfg) $ \redis -> do
store <- newS3 (cfgS3 cfg)
case mode of
["fence"] -> verifyStoreFence cfg database redis store
["restored"] -> verifyStoreRestored store
@ -297,7 +297,7 @@ verifyStoreFence cfg database redis store = do
"UPDATE mutations \
\SET updated_at = now() - (? * interval '1 second') \
\WHERE operation_id = 'expired-delete-store-down'"
(Only (cfgIdempotencyWindowSec cfg + 1))
(Only (cfgIdempotencyWindowSec (cfgProduct cfg) + 1))
beforeExpiredDelete <-
mutationSnapshot database "expired-delete-store-down"
expiredDeleteResult <- runDelete
@ -335,7 +335,7 @@ verifyStoreFence cfg database redis store = do
"UPDATE mutations \
\SET updated_at = now() - (? * interval '1 second') \
\WHERE operation_id = 'expired-store-down'"
(Only (cfgIdempotencyWindowSec cfg + 1))
(Only (cfgIdempotencyWindowSec (cfgProduct cfg) + 1))
beforeExpired <- mutationSnapshot database "expired-store-down"
expiredResult <- runPut
env
@ -430,7 +430,7 @@ verifyPostgresUnavailable :: Config -> IO ()
verifyPostgresUnavailable cfg = do
attempt <-
(try $
withDb cfg $ \database ->
withDb (cfgPostgres cfg) $ \database ->
(Db.query_ database "SELECT 1" :: IO [Only Int]))
:: IO (Either SomeException [Only Int])
assert "PostgreSQL lane service is unavailable" (isLeft attempt)
@ -506,8 +506,8 @@ admitPut cfg database operation path size identity =
(Just identity)
}
AdmissionLimits
{ admissionMaxObjectBytes = cfgMaxObjectBytes cfg
, admissionIdempotencyWindowSec = cfgIdempotencyWindowSec cfg
{ admissionMaxObjectBytes = cfgMaxObjectBytes (cfgProduct cfg)
, admissionIdempotencyWindowSec = cfgIdempotencyWindowSec (cfgProduct cfg)
}
admitDelete :: Config -> Db -> Text -> Text -> IO AdmitOutcome
@ -524,8 +524,8 @@ admitDelete cfg database operation path =
MutationFingerprint Delete (ObjectKey ("shared/" <> path)) 0 Nothing
}
AdmissionLimits
{ admissionMaxObjectBytes = cfgMaxObjectBytes cfg
, admissionIdempotencyWindowSec = cfgIdempotencyWindowSec cfg
{ admissionMaxObjectBytes = cfgMaxObjectBytes (cfgProduct cfg)
, admissionIdempotencyWindowSec = cfgIdempotencyWindowSec (cfgProduct cfg)
}
admitPersonal :: Config -> Db -> UserId -> Text -> IO AdmitOutcome
@ -546,8 +546,8 @@ admitPersonal cfg database user operation =
(Just identityA)
}
AdmissionLimits
{ admissionMaxObjectBytes = cfgMaxObjectBytes cfg
, admissionIdempotencyWindowSec = cfgIdempotencyWindowSec cfg
{ admissionMaxObjectBytes = cfgMaxObjectBytes (cfgProduct cfg)
, admissionIdempotencyWindowSec = cfgIdempotencyWindowSec (cfgProduct cfg)
}
seedObject :: Db -> S3 -> Text -> BL.ByteString -> IO ()
@ -605,7 +605,7 @@ bounded cfg label action = do
action
finished <- getMonotonicTimeNSec
let elapsedMicros = (finished - started) `div` 1000
boundMicros = fromInteger ((cfgObjectRequestTimeoutSec cfg + 1) * 1000000)
boundMicros = fromInteger ((cfgObjectRequestTimeoutSec (cfgRecovery cfg) + 1) * 1000000)
assert (label <> " exceeded configured settlement bound")
(elapsedMicros <= boundMicros)
@ -613,7 +613,7 @@ stableForSettlementBound :: Config -> IO () -> IO ()
stableForSettlementBound cfg action = do
started <- getMonotonicTimeNSec
let duration =
fromInteger ((cfgObjectRequestTimeoutSec cfg + 1) * 1000000000)
fromInteger ((cfgObjectRequestTimeoutSec (cfgRecovery cfg) + 1) * 1000000000)
observe = do
action
now <- getMonotonicTimeNSec