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

View File

@ -1368,14 +1368,14 @@ mapPutER = mapErrorST ReplySError_PrimPut
-- | Parse a bool returned at the end of simple operations.
-- This is always 1 (@True@) so we assert that it really is so.
-- Errors for these operations are indicated via @Logger_Error@.
opSuccess :: NixSerializer r ReplySError ()
opSuccess :: NixSerializer r ReplySError SuccessCodeReply
opSuccess = Serializer
{ getS = do
retCode <- mapGetER $ getS bool
Control.Monad.unless
(retCode == True)
$ throwError ReplySError_UnexpectedFalseOpSuccess
pure ()
pure SuccessCodeReply
, 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.StoreText
, 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.Verbosity
, 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.StoreText
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.Verbosity
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.Metadata (Metadata)
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.Query.Missing (Missing)
import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig)
@ -20,7 +21,7 @@ import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig)
class StoreReply a where
getReplyS :: NixSerializer ProtoStoreConfig ReplySError a
instance StoreReply () where
instance StoreReply SuccessCodeReply where
getReplyS = opSuccess
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.StoreText (StoreText)
import System.Nix.Store.Remote.Types.SubstituteMode (SubstituteMode)
import System.Nix.Store.Remote.Types.SuccessCodeReply (SuccessCodeReply)
data StoreRequest :: Type -> Type where
-- | Add @NarSource@ to the store.
@ -51,18 +52,18 @@ data StoreRequest :: Type -> Type where
AddSignatures
:: StorePath
-> Set Signature
-> StoreRequest ()
-> StoreRequest SuccessCodeReply
AddIndirectRoot
:: StorePath
-> StoreRequest ()
-> StoreRequest SuccessCodeReply
-- | Add temporary garbage collector root.
--
-- This root is removed as soon as the client exits.
AddTempRoot
:: StorePath
-> StoreRequest ()
-> StoreRequest SuccessCodeReply
-- | Build paths if they are an actual derivations.
--
@ -70,7 +71,7 @@ data StoreRequest :: Type -> Type where
BuildPaths
:: Set DerivedPath
-> BuildMode
-> StoreRequest ()
-> StoreRequest SuccessCodeReply
BuildDerivation
:: StorePath
@ -84,7 +85,7 @@ data StoreRequest :: Type -> Type where
EnsurePath
:: StorePath
-> StoreRequest ()
-> StoreRequest SuccessCodeReply
-- | Find garbage collector roots.
FindRoots
@ -138,10 +139,10 @@ data StoreRequest :: Type -> Type where
-> StoreRequest Missing
OptimiseStore
:: StoreRequest ()
:: StoreRequest SuccessCodeReply
SyncWithGC
:: StoreRequest ()
:: StoreRequest SuccessCodeReply
-- returns True on errors
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)