remote: add gcResult serializer

Author: sorki

hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs

@@ -90,6 +90,8 @@ module System.Nix.Store.Remote.Serializer
   , realisationWithId
   -- *** BuildResult
   , buildResult
+  -- *** GCResult
+  , gcResult
   ) where
 
 import Control.Monad.Except (MonadError, throwError, )
@@ -1338,6 +1340,7 @@ data ReplySError
   = ReplySError_PrimGet SError
   | ReplySError_PrimPut SError
   | ReplySError_DerivationOutput SError
+  | ReplySError_GCResult SError
   | ReplySError_Realisation SError
   | ReplySError_RealisationWithId SError
   deriving (Eq, Ord, Generic, Show)
@@ -1435,3 +1438,18 @@ buildResult = Serializer
   where
     t0 :: UTCTime
     t0 = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
+
+gcResult
+  :: HasStoreDir r
+  => NixSerializer r ReplySError GCResult
+gcResult = mapErrorS ReplySError_GCResult $ Serializer
+  { getS = do
+      gcResult_deletedPaths <- getS (hashSet storePath)
+      gcResult_bytesFreed <- getS int
+      Control.Monad.void $ getS (int @Word64) -- obsolete
+      pure GCResult{..}
+  , putS = \GCResult{..} -> do
+      putS (hashSet storePath) gcResult_deletedPaths
+      putS int gcResult_bytesFreed
+      putS (int @Word64) 0 -- obsolete
+  }

hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs

@@ -5,6 +5,7 @@ module System.Nix.Store.Remote.Types.StoreReply
 import System.Nix.Build (BuildResult)
 import System.Nix.StorePath (HasStoreDir(..), StorePath)
 import System.Nix.Store.Remote.Serializer
+import System.Nix.Store.Remote.Types.GC (GCResult)
 import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion)
 
 -- | Get @NixSerializer@ for some type @a@
@@ -25,6 +26,9 @@ instance StoreReply Bool where
 instance StoreReply BuildResult where
   getReplyS = buildResult
 
+instance StoreReply GCResult where
+  getReplyS = gcResult
+
 instance StoreReply StorePath where
   getReplyS = mapPrimE storePath
 

hnix-store-remote/tests/NixSerializerSpec.hs

@@ -149,6 +149,9 @@ spec = parallel $ do
           forAll (arbitrary `suchThat` (restrictProtoVersion (hasProtoVersion testStoreConfig)))
           $ roundtripSReader @TestStoreConfig storeRequest testStoreConfig
 
+  describe "StoreReply" $ do
+    prop "GCResult" $ roundtripSReader @StoreDir gcResult
+
 restrictProtoVersion :: ProtoVersion -> Some StoreRequest -> Bool
 restrictProtoVersion v (Some (BuildPaths _ _)) | v < ProtoVersion 1 30 = False
 restrictProtoVersion _ (Some (BuildDerivation _ drv _)) = inputDrvs drv == mempty