mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +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
|
, storeRequest
|
||||||
-- ** Reply
|
-- ** Reply
|
||||||
, ReplySError(..)
|
, ReplySError(..)
|
||||||
|
, opSuccess
|
||||||
-- *** Realisation
|
-- *** Realisation
|
||||||
, derivationOutputTyped
|
, derivationOutputTyped
|
||||||
, realisation
|
, realisation
|
||||||
@ -1340,7 +1341,7 @@ storeRequest = Serializer
|
|||||||
-> m a
|
-> m a
|
||||||
reserved = throwError . RequestSError_ReservedOp
|
reserved = throwError . RequestSError_ReservedOp
|
||||||
|
|
||||||
-- * Reply
|
-- ** Reply
|
||||||
|
|
||||||
data ReplySError
|
data ReplySError
|
||||||
= ReplySError_PrimGet SError
|
= ReplySError_PrimGet SError
|
||||||
@ -1351,6 +1352,7 @@ data ReplySError
|
|||||||
| ReplySError_Missing SError
|
| ReplySError_Missing SError
|
||||||
| ReplySError_Realisation SError
|
| ReplySError_Realisation SError
|
||||||
| ReplySError_RealisationWithId SError
|
| ReplySError_RealisationWithId SError
|
||||||
|
| ReplySError_UnexpectedFalseOpSuccess
|
||||||
deriving (Eq, Ord, Generic, Show)
|
deriving (Eq, Ord, Generic, Show)
|
||||||
|
|
||||||
mapGetER
|
mapGetER
|
||||||
@ -1365,6 +1367,20 @@ mapPutER
|
|||||||
-> SerialT r ReplySError m a
|
-> SerialT r ReplySError m a
|
||||||
mapPutER = mapErrorST ReplySError_PrimPut
|
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
|
-- *** Realisation
|
||||||
|
|
||||||
derivationOutputTyped :: NixSerializer r ReplySError (System.Nix.Realisation.DerivationOutput OutputName)
|
derivationOutputTyped :: NixSerializer r ReplySError (System.Nix.Realisation.DerivationOutput OutputName)
|
||||||
|
@ -22,6 +22,9 @@ class StoreReply a where
|
|||||||
)
|
)
|
||||||
=> NixSerializer r ReplySError a
|
=> NixSerializer r ReplySError a
|
||||||
|
|
||||||
|
instance StoreReply () where
|
||||||
|
getReplyS = opSuccess
|
||||||
|
|
||||||
instance StoreReply Bool where
|
instance StoreReply Bool where
|
||||||
getReplyS = mapPrimE bool
|
getReplyS = mapPrimE bool
|
||||||
|
|
||||||
|
@ -150,6 +150,7 @@ spec = parallel $ do
|
|||||||
$ roundtripSReader @TestStoreConfig storeRequest testStoreConfig
|
$ roundtripSReader @TestStoreConfig storeRequest testStoreConfig
|
||||||
|
|
||||||
describe "StoreReply" $ do
|
describe "StoreReply" $ do
|
||||||
|
prop "()" $ roundtripS opSuccess
|
||||||
prop "GCResult" $ roundtripSReader @StoreDir gcResult
|
prop "GCResult" $ roundtripSReader @StoreDir gcResult
|
||||||
prop "Missing" $ roundtripSReader @StoreDir missing
|
prop "Missing" $ roundtripSReader @StoreDir missing
|
||||||
prop "Maybe (Metadata StorePath)" $ roundtripSReader @StoreDir maybePathMetadata
|
prop "Maybe (Metadata StorePath)" $ roundtripSReader @StoreDir maybePathMetadata
|
||||||
|
Loading…
Reference in New Issue
Block a user