mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +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.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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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