remote: add maybePathMetadata serializer

This commit is contained in:
sorki 2023-12-07 08:57:08 +01:00
parent d18a014103
commit 48697e1efe
3 changed files with 29 additions and 3 deletions

View File

@ -94,6 +94,8 @@ module System.Nix.Store.Remote.Serializer
, gcResult
-- *** Missing
, missing
-- *** Maybe (Metadata StorePath)
, maybePathMetadata
) where
import Control.Monad.Except (MonadError, throwError, )
@ -562,9 +564,11 @@ pathMetadata = Serializer
metadataReferences <- getS $ hashSet storePath
metadataRegistrationTime <- getS time
metadataNarBytes <- (\case
0 -> Nothing
size -> Just size) <$> getS int
metadataNarBytes <-
(\case
0 -> Nothing
size -> Just size
) <$> getS int
metadataTrust <- getS storePathTrust
metadataSigs <- getS $ set narSignature
@ -1343,6 +1347,7 @@ data ReplySError
| ReplySError_PrimPut SError
| ReplySError_DerivationOutput SError
| ReplySError_GCResult SError
| ReplySError_Metadata SError
| ReplySError_Missing SError
| ReplySError_Realisation SError
| ReplySError_RealisationWithId SError
@ -1476,3 +1481,19 @@ missing = mapErrorS ReplySError_Missing $ Serializer
putS int missingDownloadSize
putS int missingNarSize
}
-- *** Maybe (Metadata StorePath)
maybePathMetadata
:: HasStoreDir r
=> NixSerializer r ReplySError (Maybe (Metadata StorePath))
maybePathMetadata = mapErrorS ReplySError_Metadata $ Serializer
{ getS = do
valid <- getS bool
if valid
then pure <$> getS pathMetadata
else pure Nothing
, putS = \case
Nothing -> putS bool False
Just pm -> putS bool True >> putS pathMetadata pm
}

View File

@ -4,6 +4,7 @@ module System.Nix.Store.Remote.Types.StoreReply
import System.Nix.Build (BuildResult)
import System.Nix.StorePath (HasStoreDir(..), StorePath)
import System.Nix.StorePath.Metadata (Metadata)
import System.Nix.Store.Remote.Serializer
import System.Nix.Store.Remote.Types.GC (GCResult)
import System.Nix.Store.Remote.Types.Query.Missing (Missing)
@ -33,6 +34,9 @@ instance StoreReply GCResult where
instance StoreReply Missing where
getReplyS = missing
instance StoreReply (Maybe (Metadata StorePath)) where
getReplyS = maybePathMetadata
instance StoreReply StorePath where
getReplyS = mapPrimE storePath

View File

@ -152,6 +152,7 @@ spec = parallel $ do
describe "StoreReply" $ do
prop "GCResult" $ roundtripSReader @StoreDir gcResult
prop "Missing" $ roundtripSReader @StoreDir missing
prop "Maybe (Metadata StorePath)" $ roundtripSReader @StoreDir maybePathMetadata
restrictProtoVersion :: ProtoVersion -> Some StoreRequest -> Bool
restrictProtoVersion v (Some (BuildPaths _ _)) | v < ProtoVersion 1 30 = False