mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-11-30 02:51:10 +03:00
remote: add GCRoot type, serializer, prop
This commit is contained in:
parent
774590eb6e
commit
ddfdb893a6
@ -131,6 +131,7 @@ library
|
||||
, mtl
|
||||
, QuickCheck
|
||||
, unordered-containers
|
||||
, unix >= 2.7
|
||||
, vector
|
||||
hs-source-dirs: src
|
||||
ghc-options: -Wall
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user