remote/server: propagate errors from proxy handler

Author: sorki

hnix-store-remote/src/System/Nix/Store/Remote.hs

@@ -94,7 +94,7 @@ runStoreSocket sockFamily sockAddr code =
 
 justdoit :: Run IO (Bool, Bool)
 justdoit = do
-  runDaemonConnection handler (pure ()) (StoreConnection_Socket "/tmp/dsock") $
+  runDaemonConnection runStore (pure ()) (StoreConnection_Socket "/tmp/dsock") $
     runStoreConnection (StoreConnection_Socket "/tmp/dsock")
       $ do
         a <- isValidPath pth
@@ -108,11 +108,6 @@ justdoit = do
         def
         "/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
 
-    handler :: RemoteStoreT IO a -> IO a
-    handler k = do
-      x <- runStore k
-      either (error . show) pure (fst x)
-
 runDaemon
   :: forall m a
   . ( MonadIO m

hnix-store-remote/src/System/Nix/Store/Remote/Server.hs

@@ -20,7 +20,7 @@ import Data.Void (Void, absurd)
 import Data.Word (Word32)
 import Network.Socket (Socket, accept, close, listen, maxListenQueue)
 import System.Nix.Nar (NarSource)
-import System.Nix.Store.Remote.Client (doReq)
+import System.Nix.Store.Remote.Client (Run, doReq)
 import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
 import System.Nix.Store.Remote.Socket
 import System.Nix.Store.Remote.Types.StoreRequest as R
@@ -42,7 +42,7 @@ type WorkerHelper m
     , StoreReply a
     )
   => RemoteStoreT m a
-  -> m a
+  -> Run m a
 
 chatty :: Bool
 chatty = False
@@ -138,19 +138,22 @@ processConnection workerHelper postGreet sock = do
               pure $ setNarSource proxyNarSource
             _ -> pure $ pure ()
 
-          resp <-
+          res <-
             bracketLogger
               tunnelLogger
               $ lift
               $ workerHelper
               $ special >> doReq req
 
-          sockPutS
-            (mapErrorS
-               RemoteStoreError_SerializerReply
-               $ getReplyS
-            )
-            resp
+          case fst res of
+            Left e -> throwError e
+            Right reply ->
+              sockPutS
+                (mapErrorS
+                   RemoteStoreError_SerializerReply
+                   $ getReplyS
+                )
+                reply
 
     -- Process client requests.
     let loop = do

hnix-store-remote/tests-io/NixDaemonSpec.hs

@@ -5,7 +5,7 @@ module NixDaemonSpec
   , spec
   ) where
 
-import Control.Monad (forM_, unless, void, (<=<))
+import Control.Monad (forM_, unless, void)
 import Control.Monad.Catch (MonadMask)
 import Control.Monad.Conc.Class (MonadConc)
 import Control.Monad.IO.Class (MonadIO, liftIO)
@@ -209,9 +209,8 @@ withManInTheMiddleNixDaemon action =
     storeConn2 = StoreConnection_Socket $ StoreSocketPath sockFp2
 
     handler :: WorkerHelper m
-    handler = either (error . show) pure
-      <=< fmap fst
-      . runStoreConnection storeConn
+    handler =
+      runStoreConnection storeConn
       . (setStoreDir storeDir >>)
 
   in action $ \(mstore :: RemoteStoreT m a) ->