diff --git a/hnix-store-remote/src/System/Nix/Store/Remote.hs b/hnix-store-remote/src/System/Nix/Store/Remote.hs index b51ce2bd..aa582ed6 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote.hs @@ -158,7 +158,7 @@ addToStore name source recursive repair = do Control.Monad.when (repair == RepairMode_DoRepair) $ error "repairing is not supported when building through the Nix daemon" - runOpArgsIO AddToStore $ \yield -> do + runOpArgsIO WorkerOp_AddToStore $ \yield -> do yield $ Data.Serialize.Put.runPut $ do putText $ System.Nix.StorePath.unStorePathName name putBool @@ -186,7 +186,7 @@ addTextToStore name text references' repair = do $ error "repairing is not supported when building through the Nix daemon" storeDir <- getStoreDir - runOpArgs AddTextToStore $ do + runOpArgs WorkerOp_AddTextToStore $ do putText name putText text putPaths storeDir references' @@ -195,14 +195,14 @@ addTextToStore name text references' repair = do addSignatures :: StorePath -> [ByteString] -> MonadStore () addSignatures p signatures = do storeDir <- getStoreDir - Control.Monad.void $ simpleOpArgs AddSignatures $ do + Control.Monad.void $ simpleOpArgs WorkerOp_AddSignatures $ do putPath storeDir p putByteStrings signatures addIndirectRoot :: StorePath -> MonadStore () addIndirectRoot pn = do storeDir <- getStoreDir - Control.Monad.void $ simpleOpArgs AddIndirectRoot $ putPath storeDir pn + Control.Monad.void $ simpleOpArgs WorkerOp_AddIndirectRoot $ putPath storeDir pn -- | Add temporary garbage collector root. -- @@ -210,7 +210,7 @@ addIndirectRoot pn = do addTempRoot :: StorePath -> MonadStore () addTempRoot pn = do storeDir <- getStoreDir - Control.Monad.void $ simpleOpArgs AddTempRoot $ putPath storeDir pn + Control.Monad.void $ simpleOpArgs WorkerOp_AddTempRoot $ putPath storeDir pn -- | Build paths if they are an actual derivations. -- @@ -218,7 +218,7 @@ addTempRoot pn = do buildPaths :: HashSet StorePath -> BuildMode -> MonadStore () buildPaths ps bm = do storeDir <- getStoreDir - Control.Monad.void $ simpleOpArgs BuildPaths $ do + Control.Monad.void $ simpleOpArgs WorkerOp_BuildPaths $ do putPaths storeDir ps putInt $ fromEnum bm @@ -229,7 +229,7 @@ buildDerivation -> MonadStore BuildResult buildDerivation p drv buildMode = do storeDir <- getStoreDir - runOpArgs BuildDerivation $ do + runOpArgs WorkerOp_BuildDerivation $ do putPath storeDir p putDerivation storeDir drv putEnum buildMode @@ -247,7 +247,7 @@ deleteSpecific -> MonadStore GCResult deleteSpecific paths = do storeDir <- getStoreDir - runOpArgs CollectGarbage $ do + runOpArgs WorkerOp_CollectGarbage $ do putEnum GCAction_DeleteSpecific putPaths storeDir paths putBool False -- ignoreLiveness @@ -265,12 +265,14 @@ deleteSpecific paths = do ensurePath :: StorePath -> MonadStore () ensurePath pn = do storeDir <- getStoreDir - Control.Monad.void $ simpleOpArgs EnsurePath $ putPath storeDir pn + Control.Monad.void + $ simpleOpArgs WorkerOp_EnsurePath + $ putPath storeDir pn -- | Find garbage collector roots. findRoots :: MonadStore (Map ByteString StorePath) findRoots = do - runOp FindRoots + runOp WorkerOp_FindRoots sd <- getStoreDir res <- getSocketIncremental @@ -292,7 +294,7 @@ findRoots = do isValidPathUncached :: StorePath -> MonadStore Bool isValidPathUncached p = do storeDir <- getStoreDir - simpleOpArgs IsValidPath $ putPath storeDir p + simpleOpArgs WorkerOp_IsValidPath $ putPath storeDir p -- | Query valid paths from set, optionally try to use substitutes. queryValidPaths @@ -301,26 +303,26 @@ queryValidPaths -> MonadStore (HashSet StorePath) queryValidPaths ps substitute = do storeDir <- getStoreDir - runOpArgs QueryValidPaths $ do + runOpArgs WorkerOp_QueryValidPaths $ do putPaths storeDir ps putBool $ substitute == SubstituteMode_DoSubstitute sockGetPaths queryAllValidPaths :: MonadStore (HashSet StorePath) queryAllValidPaths = do - runOp QueryAllValidPaths + runOp WorkerOp_QueryAllValidPaths sockGetPaths querySubstitutablePaths :: HashSet StorePath -> MonadStore (HashSet StorePath) querySubstitutablePaths ps = do storeDir <- getStoreDir - runOpArgs QuerySubstitutablePaths $ putPaths storeDir ps + runOpArgs WorkerOp_QuerySubstitutablePaths $ putPaths storeDir ps sockGetPaths queryPathInfoUncached :: StorePath -> MonadStore (Metadata StorePath) queryPathInfoUncached path = do storeDir <- getStoreDir - runOpArgs QueryPathInfo $ do + runOpArgs WorkerOp_QueryPathInfo $ do putPath storeDir path valid <- sockGetBool @@ -369,30 +371,30 @@ queryPathInfoUncached path = do queryReferrers :: StorePath -> MonadStore (HashSet StorePath) queryReferrers p = do storeDir <- getStoreDir - runOpArgs QueryReferrers $ putPath storeDir p + runOpArgs WorkerOp_QueryReferrers $ putPath storeDir p sockGetPaths queryValidDerivers :: StorePath -> MonadStore (HashSet StorePath) queryValidDerivers p = do storeDir <- getStoreDir - runOpArgs QueryValidDerivers $ putPath storeDir p + runOpArgs WorkerOp_QueryValidDerivers $ putPath storeDir p sockGetPaths queryDerivationOutputs :: StorePath -> MonadStore (HashSet StorePath) queryDerivationOutputs p = do storeDir <- getStoreDir - runOpArgs QueryDerivationOutputs $ putPath storeDir p + runOpArgs WorkerOp_QueryDerivationOutputs $ putPath storeDir p sockGetPaths queryDerivationOutputNames :: StorePath -> MonadStore (HashSet StorePath) queryDerivationOutputNames p = do storeDir <- getStoreDir - runOpArgs QueryDerivationOutputNames $ putPath storeDir p + runOpArgs WorkerOp_QueryDerivationOutputNames $ putPath storeDir p sockGetPaths queryPathFromHashPart :: StorePathHashPart -> MonadStore StorePath queryPathFromHashPart storePathHash = do - runOpArgs QueryPathFromHashPart + runOpArgs WorkerOp_QueryPathFromHashPart $ putText $ System.Nix.StorePath.storePathHashPartToText storePathHash sockGetPath @@ -408,7 +410,7 @@ queryMissing ) queryMissing ps = do storeDir <- getStoreDir - runOpArgs QueryMissing $ putPaths storeDir ps + runOpArgs WorkerOp_QueryMissing $ putPaths storeDir ps willBuild <- sockGetPaths willSubstitute <- sockGetPaths @@ -418,13 +420,13 @@ queryMissing ps = do pure (willBuild, willSubstitute, unknown, downloadSize', narSize') optimiseStore :: MonadStore () -optimiseStore = Control.Monad.void $ simpleOp OptimiseStore +optimiseStore = Control.Monad.void $ simpleOp WorkerOp_OptimiseStore syncWithGC :: MonadStore () -syncWithGC = Control.Monad.void $ simpleOp SyncWithGC +syncWithGC = Control.Monad.void $ simpleOp WorkerOp_SyncWithGC -- returns True on errors verifyStore :: CheckMode -> RepairMode -> MonadStore Bool -verifyStore check repair = simpleOpArgs VerifyStore $ do +verifyStore check repair = simpleOpArgs WorkerOp_VerifyStore $ do putBool $ check == CheckMode_DoCheck putBool $ repair == RepairMode_DoRepair diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs index b07a1ce6..0738e639 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs @@ -66,6 +66,8 @@ module System.Nix.Store.Remote.Serializer -- * Handshake , HandshakeSError(..) , workerMagic + -- * Worker protocol + , workerOp ) where import Control.Monad.Except (MonadError, throwError, ) @@ -922,3 +924,9 @@ workerMagic = Serializer $ word64ToWorkerMagic c , putS = putS int . workerMagicToWord64 } + +-- * Worker protocol + +workerOp :: NixSerializer r SError WorkerOp +workerOp = enum + diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/WorkerOp.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/WorkerOp.hs index 6fd18f9e..c250db27 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/WorkerOp.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/WorkerOp.hs @@ -7,51 +7,51 @@ module System.Nix.Store.Remote.Types.WorkerOp -- This type has gaps filled in so that the GHC builtin -- Enum instance lands on the right values. data WorkerOp - = Reserved_0__ -- 0 - | IsValidPath -- 1 - | Reserved_2__ -- 2 - | HasSubstitutes -- 3 - | QueryPathHash -- 4 // obsolete - | QueryReferences -- 5 // obsolete - | QueryReferrers -- 6 - | AddToStore -- 7 - | AddTextToStore -- 8 // obsolete since 1.25, Nix 3.0. Use wopAddToStore - | BuildPaths -- 9 - | EnsurePath -- 10 0xa - | AddTempRoot -- 11 0xb - | AddIndirectRoot -- 12 0xc - | SyncWithGC -- 13 0xd - | FindRoots -- 14 0xe - | Reserved_15__ -- 15 0xf - | ExportPath -- 16 0x10 // obsolete - | Reserved_17__ -- 17 0x11 - | QueryDeriver -- 18 0x12 // obsolete - | SetOptions -- 19 0x13 - | CollectGarbage -- 20 0x14 - | QuerySubstitutablePathInfo -- 21 0x15 - | QueryDerivationOutputs -- 22 0x16 // obsolete - | QueryAllValidPaths -- 23 0x17 - | QueryFailedPaths -- 24 0x18 - | ClearFailedPaths -- 25 0x19 - | QueryPathInfo -- 26 0x1a - | ImportPaths -- 27 0x1b // obsolete - | QueryDerivationOutputNames -- 28 0x1c // obsolete - | QueryPathFromHashPart -- 29 0x1d - | QuerySubstitutablePathInfos -- 30 0x1e - | QueryValidPaths -- 31 0x1f - | QuerySubstitutablePaths -- 32 0x20 - | QueryValidDerivers -- 33 0x21 - | OptimiseStore -- 34 0x22 - | VerifyStore -- 35 0x23 - | BuildDerivation -- 36 0x24 - | AddSignatures -- 37 0x25 - | NarFromPath -- 38 0x26 - | AddToStoreNar -- 39 0x27 - | QueryMissing -- 40 0x28 - | QueryDerivationOutputMap -- 41 0x29 - | RegisterDrvOutput -- 42 0x2a - | QueryRealisation -- 43 0x2b - | AddMultipleToStore -- 44 0x2c - | AddBuildLog -- 45 0x2d - | BuildPathsWithResults -- 46 0x2e + = WorkerOp_Reserved_0__ -- 0 + | WorkerOp_IsValidPath -- 1 + | WorkerOp_Reserved_2__ -- 2 + | WorkerOp_HasSubstitutes -- 3 + | WorkerOp_QueryPathHash -- 4 // obsolete + | WorkerOp_QueryReferences -- 5 // obsolete + | WorkerOp_QueryReferrers -- 6 + | WorkerOp_AddToStore -- 7 + | WorkerOp_AddTextToStore -- 8 // obsolete since 1.25, Nix 3.0. Use wopAddToStore + | WorkerOp_BuildPaths -- 9 + | WorkerOp_EnsurePath -- 10 0xa + | WorkerOp_AddTempRoot -- 11 0xb + | WorkerOp_AddIndirectRoot -- 12 0xc + | WorkerOp_SyncWithGC -- 13 0xd + | WorkerOp_FindRoots -- 14 0xe + | WorkerOp_Reserved_15__ -- 15 0xf + | WorkerOp_ExportPath -- 16 0x10 // obsolete + | WorkerOp_Reserved_17__ -- 17 0x11 + | WorkerOp_QueryDeriver -- 18 0x12 // obsolete + | WorkerOp_SetOptions -- 19 0x13 + | WorkerOp_CollectGarbage -- 20 0x14 + | WorkerOp_QuerySubstitutablePathInfo -- 21 0x15 + | WorkerOp_QueryDerivationOutputs -- 22 0x16 // obsolete + | WorkerOp_QueryAllValidPaths -- 23 0x17 + | WorkerOp_QueryFailedPaths -- 24 0x18 + | WorkerOp_ClearFailedPaths -- 25 0x19 + | WorkerOp_QueryPathInfo -- 26 0x1a + | WorkerOp_ImportPaths -- 27 0x1b // obsolete + | WorkerOp_QueryDerivationOutputNames -- 28 0x1c // obsolete + | WorkerOp_QueryPathFromHashPart -- 29 0x1d + | WorkerOp_QuerySubstitutablePathInfos -- 30 0x1e + | WorkerOp_QueryValidPaths -- 31 0x1f + | WorkerOp_QuerySubstitutablePaths -- 32 0x20 + | WorkerOp_QueryValidDerivers -- 33 0x21 + | WorkerOp_OptimiseStore -- 34 0x22 + | WorkerOp_VerifyStore -- 35 0x23 + | WorkerOp_BuildDerivation -- 36 0x24 + | WorkerOp_AddSignatures -- 37 0x25 + | WorkerOp_NarFromPath -- 38 0x26 + | WorkerOp_AddToStoreNar -- 39 0x27 + | WorkerOp_QueryMissing -- 40 0x28 + | WorkerOp_QueryDerivationOutputMap -- 41 0x29 + | WorkerOp_RegisterDrvOutput -- 42 0x2a + | WorkerOp_QueryRealisation -- 43 0x2b + | WorkerOp_AddMultipleToStore -- 44 0x2c + | WorkerOp_AddBuildLog -- 45 0x2d + | WorkerOp_BuildPathsWithResults -- 46 0x2e deriving (Bounded, Eq, Enum, Ord, Show, Read) diff --git a/hnix-store-remote/tests/NixSerializerSpec.hs b/hnix-store-remote/tests/NixSerializerSpec.hs index 9356bf28..e85fd2e1 100644 --- a/hnix-store-remote/tests/NixSerializerSpec.hs +++ b/hnix-store-remote/tests/NixSerializerSpec.hs @@ -6,7 +6,8 @@ import Crypto.Hash (MD5, SHA1, SHA256, SHA512) import Data.Dependent.Sum (DSum((:=>))) import Data.Fixed (Uni) import Data.Time (NominalDiffTime) -import Test.Hspec (Expectation, Spec, describe, parallel, shouldBe) +import Data.Word (Word64) +import Test.Hspec (Expectation, Spec, describe, it, parallel, shouldBe) import Test.Hspec.QuickCheck (prop) import Test.QuickCheck (Gen, arbitrary, forAll, suchThat) import Test.QuickCheck.Instances () @@ -23,7 +24,7 @@ import System.Nix.StorePath (StoreDir) import System.Nix.StorePath.Metadata (Metadata(..)) import System.Nix.Store.Remote.Arbitrary () import System.Nix.Store.Remote.Serializer -import System.Nix.Store.Remote.Types (ErrorInfo(..), Logger(..), ProtoVersion(..), Trace(..)) +import System.Nix.Store.Remote.Types (ErrorInfo(..), Logger(..), ProtoVersion(..), Trace(..), WorkerOp(..)) -- | Test for roundtrip using @NixSerializer@ roundtripSReader @@ -154,11 +155,25 @@ spec = parallel $ do $ \pv -> forAll (arbitrary `suchThat` errorInfoIf (protoVersion_minor pv >= 26)) $ roundtripSReader logger pv - where - errorInfoIf True (Logger_Error (Right x)) = noJust0s x - errorInfoIf False (Logger_Error (Left _)) = True - errorInfoIf _ (Logger_Error _) = False - errorInfoIf _ _ = True - noJust0s ErrorInfo{..} = - errorInfoPosition /= Just 0 - && all ((/= Just 0) . tracePosition) errorInfoTraces + + describe "Enums" $ do + let it' name constr value = + it name + $ (runP enum () constr) + `shouldBe` + (runP (int @Word64) () value) + + describe "WorkerOp enum order matches Nix" $ do + it' "IsValidPath" WorkerOp_IsValidPath 1 + it' "BuildPathsWithResults" WorkerOp_BuildPathsWithResults 46 + +errorInfoIf :: Bool -> Logger -> Bool +errorInfoIf True (Logger_Error (Right x)) = noJust0s x + where + noJust0s :: ErrorInfo -> Bool + noJust0s ErrorInfo{..} = + errorInfoPosition /= Just 0 + && all ((/= Just 0) . tracePosition) errorInfoTraces +errorInfoIf False (Logger_Error (Left _)) = True +errorInfoIf _ (Logger_Error _) = False +errorInfoIf _ _ = True