remote: add GCRoot type, serializer, prop

This commit is contained in:
sorki 2023-12-07 10:08:44 +01:00
parent 774590eb6e
commit ddfdb893a6
7 changed files with 41 additions and 4 deletions

View File

@ -131,6 +131,7 @@ library
, mtl
, QuickCheck
, unordered-containers
, unix >= 2.7
, vector
hs-source-dirs: src
ghc-options: -Wall

View File

@ -126,5 +126,8 @@ instance Arbitrary (Some StoreRequest) where
deriving via GenericArbitrary GCResult
instance Arbitrary GCResult
deriving via GenericArbitrary GCRoot
instance Arbitrary GCRoot
deriving via GenericArbitrary Missing
instance Arbitrary Missing

View File

@ -93,6 +93,8 @@ module System.Nix.Store.Remote.Serializer
, buildResult
-- *** GCResult
, gcResult
-- *** GCResult
, gcRoot
-- *** Missing
, missing
-- *** Maybe (Metadata StorePath)
@ -126,6 +128,7 @@ import qualified Control.Monad.Reader
import qualified Data.Attoparsec.Text
import qualified Data.Bits
import qualified Data.ByteString
import qualified Data.ByteString.Char8
import qualified Data.ByteString.Lazy
import qualified Data.HashSet
import qualified Data.Map.Strict
@ -1463,6 +1466,8 @@ buildResult = Serializer
t0 :: UTCTime
t0 = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
-- *** GCResult
gcResult
:: HasStoreDir r
=> NixSerializer r ReplySError GCResult
@ -1478,6 +1483,22 @@ gcResult = mapErrorS ReplySError_GCResult $ Serializer
putS (int @Word64) 0 -- obsolete
}
-- *** GCRoot
gcRoot :: NixSerializer r ReplySError GCRoot
gcRoot = Serializer
{ getS = mapGetER $ do
getS byteString >>= \case
p | p == censored -> pure GCRoot_Censored
p -> pure (GCRoot_Path p)
, putS = mapPutER . putS byteString . \case
GCRoot_Censored -> censored
GCRoot_Path p -> p
}
where censored = Data.ByteString.Char8.pack "{censored}"
-- *** Missing
missing
:: HasStoreDir r
=> NixSerializer r ReplySError Missing

View File

@ -6,12 +6,14 @@ module System.Nix.Store.Remote.Types.GC (
GCAction(..)
, GCOptions(..)
, GCResult(..)
, GCRoot(..)
) where
import Data.HashSet (HashSet)
import Data.Word (Word64)
import GHC.Generics (Generic)
import System.Nix.StorePath (StorePath)
import System.Posix.ByteString (RawFilePath)
-- | Garbage collection action
data GCAction
@ -45,3 +47,9 @@ data GCResult = GCResult
-- - @GCAction_DeleteSpecific@
, gcResultBytesFreed :: Word64
} deriving (Eq, Generic, Ord, Show)
-- | Used as a part of the result of @FindRoots@ operation
data GCRoot
= GCRoot_Censored -- ^ Source path is censored since the user is not trusted
| GCRoot_Path RawFilePath -- ^ Raw source path
deriving (Eq, Generic, Ord, Show)

View File

@ -3,11 +3,12 @@ module System.Nix.Store.Remote.Types.StoreReply
) where
import Data.HashSet (HashSet)
import Data.Map (Map)
import System.Nix.Build (BuildResult)
import System.Nix.StorePath (HasStoreDir(..), StorePath, StorePathName)
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.GC (GCResult, GCRoot)
import System.Nix.Store.Remote.Types.Query.Missing (Missing)
import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion)
@ -35,6 +36,9 @@ instance StoreReply BuildResult where
instance StoreReply GCResult where
getReplyS = gcResult
instance StoreReply (Map GCRoot StorePath) where
getReplyS = mapS gcRoot (mapPrimE storePath)
instance StoreReply Missing where
getReplyS = missing

View File

@ -6,7 +6,6 @@ module System.Nix.Store.Remote.Types.StoreRequest
( StoreRequest(..)
) where
import Data.ByteString (ByteString)
import Data.GADT.Compare.TH (deriveGEq, deriveGCompare)
import Data.GADT.Show.TH (deriveGShow)
import Data.HashSet (HashSet)
@ -24,7 +23,7 @@ import System.Nix.Signature (Signature)
import System.Nix.Store.Types (FileIngestionMethod, RepairMode)
import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart)
import System.Nix.StorePath.Metadata (Metadata)
import System.Nix.Store.Remote.Types.GC (GCOptions, GCResult)
import System.Nix.Store.Remote.Types.GC (GCOptions, GCResult, GCRoot)
import System.Nix.Store.Remote.Types.CheckMode (CheckMode)
import System.Nix.Store.Remote.Types.Query.Missing (Missing)
import System.Nix.Store.Remote.Types.StoreText (StoreText)
@ -89,7 +88,7 @@ data StoreRequest :: Type -> Type where
-- | Find garbage collector roots.
FindRoots
:: StoreRequest (Map ByteString StorePath)
:: StoreRequest (Map GCRoot StorePath)
IsValidPath
:: StorePath

View File

@ -152,6 +152,7 @@ spec = parallel $ do
describe "StoreReply" $ do
prop "()" $ roundtripS opSuccess
prop "GCResult" $ roundtripSReader @StoreDir gcResult
prop "GCRoot" $ roundtripS gcRoot
prop "Missing" $ roundtripSReader @StoreDir missing
prop "Maybe (Metadata StorePath)" $ roundtripSReader @StoreDir maybePathMetadata