mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-11-30 02:51:10 +03:00
remote: add opSuccess serializer for StoreReply ()
This commit is contained in:
parent
48697e1efe
commit
04a38e8c46
@ -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)
|
||||
|
@ -22,6 +22,9 @@ class StoreReply a where
|
||||
)
|
||||
=> NixSerializer r ReplySError a
|
||||
|
||||
instance StoreReply () where
|
||||
getReplyS = opSuccess
|
||||
|
||||
instance StoreReply Bool where
|
||||
getReplyS = mapPrimE bool
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user