module System.Nix.Store.Remote.Client.Core
  ( Run
  , greetServer
  , doReq
  ) where

import Control.Monad (unless, when)
import Control.Monad.Except (throwError)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.ByteString (ByteString)
import Data.DList (DList)
import Data.Some (Some(Some))
import Data.Word (Word64)
import Network.Socket (Socket)
import System.Nix.Nar (NarSource)
import System.Nix.StorePath.Metadata (Metadata(..))
import System.Nix.Store.Remote.Logger (processOutput)
import System.Nix.Store.Remote.MonadStore
  ( MonadRemoteStore(..)
  , RemoteStoreError(..)
  )
import System.Nix.Store.Remote.Socket (sockPutS, sockGetS)
import System.Nix.Store.Remote.Serializer
  ( bool
  , int
  , mapErrorS
  , protoVersion
  , storeRequest
  , text
  , trustedFlag
  , workerMagic
  )
import System.Nix.Store.Remote.Types.Handshake (ClientHandshakeOutput(..))
import System.Nix.Store.Remote.Types.Logger (Logger)
import System.Nix.Store.Remote.Types.NoReply (NoReply(..))
import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..))
import System.Nix.Store.Remote.Types.StoreRequest (StoreRequest(..))
import System.Nix.Store.Remote.Types.StoreReply (StoreReply(..))
import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))

import qualified Data.ByteString
import qualified Network.Socket.ByteString

type Run m a = m (Either RemoteStoreError a, DList Logger)

-- | Perform @StoreRequest@
doReq
  :: forall m a
   . ( MonadIO m
     , MonadRemoteStore m
     , StoreReply a
     , Show a
     )
  => StoreRequest a
  -> m a
doReq :: forall (m :: * -> *) a.
(MonadIO m, MonadRemoteStore m, StoreReply a, Show a) =>
StoreRequest a -> m a
doReq = \case
  StoreRequest a
x -> do
    NixSerializer ProtoStoreConfig RemoteStoreError (Some StoreRequest)
-> Some StoreRequest -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS
      ((RequestSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig RequestSError (Some StoreRequest)
-> NixSerializer
     ProtoStoreConfig RemoteStoreError (Some StoreRequest)
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
        RequestSError -> RemoteStoreError
RemoteStoreError_SerializerRequest
          NixSerializer ProtoStoreConfig RequestSError (Some StoreRequest)
forall r.
(HasProtoVersion r, HasStoreDir r) =>
NixSerializer r RequestSError (Some StoreRequest)
storeRequest
      )
      (StoreRequest a -> Some StoreRequest
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some StoreRequest a
x)

    case StoreRequest a
x of
      AddToStore {} -> do

        Maybe (NarSource IO)
ms <- m (Maybe (NarSource IO))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (NarSource IO))
takeNarSource
        case Maybe (NarSource IO)
ms of
          Just (NarSource IO
stream :: NarSource IO) -> do
            Socket
soc <- m Socket
forall (m :: * -> *). MonadRemoteStore m => m Socket
getStoreSocket
            IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
              (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ NarSource IO
stream
              NarSource IO -> NarSource IO
forall a b. (a -> b) -> a -> b
$ Socket -> ByteString -> IO ()
Network.Socket.ByteString.sendAll Socket
soc
          Maybe (NarSource IO)
Nothing ->
            RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
              RemoteStoreError
RemoteStoreError_NoNarSourceProvided
        m ()
forall (m :: * -> *). MonadRemoteStore m => m ()
processOutput
        m a
processReply

      AddToStoreNar StorePath
_ Metadata StorePath
meta RepairMode
_ CheckMode
_ -> do
        let narBytes :: Word64
narBytes = Word64 -> (Word64 -> Word64) -> Maybe Word64 -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
0 Word64 -> Word64
forall a. a -> a
id (Maybe Word64 -> Word64) -> Maybe Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ Metadata StorePath -> Maybe Word64
forall a. Metadata a -> Maybe Word64
metadataNarBytes Metadata StorePath
meta
        Maybe (Word64 -> IO (Maybe ByteString))
maybeDataSource <- m (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (Word64 -> IO (Maybe ByteString)))
takeDataSource
        Socket
soc <- m Socket
forall (m :: * -> *). MonadRemoteStore m => m Socket
getStoreSocket
        case Maybe (Word64 -> IO (Maybe ByteString))
maybeDataSource of
          Maybe (Word64 -> IO (Maybe ByteString))
Nothing ->
            if Word64
narBytes Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then (Word64 -> IO (Maybe ByteString)) -> Socket -> Word64 -> m ()
forall (m :: * -> *).
(MonadIO m, MonadRemoteStore m) =>
(Word64 -> IO (Maybe ByteString)) -> Socket -> Word64 -> m ()
writeFramedSource (IO (Maybe ByteString) -> Word64 -> IO (Maybe ByteString)
forall a b. a -> b -> a
const (Maybe ByteString -> IO (Maybe ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ByteString
forall a. Maybe a
Nothing)) Socket
soc Word64
0
            else RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_NoDataSourceProvided
          Just Word64 -> IO (Maybe ByteString)
dataSource -> do
            (Word64 -> IO (Maybe ByteString)) -> Socket -> Word64 -> m ()
forall (m :: * -> *).
(MonadIO m, MonadRemoteStore m) =>
(Word64 -> IO (Maybe ByteString)) -> Socket -> Word64 -> m ()
writeFramedSource Word64 -> IO (Maybe ByteString)
dataSource Socket
soc Word64
narBytes
        m ()
forall (m :: * -> *). MonadRemoteStore m => m ()
processOutput
        a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
NoReply
NoReply

      NarFromPath StorePath
_ -> do
        Maybe (ByteString -> IO ())
maybeSink <- m (Maybe (ByteString -> IO ()))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (ByteString -> IO ()))
getDataSink
        ByteString -> IO ()
sink <- case Maybe (ByteString -> IO ())
maybeSink of
          Maybe (ByteString -> IO ())
Nothing -> RemoteStoreError -> m (ByteString -> IO ())
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_NoDataSinkProvided
          Just ByteString -> IO ()
sink -> (ByteString -> IO ()) -> m (ByteString -> IO ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString -> IO ()
sink
        m ()
forall (m :: * -> *). MonadRemoteStore m => m ()
clearDataSink
        Maybe Word64
maybeNarSize <- m (Maybe Word64)
forall (m :: * -> *). MonadRemoteStore m => m (Maybe Word64)
getDataSinkSize
        Word64
narSize <- case Maybe Word64
maybeNarSize of
          Maybe Word64
Nothing -> RemoteStoreError -> m Word64
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_NoDataSinkSizeProvided
          Just Word64
narSize -> Word64 -> m Word64
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word64
narSize
        m ()
forall (m :: * -> *). MonadRemoteStore m => m ()
clearDataSinkSize
        Socket
soc <- m Socket
forall (m :: * -> *). MonadRemoteStore m => m Socket
getStoreSocket
        m ()
forall (m :: * -> *). MonadRemoteStore m => m ()
processOutput
        (ByteString -> IO ()) -> Word64 -> Socket -> m ()
forall (m :: * -> *).
(MonadIO m, MonadRemoteStore m) =>
(ByteString -> IO ()) -> Word64 -> Socket -> m ()
copyToSink ByteString -> IO ()
sink Word64
narSize Socket
soc
        a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
NoReply
NoReply

      StoreRequest a
_ -> do
        m ()
forall (m :: * -> *). MonadRemoteStore m => m ()
processOutput
        m a
processReply

  where
    processReply :: m a
processReply = NixSerializer ProtoStoreConfig RemoteStoreError a -> m a
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS
          ((ReplySError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig ReplySError a
-> NixSerializer ProtoStoreConfig RemoteStoreError a
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS ReplySError -> RemoteStoreError
RemoteStoreError_SerializerReply
            (NixSerializer ProtoStoreConfig ReplySError a
 -> NixSerializer ProtoStoreConfig RemoteStoreError a)
-> NixSerializer ProtoStoreConfig ReplySError a
-> NixSerializer ProtoStoreConfig RemoteStoreError a
forall a b. (a -> b) -> a -> b
$ forall a.
StoreReply a =>
NixSerializer ProtoStoreConfig ReplySError a
getReplyS @a
          )

copyToSink
  :: forall m
   . ( MonadIO m
     , MonadRemoteStore m
     )
  => (ByteString -> IO()) --  ^ data sink
  -> Word64 -- ^ byte length to read
  -> Socket
  -> m ()
copyToSink :: forall (m :: * -> *).
(MonadIO m, MonadRemoteStore m) =>
(ByteString -> IO ()) -> Word64 -> Socket -> m ()
copyToSink ByteString -> IO ()
sink Word64
remainingBytes Socket
soc =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
remainingBytes Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let chunkSize :: Word64
chunkSize = Word64
16384
        bytesToRead :: Word64
bytesToRead = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
min Word64
chunkSize Word64
remainingBytes
    ByteString
bytes <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Socket -> Int -> IO ByteString
Network.Socket.ByteString.recv Socket
soc (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
bytesToRead)
    IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
sink ByteString
bytes
    let nextRemainingBytes :: Word64
nextRemainingBytes = Word64
remainingBytes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> (ByteString -> Int) -> ByteString -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
Data.ByteString.length) ByteString
bytes
    (ByteString -> IO ()) -> Word64 -> Socket -> m ()
forall (m :: * -> *).
(MonadIO m, MonadRemoteStore m) =>
(ByteString -> IO ()) -> Word64 -> Socket -> m ()
copyToSink ByteString -> IO ()
sink Word64
nextRemainingBytes Socket
soc

writeFramedSource
  :: forall m
   . ( MonadIO m
     , MonadRemoteStore m
     )
  => (Word64 -> IO(Maybe ByteString))
  -> Socket
  -> Word64
  -> m ()
writeFramedSource :: forall (m :: * -> *).
(MonadIO m, MonadRemoteStore m) =>
(Word64 -> IO (Maybe ByteString)) -> Socket -> Word64 -> m ()
writeFramedSource Word64 -> IO (Maybe ByteString)
dataSource Socket
soc Word64
remainingBytes = do
  let chunkSize :: Word64
chunkSize = Word64
16384
  Maybe ByteString
maybeBytes <- IO (Maybe ByteString) -> m (Maybe ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ByteString) -> m (Maybe ByteString))
-> IO (Maybe ByteString) -> m (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ Word64 -> IO (Maybe ByteString)
dataSource Word64
chunkSize
  case Maybe ByteString
maybeBytes of
    Maybe ByteString
Nothing -> do
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Word64
remainingBytes Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_DataSourceExhausted
      let Word64
eof :: Word64 = Word64
0
      NixSerializer ProtoStoreConfig RemoteStoreError Word64
-> Word64 -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError Word64
forall a r e. Integral a => NixSerializer r e a
int Word64
eof
    Just ByteString
bytes -> do
      let bytesInChunk :: Word64
bytesInChunk = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
Data.ByteString.length ByteString
bytes
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
bytesInChunk Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
chunkSize Bool -> Bool -> Bool
|| Word64
bytesInChunk Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
remainingBytes) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_DataSourceReadTooLarge
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word64
bytesInChunk Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_DataSourceZeroLengthRead
      NixSerializer ProtoStoreConfig RemoteStoreError Word64
-> Word64 -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError Word64
forall a r e. Integral a => NixSerializer r e a
int Word64
bytesInChunk
      IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
        (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> ByteString -> IO ()
Network.Socket.ByteString.sendAll Socket
soc ByteString
bytes
      let nextRemainingBytes :: Word64
nextRemainingBytes = Word64
remainingBytes Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
bytesInChunk
      (Word64 -> IO (Maybe ByteString)) -> Socket -> Word64 -> m ()
forall (m :: * -> *).
(MonadIO m, MonadRemoteStore m) =>
(Word64 -> IO (Maybe ByteString)) -> Socket -> Word64 -> m ()
writeFramedSource Word64 -> IO (Maybe ByteString)
dataSource Socket
soc Word64
nextRemainingBytes

greetServer
  :: MonadRemoteStore m
  => m ClientHandshakeOutput
greetServer :: forall (m :: * -> *). MonadRemoteStore m => m ClientHandshakeOutput
greetServer = do
  NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
-> WorkerMagic -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS
    ((HandshakeSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
-> NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
      HandshakeSError -> RemoteStoreError
RemoteStoreError_SerializerHandshake
      NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
forall r. NixSerializer r HandshakeSError WorkerMagic
workerMagic
    )
    WorkerMagic
WorkerMagic_One

  WorkerMagic
magic <-
    NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
-> m WorkerMagic
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS
    (NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
 -> m WorkerMagic)
-> NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
-> m WorkerMagic
forall a b. (a -> b) -> a -> b
$ (HandshakeSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
-> NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
        HandshakeSError -> RemoteStoreError
RemoteStoreError_SerializerHandshake
        NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
forall r. NixSerializer r HandshakeSError WorkerMagic
workerMagic

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    (WorkerMagic
magic WorkerMagic -> WorkerMagic -> Bool
forall a. Eq a => a -> a -> Bool
== WorkerMagic
WorkerMagic_Two)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_WorkerMagic2Mismatch

  ProtoVersion
daemonVersion <- NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
-> m ProtoVersion
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
forall r e. NixSerializer r e ProtoVersion
protoVersion

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
daemonVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
< Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
10)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_ClientVersionTooOld

  ProtoVersion
pv <- m ProtoVersion
forall (m :: * -> *). MonadRemoteStore m => m ProtoVersion
getProtoVersion
  NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
-> ProtoVersion -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
forall r e. NixSerializer r e ProtoVersion
protoVersion ProtoVersion
pv

  let leastCommonVersion :: ProtoVersion
leastCommonVersion = ProtoVersion -> ProtoVersion -> ProtoVersion
forall a. Ord a => a -> a -> a
min ProtoVersion
daemonVersion ProtoVersion
pv

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
leastCommonVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
14)
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ NixSerializer ProtoStoreConfig RemoteStoreError Int -> Int -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError Int
forall a r e. Integral a => NixSerializer r e a
int (Int
0 :: Int) -- affinity, obsolete

  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
leastCommonVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
11) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    NixSerializer ProtoStoreConfig RemoteStoreError Bool
-> Bool -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS
      ((SError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig SError Bool
-> NixSerializer ProtoStoreConfig RemoteStoreError Bool
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS SError -> RemoteStoreError
RemoteStoreError_SerializerPut NixSerializer ProtoStoreConfig SError Bool
forall r. NixSerializer r SError Bool
bool)
      Bool
False -- reserveSpace, obsolete

  Maybe Text
daemonNixVersion <- if ProtoVersion
leastCommonVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
33
    then do
      -- If we were buffering I/O, we would flush the output here.
      Text
txtVer <-
        NixSerializer ProtoStoreConfig RemoteStoreError Text -> m Text
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS
          (NixSerializer ProtoStoreConfig RemoteStoreError Text -> m Text)
-> NixSerializer ProtoStoreConfig RemoteStoreError Text -> m Text
forall a b. (a -> b) -> a -> b
$ (SError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig SError Text
-> NixSerializer ProtoStoreConfig RemoteStoreError Text
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
              SError -> RemoteStoreError
RemoteStoreError_SerializerGet
              NixSerializer ProtoStoreConfig SError Text
forall r. NixSerializer r SError Text
text
      Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Text -> m (Maybe Text)) -> Maybe Text -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txtVer
    else Maybe Text -> m (Maybe Text)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Text
forall a. Maybe a
Nothing

  Maybe TrustedFlag
remoteTrustsUs <- if ProtoVersion
leastCommonVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
35
    then do
      NixSerializer ProtoStoreConfig RemoteStoreError (Maybe TrustedFlag)
-> m (Maybe TrustedFlag)
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS
        (NixSerializer
   ProtoStoreConfig RemoteStoreError (Maybe TrustedFlag)
 -> m (Maybe TrustedFlag))
-> NixSerializer
     ProtoStoreConfig RemoteStoreError (Maybe TrustedFlag)
-> m (Maybe TrustedFlag)
forall a b. (a -> b) -> a -> b
$ (HandshakeSError -> RemoteStoreError)
-> NixSerializer
     ProtoStoreConfig HandshakeSError (Maybe TrustedFlag)
-> NixSerializer
     ProtoStoreConfig RemoteStoreError (Maybe TrustedFlag)
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS HandshakeSError -> RemoteStoreError
RemoteStoreError_SerializerHandshake NixSerializer ProtoStoreConfig HandshakeSError (Maybe TrustedFlag)
forall r. NixSerializer r HandshakeSError (Maybe TrustedFlag)
trustedFlag
    else Maybe TrustedFlag -> m (Maybe TrustedFlag)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe TrustedFlag
forall a. Maybe a
Nothing

  ProtoVersion -> m ()
forall (m :: * -> *). MonadRemoteStore m => ProtoVersion -> m ()
setProtoVersion ProtoVersion
leastCommonVersion
  m ()
forall (m :: * -> *). MonadRemoteStore m => m ()
processOutput

  ClientHandshakeOutput -> m ClientHandshakeOutput
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientHandshakeOutput
    { clientHandshakeOutputNixVersion :: Maybe Text
clientHandshakeOutputNixVersion = Maybe Text
daemonNixVersion
    , clientHandshakeOutputTrust :: Maybe TrustedFlag
clientHandshakeOutputTrust = Maybe TrustedFlag
remoteTrustsUs
    , clientHandshakeOutputLeastCommonVersion :: ProtoVersion
clientHandshakeOutputLeastCommonVersion = ProtoVersion
leastCommonVersion
    , clientHandshakeOutputServerVersion :: ProtoVersion
clientHandshakeOutputServerVersion = ProtoVersion
daemonVersion
    }