mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
remote: add maybePathMetadata serializer
This commit is contained in:
parent
d18a014103
commit
48697e1efe
@ -94,6 +94,8 @@ module System.Nix.Store.Remote.Serializer
|
|||||||
, gcResult
|
, gcResult
|
||||||
-- *** Missing
|
-- *** Missing
|
||||||
, missing
|
, missing
|
||||||
|
-- *** Maybe (Metadata StorePath)
|
||||||
|
, maybePathMetadata
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Except (MonadError, throwError, )
|
import Control.Monad.Except (MonadError, throwError, )
|
||||||
@ -562,9 +564,11 @@ pathMetadata = Serializer
|
|||||||
|
|
||||||
metadataReferences <- getS $ hashSet storePath
|
metadataReferences <- getS $ hashSet storePath
|
||||||
metadataRegistrationTime <- getS time
|
metadataRegistrationTime <- getS time
|
||||||
metadataNarBytes <- (\case
|
metadataNarBytes <-
|
||||||
0 -> Nothing
|
(\case
|
||||||
size -> Just size) <$> getS int
|
0 -> Nothing
|
||||||
|
size -> Just size
|
||||||
|
) <$> getS int
|
||||||
metadataTrust <- getS storePathTrust
|
metadataTrust <- getS storePathTrust
|
||||||
|
|
||||||
metadataSigs <- getS $ set narSignature
|
metadataSigs <- getS $ set narSignature
|
||||||
@ -1343,6 +1347,7 @@ data ReplySError
|
|||||||
| ReplySError_PrimPut SError
|
| ReplySError_PrimPut SError
|
||||||
| ReplySError_DerivationOutput SError
|
| ReplySError_DerivationOutput SError
|
||||||
| ReplySError_GCResult SError
|
| ReplySError_GCResult SError
|
||||||
|
| ReplySError_Metadata SError
|
||||||
| ReplySError_Missing SError
|
| ReplySError_Missing SError
|
||||||
| ReplySError_Realisation SError
|
| ReplySError_Realisation SError
|
||||||
| ReplySError_RealisationWithId SError
|
| ReplySError_RealisationWithId SError
|
||||||
@ -1476,3 +1481,19 @@ missing = mapErrorS ReplySError_Missing $ Serializer
|
|||||||
putS int missingDownloadSize
|
putS int missingDownloadSize
|
||||||
putS int missingNarSize
|
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
|
||||||
|
}
|
||||||
|
@ -4,6 +4,7 @@ module System.Nix.Store.Remote.Types.StoreReply
|
|||||||
|
|
||||||
import System.Nix.Build (BuildResult)
|
import System.Nix.Build (BuildResult)
|
||||||
import System.Nix.StorePath (HasStoreDir(..), StorePath)
|
import System.Nix.StorePath (HasStoreDir(..), StorePath)
|
||||||
|
import System.Nix.StorePath.Metadata (Metadata)
|
||||||
import System.Nix.Store.Remote.Serializer
|
import System.Nix.Store.Remote.Serializer
|
||||||
import System.Nix.Store.Remote.Types.GC (GCResult)
|
import System.Nix.Store.Remote.Types.GC (GCResult)
|
||||||
import System.Nix.Store.Remote.Types.Query.Missing (Missing)
|
import System.Nix.Store.Remote.Types.Query.Missing (Missing)
|
||||||
@ -33,6 +34,9 @@ instance StoreReply GCResult where
|
|||||||
instance StoreReply Missing where
|
instance StoreReply Missing where
|
||||||
getReplyS = missing
|
getReplyS = missing
|
||||||
|
|
||||||
|
instance StoreReply (Maybe (Metadata StorePath)) where
|
||||||
|
getReplyS = maybePathMetadata
|
||||||
|
|
||||||
instance StoreReply StorePath where
|
instance StoreReply StorePath where
|
||||||
getReplyS = mapPrimE storePath
|
getReplyS = mapPrimE storePath
|
||||||
|
|
||||||
|
@ -152,6 +152,7 @@ spec = parallel $ do
|
|||||||
describe "StoreReply" $ do
|
describe "StoreReply" $ do
|
||||||
prop "GCResult" $ roundtripSReader @StoreDir gcResult
|
prop "GCResult" $ roundtripSReader @StoreDir gcResult
|
||||||
prop "Missing" $ roundtripSReader @StoreDir missing
|
prop "Missing" $ roundtripSReader @StoreDir missing
|
||||||
|
prop "Maybe (Metadata StorePath)" $ roundtripSReader @StoreDir maybePathMetadata
|
||||||
|
|
||||||
restrictProtoVersion :: ProtoVersion -> Some StoreRequest -> Bool
|
restrictProtoVersion :: ProtoVersion -> Some StoreRequest -> Bool
|
||||||
restrictProtoVersion v (Some (BuildPaths _ _)) | v < ProtoVersion 1 30 = False
|
restrictProtoVersion v (Some (BuildPaths _ _)) | v < ProtoVersion 1 30 = False
|
||||||
|
Loading…
Reference in New Issue
Block a user