remote: prefix WorkerOp, add workerOp Serializer, test

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

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
+

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)

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