remote: add opSuccess serializer for StoreReply ()

Author: sorki

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)

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
 

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