remote: generalize error in sockPutS, sockGetS, add Types.WorkerMagic, workerMagic serializer, HandshakeSError

Author: sorki

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

@@ -92,6 +92,7 @@ library
     , System.Nix.Store.Remote.Types.StoreConfig
     , System.Nix.Store.Remote.Types.SubstituteMode
     , System.Nix.Store.Remote.Types.Verbosity
+    , System.Nix.Store.Remote.Types.WorkerMagic
     , System.Nix.Store.Remote.Types.WorkerOp
 
   build-depends:

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

@@ -23,17 +23,13 @@ import qualified Network.Socket.ByteString
 import System.Nix.Store.Remote.Logger (processOutput)
 import System.Nix.Store.Remote.MonadStore
 import System.Nix.Store.Remote.Socket (sockPutS, sockGetS)
-import System.Nix.Store.Remote.Serializer (bool, enum, int, protoVersion, text)
+import System.Nix.Store.Remote.Serializer (bool, enum, int, mapErrorS, protoVersion, text, workerMagic)
 import System.Nix.Store.Remote.Types.Logger (Logger)
 import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..), ourProtoVersion)
 import System.Nix.Store.Remote.Types.StoreConfig (PreStoreConfig(..), StoreConfig(..))
+import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
 import System.Nix.Store.Remote.Types.WorkerOp (WorkerOp)
 
-workerMagic1 :: Int
-workerMagic1 = 0x6e697863
-workerMagic2 :: Int
-workerMagic2 = 0x6478696f
-
 type Run a = IO (Either RemoteStoreError a, [Logger])
 
 simpleOp :: WorkerOp -> MonadRemoteStore Bool
@@ -44,7 +40,7 @@ simpleOpArgs op args = do
   runOpArgs op args
   err <- gotError
   Data.Bool.bool
-    (sockGetS bool)
+    (sockGetS $ mapErrorS RemoteStoreError_SerializerGet bool)
     (do
       -- TODO: don't use show
       getErrors >>= throwError . RemoteStoreError_Fixme . show
@@ -67,7 +63,7 @@ runOpArgsIO
      )
   -> MonadRemoteStore ()
 runOpArgsIO op encoder = do
-  sockPutS enum op
+  sockPutS (mapErrorS RemoteStoreError_SerializerPut enum) op
 
   soc <- getStoreSocket
   encoder (liftIO . Network.Socket.ByteString.sendAll soc)
@@ -93,11 +89,22 @@ runStoreSocket preStoreConfig code =
   where
     greet :: MonadRemoteStoreHandshake ProtoVersion
     greet = do
-      sockPutS int workerMagic1
 
-      magic <- sockGetS int
+      sockPutS
+        (mapErrorS
+          RemoteStoreError_SerializerHandshake
+          workerMagic
+        )
+        WorkerMagic_One
+
+      magic <-
+        sockGetS
+        $ mapErrorS
+            RemoteStoreError_SerializerHandshake
+            workerMagic
+
       unless
-        (magic == workerMagic2)
+        (magic == WorkerMagic_Two)
         $ throwError RemoteStoreError_WorkerMagic2Mismatch
 
       daemonVersion <- sockGetS protoVersion
@@ -111,13 +118,19 @@ runStoreSocket preStoreConfig code =
         $ sockPutS int (0 :: Int) -- affinity, obsolete
 
       when (daemonVersion >= ProtoVersion 1 11) $ do
-        sockPutS bool False  -- reserveSpace, obsolete
+        sockPutS
+          (mapErrorS RemoteStoreError_SerializerPut bool)
+          False -- reserveSpace, obsolete
 
       -- not quite right, should be min of the two
       -- as well as two ^ above
       when (ourProtoVersion >= ProtoVersion 1 33) $ do
         -- If we were buffering I/O, we would flush the output here.
-        _daemonNixVersion <- sockGetS text
+        _daemonNixVersion <-
+          sockGetS
+          $ mapErrorS
+              RemoteStoreError_SerializerGet
+              text
         return ()
 
       -- TODO do something with it

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

@@ -38,7 +38,7 @@ import Data.ByteString (ByteString)
 import Data.Word (Word64)
 import Network.Socket (Socket)
 import System.Nix.StorePath (HasStoreDir(..), StoreDir)
-import System.Nix.Store.Remote.Serializer (SError)
+import System.Nix.Store.Remote.Serializer (HandshakeSError, LoggerSError, SError)
 import System.Nix.Store.Remote.Types.Logger (Logger, isError)
 import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
 import System.Nix.Store.Remote.Types.StoreConfig (HasStoreSocket(..), PreStoreConfig, StoreConfig)
@@ -55,6 +55,8 @@ data RemoteStoreError
   | RemoteStoreError_Disconnected
   | RemoteStoreError_GetAddrInfoFailed
   | RemoteStoreError_SerializerGet SError
+  | RemoteStoreError_SerializerHandshake HandshakeSError
+  | RemoteStoreError_SerializerLogger LoggerSError
   | RemoteStoreError_SerializerPut SError
   | RemoteStoreError_NoDataProvided
   | RemoteStoreError_ProtocolMismatch

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

@@ -63,6 +63,9 @@ module System.Nix.Store.Remote.Serializer
   , loggerOpCode
   , logger
   , verbosity
+  -- * Handshake
+  , HandshakeSError(..)
+  , workerMagic
   ) where
 
 import Control.Monad.Except (MonadError, throwError, )
@@ -902,3 +905,20 @@ verbosity = Serializer
   { getS = mapPrimE $ getS enum
   , putS = mapPrimE . putS enum
   }
+
+-- * Handshake
+
+data HandshakeSError
+  = HandshakeSError_InvalidWorkerMagic Word64
+  deriving (Eq, Ord, Generic, Show)
+
+workerMagic :: NixSerializer r HandshakeSError WorkerMagic
+workerMagic = Serializer
+  { getS = do
+      c <- getS int
+      either
+        (pure $ throwError (HandshakeSError_InvalidWorkerMagic c))
+        pure
+        $ word64ToWorkerMagic c
+  , putS = putS int . workerMagicToWord64
+  }

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

@@ -10,7 +10,7 @@ import Data.Serialize.Put (Put, runPut)
 import Network.Socket.ByteString (recv, sendAll)
 import System.Nix.StorePath (HasStoreDir, StorePath)
 import System.Nix.Store.Remote.MonadStore (MonadRemoteStore0, RemoteStoreError(..), getStoreDir, getStoreSocket)
-import System.Nix.Store.Remote.Serializer (NixSerializer, SError, runP, runSerialT)
+import System.Nix.Store.Remote.Serializer (NixSerializer, runP, runSerialT)
 import System.Nix.Store.Remote.Serialize.Prim (getInt, getByteString, getByteStrings, getPath, getPathsOrFail)
 import System.Nix.Store.Remote.Types (HasStoreSocket(..))
 
@@ -50,27 +50,28 @@ sockPut p = do
 
 sockPutS
   :: ( MonadReader r m
-     , MonadError RemoteStoreError m
+     , MonadError e m
      , MonadIO m
      , HasStoreSocket r
      )
-  => NixSerializer r SError a
+  => NixSerializer r e a
   -> a
   -> m ()
 sockPutS s a = do
   r <- ask
   case runP s r a of
     Right x -> liftIO $ sendAll (hasStoreSocket r) x
-    Left e -> throwError $ RemoteStoreError_SerializerPut e
+    Left e -> throwError e
 
 sockGetS
-  :: forall r m a
+  :: forall r e m a
    . ( HasStoreSocket r
      , MonadError RemoteStoreError m
+     , MonadError e m
      , MonadReader r m
      , MonadIO m
      )
-  => NixSerializer r SError a
+  => NixSerializer r e a
   -> m a
 sockGetS s = do
   r <- ask
@@ -79,7 +80,7 @@ sockGetS s = do
 
   case res of
     Right x -> pure x
-    Left e -> throwError $ RemoteStoreError_SerializerGet e
+    Left e -> throwError e
  where
   sockGet8' :: MonadError RemoteStoreError m => m ByteString
   sockGet8' = do

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

@@ -7,6 +7,7 @@ module System.Nix.Store.Remote.Types
   , module System.Nix.Store.Remote.Types.StoreConfig
   , module System.Nix.Store.Remote.Types.SubstituteMode
   , module System.Nix.Store.Remote.Types.Verbosity
+  , module System.Nix.Store.Remote.Types.WorkerMagic
   , module System.Nix.Store.Remote.Types.WorkerOp
   ) where
 
@@ -18,4 +19,5 @@ import System.Nix.Store.Remote.Types.ProtoVersion
 import System.Nix.Store.Remote.Types.StoreConfig
 import System.Nix.Store.Remote.Types.SubstituteMode
 import System.Nix.Store.Remote.Types.Verbosity
+import System.Nix.Store.Remote.Types.WorkerMagic
 import System.Nix.Store.Remote.Types.WorkerOp

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

@@ -0,0 +1,27 @@
+module System.Nix.Store.Remote.Types.WorkerMagic
+  ( WorkerMagic(..)
+  , workerMagicToWord64
+  , word64ToWorkerMagic
+  ) where
+
+import Data.Word (Word64)
+import GHC.Generics (Generic)
+
+-- | WorkerMagic
+--
+-- Magic numbers exchange during handshake
+data WorkerMagic
+  = WorkerMagic_One
+  | WorkerMagic_Two
+  deriving (Eq, Generic, Ord, Show)
+
+workerMagicToWord64 :: WorkerMagic -> Word64
+workerMagicToWord64 = \case
+  WorkerMagic_One -> 0x6e697863
+  WorkerMagic_Two -> 0x6478696f
+
+word64ToWorkerMagic :: Word64 -> Either String WorkerMagic
+word64ToWorkerMagic = \case
+  0x6e697863 -> Right WorkerMagic_One
+  0x6478696f -> Right WorkerMagic_Two
+  x -> Left $ "Invalid WorkerMagic: " ++ show x