mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
remote: add Types.StoreText, use in AddTextToStore
This commit is contained in:
parent
7f9c7fb2eb
commit
0ab79e5157
@ -90,6 +90,7 @@ library
|
||||
, System.Nix.Store.Remote.Types.Logger
|
||||
, System.Nix.Store.Remote.Types.ProtoVersion
|
||||
, System.Nix.Store.Remote.Types.StoreConfig
|
||||
, System.Nix.Store.Remote.Types.StoreText
|
||||
, System.Nix.Store.Remote.Types.SubstituteMode
|
||||
, System.Nix.Store.Remote.Types.Verbosity
|
||||
, System.Nix.Store.Remote.Types.WorkerMagic
|
||||
|
@ -21,6 +21,9 @@ deriving via GenericArbitrary SubstituteMode
|
||||
deriving via GenericArbitrary ProtoVersion
|
||||
instance Arbitrary ProtoVersion
|
||||
|
||||
deriving via GenericArbitrary StoreText
|
||||
instance Arbitrary StoreText
|
||||
|
||||
-- * Logger
|
||||
|
||||
deriving via GenericArbitrary Activity
|
||||
@ -56,7 +59,7 @@ deriving via GenericArbitrary Verbosity
|
||||
instance Arbitrary (Some StoreRequest) where
|
||||
arbitrary = oneof
|
||||
[ Some <$> (AddToStore <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)
|
||||
, Some <$> (AddTextToStore <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary)
|
||||
, Some <$> (AddTextToStore <$> arbitrary <*> arbitrary <*> arbitrary)
|
||||
, Some <$> (AddSignatures <$> arbitrary <*> arbitrary)
|
||||
, Some . AddIndirectRoot <$> arbitrary
|
||||
, Some . AddTempRoot <$> arbitrary
|
||||
|
@ -24,6 +24,7 @@ import System.Nix.Store.Types (RepairMode)
|
||||
import System.Nix.StorePath (StorePath, StorePathName, StorePathHashPart)
|
||||
import System.Nix.StorePath.Metadata (Metadata)
|
||||
import System.Nix.Store.Remote.Types.CheckMode (CheckMode)
|
||||
import System.Nix.Store.Remote.Types.StoreText (StoreText)
|
||||
import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode)
|
||||
|
||||
data StoreRequest :: Type -> Type where
|
||||
@ -49,8 +50,7 @@ data StoreRequest :: Type -> Type where
|
||||
-- Reference accepts repair but only uses it
|
||||
-- to throw error in case of remote talking to nix-daemon.
|
||||
AddTextToStore
|
||||
:: Text -- ^ Name of the text
|
||||
-> Text -- ^ Actual text to add
|
||||
:: StoreText
|
||||
-> HashSet StorePath -- ^ Set of @StorePath@s that the added text references
|
||||
-> RepairMode -- ^ Repair mode, must be @RepairMode_DontRepair@ in case of remote backend
|
||||
-> StoreRequest StorePath
|
||||
@ -167,7 +167,7 @@ deriveGShow ''StoreRequest
|
||||
|
||||
instance {-# OVERLAPPING #-} Eq (Some StoreRequest) where
|
||||
Some (AddToStore a b c d) == Some (AddToStore a' b' c' d') = (a, b, c, d) == (a', b', c', d')
|
||||
Some (AddTextToStore a b c d) == Some (AddTextToStore a' b' c' d') = (a, b, c, d) == (a', b', c', d')
|
||||
Some (AddTextToStore a b c) == Some (AddTextToStore a' b' c') = (a, b, c) == (a', b', c')
|
||||
Some (AddSignatures a b) == Some (AddSignatures a' b') = (a, b) == (a', b')
|
||||
Some (AddIndirectRoot a) == Some (AddIndirectRoot a') = a == a'
|
||||
Some (AddTempRoot a) == Some (AddTempRoot a') = a == a'
|
||||
|
@ -67,6 +67,7 @@ module System.Nix.Store.Remote.Serializer
|
||||
, HandshakeSError(..)
|
||||
, workerMagic
|
||||
-- * Worker protocol
|
||||
, storeText
|
||||
, workerOp
|
||||
) where
|
||||
|
||||
@ -927,6 +928,17 @@ workerMagic = Serializer
|
||||
|
||||
-- * Worker protocol
|
||||
|
||||
storeText :: NixSerializer r SError StoreText
|
||||
storeText = Serializer
|
||||
{ getS = do
|
||||
storeTextName <- getS storePathName
|
||||
storeTextText <- getS text
|
||||
pure StoreText{..}
|
||||
, putS = \StoreText{..} -> do
|
||||
putS storePathName storeTextName
|
||||
putS text storeTextText
|
||||
}
|
||||
|
||||
workerOp :: NixSerializer r SError WorkerOp
|
||||
workerOp = enum
|
||||
|
||||
|
@ -5,6 +5,7 @@ module System.Nix.Store.Remote.Types
|
||||
, module System.Nix.Store.Remote.Types.Logger
|
||||
, module System.Nix.Store.Remote.Types.ProtoVersion
|
||||
, module System.Nix.Store.Remote.Types.StoreConfig
|
||||
, module System.Nix.Store.Remote.Types.StoreText
|
||||
, module System.Nix.Store.Remote.Types.SubstituteMode
|
||||
, module System.Nix.Store.Remote.Types.Verbosity
|
||||
, module System.Nix.Store.Remote.Types.WorkerMagic
|
||||
@ -17,6 +18,7 @@ import System.Nix.Store.Remote.Types.CheckMode
|
||||
import System.Nix.Store.Remote.Types.Logger
|
||||
import System.Nix.Store.Remote.Types.ProtoVersion
|
||||
import System.Nix.Store.Remote.Types.StoreConfig
|
||||
import System.Nix.Store.Remote.Types.StoreText
|
||||
import System.Nix.Store.Remote.Types.SubstituteMode
|
||||
import System.Nix.Store.Remote.Types.Verbosity
|
||||
import System.Nix.Store.Remote.Types.WorkerMagic
|
||||
|
@ -0,0 +1,12 @@
|
||||
module System.Nix.Store.Remote.Types.StoreText
|
||||
( StoreText(..)
|
||||
) where
|
||||
|
||||
import Data.Text (Text)
|
||||
import GHC.Generics (Generic)
|
||||
import System.Nix.StorePath (StorePathName)
|
||||
|
||||
data StoreText = StoreText
|
||||
{ storeTextName :: StorePathName
|
||||
, storeTextText :: Text
|
||||
} deriving (Eq, Generic, Ord, Show)
|
@ -167,6 +167,9 @@ spec = parallel $ do
|
||||
it' "IsValidPath" WorkerOp_IsValidPath 1
|
||||
it' "BuildPathsWithResults" WorkerOp_BuildPathsWithResults 46
|
||||
|
||||
describe "Worker protocol" $ do
|
||||
prop "StoreText" $ roundtripS storeText
|
||||
|
||||
errorInfoIf :: Bool -> Logger -> Bool
|
||||
errorInfoIf True (Logger_Error (Right x)) = noJust0s x
|
||||
where
|
||||
|
Loading…
Reference in New Issue
Block a user