remote: fix roots test for MITM vs Direct

This commit is contained in:
sorki 2023-12-10 18:48:50 +01:00
parent dea03e0f72
commit 3eb346699b

View File

@ -318,16 +318,28 @@ builderSh = "declare -xpexport > $out"
spec :: Spec spec :: Spec
spec = do spec = do
describe "Remote store protocol" $ do describe "Remote store protocol" $ do
describe "Direct" $ makeProtoSpec withNixDaemon describe "Direct"
describe "MITM" $ makeProtoSpec withManInTheMiddleNixDaemon $ makeProtoSpec
withNixDaemon
SpecFlavor_Direct
describe "MITM"
$ makeProtoSpec
withManInTheMiddleNixDaemon
SpecFlavor_MITM
data SpecFlavor
= SpecFlavor_Direct
| SpecFlavor_MITM
deriving (Eq, Ord, Show)
makeProtoSpec makeProtoSpec
:: (ActionWith :: (ActionWith
(RemoteStoreT IO () -> Run IO ()) (RemoteStoreT IO () -> Run IO ())
-> IO () -> IO ()
) )
-> SpecFlavor
-> Spec -> Spec
makeProtoSpec f = around f $ do makeProtoSpec f flavor = around f $ do
context "syncWithGC" $ context "syncWithGC" $
itRights "syncs with garbage collector" syncWithGC itRights "syncs with garbage collector" syncWithGC
@ -394,11 +406,24 @@ makeProtoSpec f = around f $ do
buildPaths (toDerivedPathSet path) BuildMode_Repair buildPaths (toDerivedPathSet path) BuildMode_Repair
context "roots" $ context "findRoots" $ do context "roots" $ context "findRoots" $ do
itRights "empty roots" (findRoots `shouldReturn` mempty) itRights "empty roots" (findRoots `shouldReturn` mempty)
itRights "path added as a temp root" $ withPath $ \_ -> do itRights "path added as a temp root" $ withPath $ \_ -> do
roots <- findRoots let expectRoots =
roots `shouldSatisfy` ((== 1) . Data.Map.size) if flavor == SpecFlavor_MITM
then 0 -- nested client closes its connection so temp root gets removed
else 1
roots <- findRoots
roots `shouldSatisfy` ((== expectRoots) . Data.Map.size)
itRights "indirect root" $ withPath $ \path -> do
let expectRoots =
if flavor == SpecFlavor_MITM
then 1 -- nested client closes its connection so temp root gets removed
else 2
addIndirectRoot path
roots <- findRoots
roots `shouldSatisfy` ((== expectRoots) . Data.Map.size)
context "optimiseStore" $ itRights "optimises" optimiseStore context "optimiseStore" $ itRights "optimises" optimiseStore