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 , mtl
, QuickCheck , QuickCheck
, unordered-containers , unordered-containers
, unix >= 2.7
, vector , vector
hs-source-dirs: src hs-source-dirs: src
ghc-options: -Wall ghc-options: -Wall

View File

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

View File

@ -93,6 +93,8 @@ module System.Nix.Store.Remote.Serializer
, buildResult , buildResult
-- *** GCResult -- *** GCResult
, gcResult , gcResult
-- *** GCResult
, gcRoot
-- *** Missing -- *** Missing
, missing , missing
-- *** Maybe (Metadata StorePath) -- *** Maybe (Metadata StorePath)
@ -126,6 +128,7 @@ import qualified Control.Monad.Reader
import qualified Data.Attoparsec.Text import qualified Data.Attoparsec.Text
import qualified Data.Bits import qualified Data.Bits
import qualified Data.ByteString import qualified Data.ByteString
import qualified Data.ByteString.Char8
import qualified Data.ByteString.Lazy import qualified Data.ByteString.Lazy
import qualified Data.HashSet import qualified Data.HashSet
import qualified Data.Map.Strict import qualified Data.Map.Strict
@ -1463,6 +1466,8 @@ buildResult = Serializer
t0 :: UTCTime t0 :: UTCTime
t0 = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0 t0 = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
-- *** GCResult
gcResult gcResult
:: HasStoreDir r :: HasStoreDir r
=> NixSerializer r ReplySError GCResult => NixSerializer r ReplySError GCResult
@ -1478,6 +1483,22 @@ gcResult = mapErrorS ReplySError_GCResult $ Serializer
putS (int @Word64) 0 -- obsolete 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 missing
:: HasStoreDir r :: HasStoreDir r
=> NixSerializer r ReplySError Missing => NixSerializer r ReplySError Missing

View File

@ -6,12 +6,14 @@ module System.Nix.Store.Remote.Types.GC (
GCAction(..) GCAction(..)
, GCOptions(..) , GCOptions(..)
, GCResult(..) , GCResult(..)
, GCRoot(..)
) where ) where
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
import Data.Word (Word64) import Data.Word (Word64)
import GHC.Generics (Generic) import GHC.Generics (Generic)
import System.Nix.StorePath (StorePath) import System.Nix.StorePath (StorePath)
import System.Posix.ByteString (RawFilePath)
-- | Garbage collection action -- | Garbage collection action
data GCAction data GCAction
@ -45,3 +47,9 @@ data GCResult = GCResult
-- - @GCAction_DeleteSpecific@ -- - @GCAction_DeleteSpecific@
, gcResultBytesFreed :: Word64 , gcResultBytesFreed :: Word64
} deriving (Eq, Generic, Ord, Show) } 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 ) where
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
import Data.Map (Map)
import System.Nix.Build (BuildResult) import System.Nix.Build (BuildResult)
import System.Nix.StorePath (HasStoreDir(..), StorePath, StorePathName) import System.Nix.StorePath (HasStoreDir(..), StorePath, StorePathName)
import System.Nix.StorePath.Metadata (Metadata) 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, GCRoot)
import System.Nix.Store.Remote.Types.Query.Missing (Missing) import System.Nix.Store.Remote.Types.Query.Missing (Missing)
import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion) import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion)
@ -35,6 +36,9 @@ instance StoreReply BuildResult where
instance StoreReply GCResult where instance StoreReply GCResult where
getReplyS = gcResult getReplyS = gcResult
instance StoreReply (Map GCRoot StorePath) where
getReplyS = mapS gcRoot (mapPrimE storePath)
instance StoreReply Missing where instance StoreReply Missing where
getReplyS = missing getReplyS = missing

View File

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

View File

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