remote: add opSuccess serializer for StoreReply ()

This commit is contained in:
sorki 2023-12-07 09:13:24 +01:00
parent 48697e1efe
commit 04a38e8c46
3 changed files with 21 additions and 1 deletions

View File

@ -84,6 +84,7 @@ module System.Nix.Store.Remote.Serializer
, storeRequest
-- ** Reply
, ReplySError(..)
, opSuccess
-- *** Realisation
, derivationOutputTyped
, realisation
@ -1340,7 +1341,7 @@ storeRequest = Serializer
-> m a
reserved = throwError . RequestSError_ReservedOp
-- * Reply
-- ** Reply
data ReplySError
= ReplySError_PrimGet SError
@ -1351,6 +1352,7 @@ data ReplySError
| ReplySError_Missing SError
| ReplySError_Realisation SError
| ReplySError_RealisationWithId SError
| ReplySError_UnexpectedFalseOpSuccess
deriving (Eq, Ord, Generic, Show)
mapGetER
@ -1365,6 +1367,20 @@ mapPutER
-> SerialT r ReplySError m a
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 = Serializer
{ getS = do
retCode <- mapGetER $ getS bool
Control.Monad.unless
(retCode == True)
$ throwError ReplySError_UnexpectedFalseOpSuccess
pure ()
, putS = \_ -> mapPutER $ putS bool True
}
-- *** Realisation
derivationOutputTyped :: NixSerializer r ReplySError (System.Nix.Realisation.DerivationOutput OutputName)

View File

@ -22,6 +22,9 @@ class StoreReply a where
)
=> NixSerializer r ReplySError a
instance StoreReply () where
getReplyS = opSuccess
instance StoreReply Bool where
getReplyS = mapPrimE bool

View File

@ -150,6 +150,7 @@ spec = parallel $ do
$ roundtripSReader @TestStoreConfig storeRequest testStoreConfig
describe "StoreReply" $ do
prop "()" $ roundtripS opSuccess
prop "GCResult" $ roundtripSReader @StoreDir gcResult
prop "Missing" $ roundtripSReader @StoreDir missing
prop "Maybe (Metadata StorePath)" $ roundtripSReader @StoreDir maybePathMetadata