remote: add gcResult serializer

This commit is contained in:
sorki 2023-12-07 08:35:25 +01:00
parent 5aa62fd8da
commit 77fe9f9acd
3 changed files with 25 additions and 0 deletions

View File

@ -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
}

View File

@ -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

View File

@ -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