diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs index 274aa67..e8d951a 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Serializer.hs @@ -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) diff --git a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs index 6bf1d15..e022ad5 100644 --- a/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs +++ b/hnix-store-remote/src/System/Nix/Store/Remote/Types/StoreReply.hs @@ -22,6 +22,9 @@ class StoreReply a where ) => NixSerializer r ReplySError a +instance StoreReply () where + getReplyS = opSuccess + instance StoreReply Bool where getReplyS = mapPrimE bool diff --git a/hnix-store-remote/tests/NixSerializerSpec.hs b/hnix-store-remote/tests/NixSerializerSpec.hs index df9082a..3fbf698 100644 --- a/hnix-store-remote/tests/NixSerializerSpec.hs +++ b/hnix-store-remote/tests/NixSerializerSpec.hs @@ -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