hnix-store-remote: Remove ExceptT, use DList to accumulate log.

.gitignore

@@ -1,3 +1,4 @@
 dist
 dist-newstyle
 .ghc.environment*
+cabal.project.local

hnix-store-remote/hnix-store-remote.cabal

@@ -26,6 +26,7 @@ library
                      , binary
                      , bytestring
                      , containers
+                     , dlist
                      , text
                      , unix
                      , network

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

@@ -4,9 +4,16 @@ module System.Nix.Store.Remote.Logger (
   , processOutput)
   where
 
+import           Control.Exception
+
 import           Control.Monad.Reader      (ask, liftIO)
+import           Control.Monad.State       (modify)
 import           Data.Binary.Get
 
+import qualified Data.ByteString.Lazy.Char8 as LBS
+
+import           Data.DList                (snoc)
+
 import           Network.Socket.ByteString (recv)
 
 import           System.Nix.Store.Remote.Types
@@ -26,25 +33,24 @@ controlParser = do
     0x52534c54 -> Result        <$> getInt <*> getInt <*> getFields
     x          -> fail           $ "Invalid control message received:" ++ show x
 
-processOutput :: MonadStore [Logger]
+processOutput :: MonadStore ()
 processOutput = go decoder
   where decoder = runGetIncremental controlParser
-        go :: Decoder Logger -> MonadStore [Logger]
+        go :: Decoder Logger -> MonadStore ()
         go (Done _leftover _consumed ctrl) = do
           case ctrl of
-            e@(Error _ _) -> return [e]
-            Last -> return [Last]
+            Error i e -> liftIO (throwIO (ProtocolError i (LBS.unpack e)))
+            Last -> modify (`snoc` Last)
             -- we should probably handle Read here as well
             x -> do
-              next <- go decoder
-              return $ x:next
+              modify (`snoc` x)
+              go decoder
         go (Partial k) = do
           soc <- ask
           chunk <- liftIO (Just <$> recv soc 8)
           go (k chunk)
-
-        go (Fail _leftover _consumed msg) = do
-          error msg
+        go (Fail _leftover _consumed msg) =
+          liftIO (throwIO (ParseError msg))
 
 getFields :: Get [Field]
 getFields = do

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

@@ -4,6 +4,7 @@ module System.Nix.Store.Remote.Protocol (
   , simpleOpArgs
   , runOp
   , runOpArgs
+  , runOpArgsDebug
   , runStore) where
 
 import           Control.Exception         (bracket)
@@ -13,12 +14,15 @@ import           Control.Monad.State
 
 import           Data.Binary.Get
 import           Data.Binary.Put
-import qualified Data.ByteString.Char8     as BSC
 import qualified Data.ByteString.Lazy      as LBS
 
-import           Network.Socket            hiding (send, sendTo, recv, recvFrom)
+import           Data.DList                (toList)
+
+import           Network.Socket
 import           Network.Socket.ByteString (recv)
 
+import           System.IO
+
 import           System.Nix.Store.Remote.Logger
 import           System.Nix.Store.Remote.Types
 import           System.Nix.Store.Remote.Util
@@ -114,38 +118,28 @@ simpleOp op = do
 simpleOpArgs :: WorkerOp -> Put -> MonadStore Bool
 simpleOpArgs op args = do
   runOpArgs op args
-  err <- gotError
-  case err of
-    True -> do
-      Error _num msg <- head <$> getError
-      throwError $ BSC.unpack $ LBS.toStrict msg
-    False -> do
-      sockGetBool
+  sockGetBool
 
 runOp :: WorkerOp -> MonadStore ()
 runOp op = runOpArgs op $ return ()
 
 runOpArgs :: WorkerOp -> Put -> MonadStore ()
 runOpArgs op args = do
 
-  -- Temporary hack for printing the messages destined for nix-daemon socket
-  when False $
-    liftIO $ LBS.writeFile "mytestfile2" $ runPut $ do
-      putInt $ opNum op
-      args
-
   sockPut $ do
     putInt $ opNum op
     args
 
-  out <- processOutput
-  modify (++out)
-  err <- gotError
-  when err $ do
-    Error _num msg <- head <$> getError
-    throwError $ BSC.unpack $ LBS.toStrict msg
+  processOutput
+  -- modify (++out)
+
+-- | Writes all sent messages to stderr.
+runOpArgsDebug :: WorkerOp -> Put -> MonadStore ()
+runOpArgsDebug op args = do
+    liftIO $ LBS.hPutStr stderr (runPut (putInt (opNum op) *> args))
+    runOpArgs op args
 
-runStore :: MonadStore a -> IO (Either String a, [Logger])
+runStore :: MonadStore a -> IO (a, [Logger])
 runStore code = do
   bracket (open sockPath) close run
   where
@@ -157,6 +151,7 @@ runStore code = do
       sockPut $ putInt workerMagic1
       soc <- ask
       vermagic <- liftIO $ recv soc 16
+      -- todo: better checks here
       let (magic2, daemonProtoVersion) = flip runGet (LBS.fromStrict vermagic) $ (,) <$> getInt <*> getInt
       unless (magic2 == workerMagic2) $ error "Worker magic 2 mismatch"
 
@@ -166,5 +161,8 @@ runStore code = do
 
       processOutput
 
-    run sock =
-      flip runReaderT sock $ flip runStateT [] $ runExceptT (greet >> code)
+    run sock = do
+      (a, dl) <- flip runReaderT sock $
+                 flip runStateT mempty $
+                 (greet >> code)
+      pure (a, toList dl)

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

@@ -1,20 +1,32 @@
 module System.Nix.Store.Remote.Types (
     MonadStore
+  , NixRemoteError(..)
+  , ActivityID
+  , ActivityParentID
+  , ActivityType
+  , Verbosity
+  , ResultType
   , Logger(..)
   , Field(..)
-  , getLog
   , flushLog
-  , gotError
-  , getError) where
+  ) where
 
+import Control.Exception
 
 import qualified Data.ByteString.Lazy      as LBS
+import           Data.DList
 import           Network.Socket            (Socket)
-import           Control.Monad.Except
 import           Control.Monad.Reader
 import           Control.Monad.State
 
-type MonadStore a = ExceptT String (StateT [Logger] (ReaderT Socket IO)) a
+type MonadStore a = StateT (DList Logger) (ReaderT Socket IO) a
+
+-- | Exceptions that may be thrown while interacting with the nix-daemon.
+data NixRemoteError = ParseError String
+                    | ProtocolError Int String
+                    deriving (Show)
+
+instance Exception NixRemoteError
 
 type ActivityID = Int
 type ActivityParentID = Int
@@ -36,18 +48,5 @@ data Logger =
   | Result        ActivityID ResultType [Field]
   deriving (Eq, Ord, Show)
 
-isError :: Logger -> Bool
-isError (Error _ _) = True
-isError _           = False
-
-gotError :: MonadStore Bool
-gotError = any isError <$> get
-
-getError :: MonadStore [Logger]
-getError = filter isError <$> get
-
-getLog :: MonadStore [Logger]
-getLog = get
-
 flushLog :: MonadStore ()
-flushLog = put []
+flushLog = put mempty

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

@@ -2,20 +2,17 @@ module System.Nix.Store.Remote.Util where
 
 import           Control.Monad.Reader
 
-import           Data.Maybe
 import           Data.Binary.Get
 import           Data.Binary.Put
 import           Data.Text                 (Text)
 import qualified Data.Text                 as T
 import qualified Data.ByteString           as B
 import qualified Data.ByteString.Char8     as BSC
 import qualified Data.ByteString.Lazy      as LBS
-import qualified Data.HashSet              as HashSet
 
 import           Network.Socket.ByteString (recv, sendAll)
 
 import           System.Nix.Store.Remote.Types
-import           System.Nix.Hash
 import           System.Nix.Util