remote: add GCRoot type, serializer, prop

Author: sorki

hnix-store-remote/hnix-store-remote.cabal

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

hnix-store-remote/src/System/Nix/Store/Remote/Arbitrary.hs

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

hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs

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

hnix-store-remote/src/System/Nix/Store/Remote/Types/GC.hs

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

hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs

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

hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreRequest.hs

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

hnix-store-remote/tests/NixSerializerSpec.hs

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