remote: add path serializer, start wiring errors

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

@@ -6,7 +6,7 @@ import Control.Monad.Except (throwError)
 import Data.ByteString (ByteString)
 import Data.Serialize (Result(..))
 import System.Nix.Store.Remote.Serialize.Prim (putByteString)
-import System.Nix.Store.Remote.Serializer (logger, runSerialT)
+import System.Nix.Store.Remote.Serializer (LoggerError, logger, runSerialT)
 import System.Nix.Store.Remote.Socket (sockGet8, sockPut)
 import System.Nix.Store.Remote.MonadStore (MonadStore, clearData)
 import System.Nix.Store.Remote.Types (Logger(..), ProtoVersion, hasProtoVersion)
@@ -22,12 +22,15 @@ processOutput = do
  protoVersion <- Control.Monad.Reader.asks hasProtoVersion
  sockGet8 >>= go . (decoder protoVersion)
  where
-  decoder :: ProtoVersion -> ByteString -> Result (Either () Logger)
+  decoder
+    :: ProtoVersion
+    -> ByteString
+    -> Result (Either LoggerError Logger)
   decoder protoVersion =
     Data.Serialize.Get.runGetPartial
       (runSerialT protoVersion $ Data.Serializer.getS logger)
 
-  go :: Result (Either () Logger) -> MonadStore [Logger]
+  go :: Result (Either LoggerError Logger) -> MonadStore [Logger]
   go (Done ectrl leftover) = do
 
     Control.Monad.unless (leftover == mempty) $

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

@@ -9,6 +9,9 @@ module System.Nix.Store.Remote.Serializer
   (
   -- * NixSerializer
     NixSerializer
+  -- * Errors
+  , GetError(..)
+  , LoggerError(..)
   -- ** Runners
   , runSerialT
   , runG
@@ -30,6 +33,8 @@ module System.Nix.Store.Remote.Serializer
   , buildResult
   , protoVersion
   , derivation
+  -- * StorePath
+  , path
   -- ** Logger
   , activityID
   , maybeActivity
@@ -43,7 +48,7 @@ module System.Nix.Store.Remote.Serializer
   , verbosity
   ) where
 
-import Control.Monad.Except (MonadError)
+import Control.Monad.Except (MonadError, throwError)
 import Control.Monad.Reader (MonadReader)
 import Control.Monad.Trans (MonadTrans, lift)
 import Control.Monad.Trans.Reader (ReaderT, runReaderT)
@@ -55,6 +60,7 @@ import Data.Map (Map)
 import Data.Set (Set)
 import Data.Text (Text)
 import Data.Time (UTCTime)
+import GHC.Generics (Generic)
 
 import qualified Control.Monad
 import qualified Control.Monad.Reader
@@ -66,7 +72,7 @@ import qualified Data.Text
 import Data.Serializer
 import System.Nix.Build (BuildResult)
 import System.Nix.Derivation (Derivation)
-import System.Nix.StorePath (StoreDir, StorePath)
+import System.Nix.StorePath (HasStoreDir(..), InvalidPathError, StoreDir, StorePath)
 import System.Nix.Store.Remote.Serialize (getDerivation, putDerivation)
 import System.Nix.Store.Remote.Serialize.Prim
 import System.Nix.Store.Remote.Types
@@ -101,6 +107,19 @@ runSerialT r =
 
 type NixSerializer r e = Serializer (SerialT r e)
 
+-- * Errors
+
+data GetError
+  = GetError
+  | GetError_Path InvalidPathError
+  deriving (Eq, Ord, Generic, Show)
+
+data LoggerError
+  = LoggerError_Get GetError
+  | LoggerError_TooOldForErrorInfo
+  | LoggerError_TooNewForBasicError
+  deriving (Eq, Ord, Generic, Show)
+
 -- ** Runners
 
 runG
@@ -210,6 +229,22 @@ buildResult = liftSerialize
 protoVersion :: NixSerializer r e ProtoVersion
 protoVersion = liftSerialize
 
+-- * StorePath
+
+path :: HasStoreDir r => NixSerializer r GetError StorePath
+path = Serializer
+  { getS = do
+      sd <- Control.Monad.Reader.asks hasStoreDir
+      lift (getPath sd)
+      >>=
+        either
+          (throwError . GetError_Path)
+          pure
+  , putS = \p -> do
+      sd <- Control.Monad.Reader.asks hasStoreDir
+      lift $ putPath sd p
+  }
+
 derivation :: StoreDir -> NixSerializer r e (Derivation StorePath Text)
 derivation sd = lift2 (getDerivation sd) (putDerivation sd)
 
@@ -251,7 +286,7 @@ loggerOpCode = liftSerialize
 
 logger
   :: HasProtoVersion r
-  => NixSerializer r e Logger
+  => NixSerializer r LoggerError Logger
 logger = Serializer
   { getS = getS loggerOpCode >>= \case
       LoggerOpCode_Next ->
@@ -298,11 +333,15 @@ logger = Serializer
           putS loggerOpCode LoggerOpCode_Last
         Logger_Error basicOrInfo -> do
           putS loggerOpCode LoggerOpCode_Error
-          -- TODO: throwError if we try to send
-          -- ErrorInfo to client which has no support for it
+
+          minor <- protoVersion_minor <$> Control.Monad.Reader.asks hasProtoVersion
+
           case basicOrInfo of
-            Left e -> putS basicError e
+            Left _ | minor >= 26 -> throwError $ LoggerError_TooNewForBasicError
+            Left e | otherwise -> putS basicError e
+            Right _ | minor < 26 -> throwError $ LoggerError_TooOldForErrorInfo
             Right e -> putS errorInfo e
+
         Logger_StartActivity{..} -> do
           putS loggerOpCode LoggerOpCode_StartActivity
           putS activityID startActivityID

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

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
 module System.Nix.Store.Remote.Types.StoreConfig
   ( PreStoreConfig(..)
   , StoreConfig(..)
@@ -31,6 +32,9 @@ data StoreConfig = StoreConfig
   , storeConfig_socket      :: Socket
   }
 
+instance HasStoreDir StoreDir where
+  hasStoreDir = id
+
 instance HasStoreDir StoreConfig where
   hasStoreDir = storeConfig_dir
 

hnix-store-remote/tests/NixSerializerSpec.hs

@@ -15,17 +15,20 @@ import qualified System.Nix.Build
 
 import System.Nix.Arbitrary ()
 import System.Nix.Derivation (Derivation(inputDrvs))
+import System.Nix.StorePath (StoreDir)
 import System.Nix.Store.Remote.Arbitrary ()
 import System.Nix.Store.Remote.Serializer
-import System.Nix.Store.Remote.Types  (ErrorInfo(..), Logger(..), ProtoVersion(..), Trace(..))
+import System.Nix.Store.Remote.Types (ErrorInfo(..), Logger(..), ProtoVersion(..), Trace(..))
 
 -- | Test for roundtrip using @NixSerializer@
 roundtripSReader
-  :: forall r a
+  :: forall r e a
    . ( Eq a
      , Show a
+     , Eq e
+     , Show e
      )
-  => NixSerializer r () a
+  => NixSerializer r e a
   -> r
   -> a
   -> Expectation
@@ -83,6 +86,9 @@ spec = parallel $ do
                  , System.Nix.Build.stopTime  = Data.Time.Clock.POSIX.posixSecondsToUTCTime 0
                  }
 
+    prop "StorePath" $ \sd ->
+      roundtripSReader @StoreDir path sd
+
     prop "Derivation" $ \sd ->
       roundtripS (derivation sd)
       . (\drv -> drv { inputDrvs = mempty })