remote: add SuccessCodeReply

Add SuccessCodeReply to replace instances of the () reply type.

The serialization behavior is more clear with the more explicit type.
This commit is contained in:
squalus 2023-12-12 14:57:22 -08:00
parent 21040fb589
commit d3408a60b4
7 changed files with 31 additions and 18 deletions

View File

@ -93,6 +93,7 @@ library
, System.Nix.Store.Remote.Types.StoreReply , System.Nix.Store.Remote.Types.StoreReply
, System.Nix.Store.Remote.Types.StoreText , System.Nix.Store.Remote.Types.StoreText
, System.Nix.Store.Remote.Types.SubstituteMode , System.Nix.Store.Remote.Types.SubstituteMode
, System.Nix.Store.Remote.Types.SuccessCodeReply
, System.Nix.Store.Remote.Types.TrustedFlag , System.Nix.Store.Remote.Types.TrustedFlag
, System.Nix.Store.Remote.Types.Verbosity , System.Nix.Store.Remote.Types.Verbosity
, System.Nix.Store.Remote.Types.WorkerMagic , System.Nix.Store.Remote.Types.WorkerMagic

View File

@ -26,7 +26,7 @@ module System.Nix.Store.Remote.Client
, module System.Nix.Store.Remote.Client.Core , module System.Nix.Store.Remote.Client.Core
) where ) where
import Control.Monad (when) import Control.Monad (void, when)
import Control.Monad.Except (throwError) import Control.Monad.Except (throwError)
import Data.HashSet (HashSet) import Data.HashSet (HashSet)
import Data.Map (Map) import Data.Map (Map)
@ -96,7 +96,7 @@ addSignatures
=> StorePath => StorePath
-> Set Signature -> Set Signature
-> m () -> m ()
addSignatures p signatures = doReq (AddSignatures p signatures) addSignatures p signatures = (void . doReq) (AddSignatures p signatures)
-- | Add temporary garbage collector root. -- | Add temporary garbage collector root.
-- --
@ -105,14 +105,14 @@ addTempRoot
:: MonadRemoteStore m :: MonadRemoteStore m
=> StorePath => StorePath
-> m () -> m ()
addTempRoot = doReq . AddTempRoot addTempRoot = void . doReq . AddTempRoot
-- | Add indirect garbage collector root. -- | Add indirect garbage collector root.
addIndirectRoot addIndirectRoot
:: MonadRemoteStore m :: MonadRemoteStore m
=> StorePath => StorePath
-> m () -> m ()
addIndirectRoot = doReq . AddIndirectRoot addIndirectRoot = void . doReq . AddIndirectRoot
-- | Build a derivation available at @StorePath@ -- | Build a derivation available at @StorePath@
buildDerivation buildDerivation
@ -139,7 +139,7 @@ buildPaths
=> Set DerivedPath => Set DerivedPath
-> BuildMode -> BuildMode
-> m () -> m ()
buildPaths a b = doReq (BuildPaths a b) buildPaths a b = (void . doReq) (BuildPaths a b)
collectGarbage collectGarbage
:: MonadRemoteStore m :: MonadRemoteStore m
@ -151,7 +151,7 @@ ensurePath
:: MonadRemoteStore m :: MonadRemoteStore m
=> StorePath => StorePath
-> m () -> m ()
ensurePath = doReq . EnsurePath ensurePath = void . doReq . EnsurePath
-- | Find garbage collector roots. -- | Find garbage collector roots.
findRoots findRoots
@ -235,12 +235,12 @@ queryMissing = doReq . QueryMissing
optimiseStore optimiseStore
:: MonadRemoteStore m :: MonadRemoteStore m
=> m () => m ()
optimiseStore = doReq OptimiseStore optimiseStore = (void . doReq) OptimiseStore
syncWithGC syncWithGC
:: MonadRemoteStore m :: MonadRemoteStore m
=> m () => m ()
syncWithGC = doReq SyncWithGC syncWithGC = (void . doReq) SyncWithGC
verifyStore verifyStore
:: MonadRemoteStore m :: MonadRemoteStore m

View File

@ -1368,14 +1368,14 @@ mapPutER = mapErrorST ReplySError_PrimPut
-- | Parse a bool returned at the end of simple operations. -- | Parse a bool returned at the end of simple operations.
-- This is always 1 (@True@) so we assert that it really is so. -- This is always 1 (@True@) so we assert that it really is so.
-- Errors for these operations are indicated via @Logger_Error@. -- Errors for these operations are indicated via @Logger_Error@.
opSuccess :: NixSerializer r ReplySError () opSuccess :: NixSerializer r ReplySError SuccessCodeReply
opSuccess = Serializer opSuccess = Serializer
{ getS = do { getS = do
retCode <- mapGetER $ getS bool retCode <- mapGetER $ getS bool
Control.Monad.unless Control.Monad.unless
(retCode == True) (retCode == True)
$ throwError ReplySError_UnexpectedFalseOpSuccess $ throwError ReplySError_UnexpectedFalseOpSuccess
pure () pure SuccessCodeReply
, putS = \_ -> mapPutER $ putS bool True , putS = \_ -> mapPutER $ putS bool True
} }

View File

@ -9,6 +9,7 @@ module System.Nix.Store.Remote.Types
, module System.Nix.Store.Remote.Types.StoreRequest , module System.Nix.Store.Remote.Types.StoreRequest
, module System.Nix.Store.Remote.Types.StoreText , module System.Nix.Store.Remote.Types.StoreText
, module System.Nix.Store.Remote.Types.SubstituteMode , module System.Nix.Store.Remote.Types.SubstituteMode
, module System.Nix.Store.Remote.Types.SuccessCodeReply
, module System.Nix.Store.Remote.Types.TrustedFlag , module System.Nix.Store.Remote.Types.TrustedFlag
, module System.Nix.Store.Remote.Types.Verbosity , module System.Nix.Store.Remote.Types.Verbosity
, module System.Nix.Store.Remote.Types.WorkerMagic , module System.Nix.Store.Remote.Types.WorkerMagic
@ -25,6 +26,7 @@ import System.Nix.Store.Remote.Types.StoreConfig
import System.Nix.Store.Remote.Types.StoreRequest import System.Nix.Store.Remote.Types.StoreRequest
import System.Nix.Store.Remote.Types.StoreText import System.Nix.Store.Remote.Types.StoreText
import System.Nix.Store.Remote.Types.SubstituteMode import System.Nix.Store.Remote.Types.SubstituteMode
import System.Nix.Store.Remote.Types.SuccessCodeReply
import System.Nix.Store.Remote.Types.TrustedFlag import System.Nix.Store.Remote.Types.TrustedFlag
import System.Nix.Store.Remote.Types.Verbosity import System.Nix.Store.Remote.Types.Verbosity
import System.Nix.Store.Remote.Types.WorkerMagic import System.Nix.Store.Remote.Types.WorkerMagic

View File

@ -8,6 +8,7 @@ import System.Nix.Build (BuildResult)
import System.Nix.StorePath (StorePath, StorePathName) import System.Nix.StorePath (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.SuccessCodeReply (SuccessCodeReply)
import System.Nix.Store.Remote.Types.GC (GCResult, GCRoot) 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.StoreConfig (ProtoStoreConfig) import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig)
@ -20,7 +21,7 @@ import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig)
class StoreReply a where class StoreReply a where
getReplyS :: NixSerializer ProtoStoreConfig ReplySError a getReplyS :: NixSerializer ProtoStoreConfig ReplySError a
instance StoreReply () where instance StoreReply SuccessCodeReply where
getReplyS = opSuccess getReplyS = opSuccess
instance StoreReply Bool where instance StoreReply Bool where

View File

@ -28,6 +28,7 @@ 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)
import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode) import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode)
import System.Nix.Store.Remote.Types.SuccessCodeReply (SuccessCodeReply)
data StoreRequest :: Type -> Type where data StoreRequest :: Type -> Type where
-- | Add @NarSource@ to the store. -- | Add @NarSource@ to the store.
@ -51,18 +52,18 @@ data StoreRequest :: Type -> Type where
AddSignatures AddSignatures
:: StorePath :: StorePath
-> Set Signature -> Set Signature
-> StoreRequest () -> StoreRequest SuccessCodeReply
AddIndirectRoot AddIndirectRoot
:: StorePath :: StorePath
-> StoreRequest () -> StoreRequest SuccessCodeReply
-- | Add temporary garbage collector root. -- | Add temporary garbage collector root.
-- --
-- This root is removed as soon as the client exits. -- This root is removed as soon as the client exits.
AddTempRoot AddTempRoot
:: StorePath :: StorePath
-> StoreRequest () -> StoreRequest SuccessCodeReply
-- | Build paths if they are an actual derivations. -- | Build paths if they are an actual derivations.
-- --
@ -70,7 +71,7 @@ data StoreRequest :: Type -> Type where
BuildPaths BuildPaths
:: Set DerivedPath :: Set DerivedPath
-> BuildMode -> BuildMode
-> StoreRequest () -> StoreRequest SuccessCodeReply
BuildDerivation BuildDerivation
:: StorePath :: StorePath
@ -84,7 +85,7 @@ data StoreRequest :: Type -> Type where
EnsurePath EnsurePath
:: StorePath :: StorePath
-> StoreRequest () -> StoreRequest SuccessCodeReply
-- | Find garbage collector roots. -- | Find garbage collector roots.
FindRoots FindRoots
@ -138,10 +139,10 @@ data StoreRequest :: Type -> Type where
-> StoreRequest Missing -> StoreRequest Missing
OptimiseStore OptimiseStore
:: StoreRequest () :: StoreRequest SuccessCodeReply
SyncWithGC SyncWithGC
:: StoreRequest () :: StoreRequest SuccessCodeReply
-- returns True on errors -- returns True on errors
VerifyStore VerifyStore

View File

@ -0,0 +1,8 @@
module System.Nix.Store.Remote.Types.SuccessCodeReply
( SuccessCodeReply(..)
) where
-- | Reply that checks an int success return value
data SuccessCodeReply = SuccessCodeReply
deriving (Show)