mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-08-17 13:51:21 +03:00
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:
parent
21040fb589
commit
d3408a60b4
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
}
|
||||
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user