remote: implement Logger_Write

Adds `setDataSink` which can be used to set
a function to be called when daemon
sned us data using `Logger_Write`.

`clearDataSink` should be used after
the operation using the data sink is finished.
This commit is contained in:
sorki 2023-12-03 16:21:32 +01:00
parent 57cc9e3609
commit 675581903e
2 changed files with 45 additions and 4 deletions

View File

@ -8,7 +8,7 @@ import Data.ByteString (ByteString)
import Data.Serialize (Result(..))
import System.Nix.Store.Remote.Serializer (LoggerSError, logger, runSerialT)
import System.Nix.Store.Remote.Socket (sockGet8)
import System.Nix.Store.Remote.MonadStore (MonadRemoteStore, RemoteStoreError(..), appendLog, getDataSource, getStoreSocket, getProtoVersion, setError)
import System.Nix.Store.Remote.MonadStore (MonadRemoteStore, RemoteStoreError(..), appendLog, getDataSource, getDataSink, getStoreSocket, getProtoVersion, setError)
import System.Nix.Store.Remote.Types.Logger (Logger(..))
import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion)
@ -72,9 +72,14 @@ processOutput = do
loop
-- Write data to sink
-- used with tunnel sink in ExportPath operation
Logger_Write _out -> do
-- TODO: handle me
Logger_Write out -> do
mSink <- getDataSink
case mSink of
Nothing ->
throwError RemoteStoreError_NoDataSinkProvided
Just sink -> do
liftIO $ sink out
loop
-- Following we just append and loop

View File

@ -41,6 +41,10 @@ data RemoteStoreState = RemoteStoreState {
-- as the daemon requests chunks of size @Word64@.
-- If the function returns Nothing and daemon tries to read more
-- data an error is thrown.
-- Used by @AddToStoreNar@ and @ImportPaths@ operations.
, remoteStoreState_mDataSink :: Maybe (ByteString -> IO ())
-- ^ Sink for @Logger_Write@, called repeatedly by the daemon
-- to dump us some data. Used by @ExportPath@ operation.
, remoteStoreState_mNarSource :: Maybe (NarSource IO)
}
@ -61,6 +65,7 @@ data RemoteStoreError
| RemoteStoreError_LoggerParserFail String ByteString -- when incremental parser returns ((Fail msg leftover) :: Result)
| RemoteStoreError_NoDataSourceProvided -- remoteStoreState_mDataSource is required but it is Nothing
| RemoteStoreError_DataSourceExhausted -- remoteStoreState_mDataSource returned Nothing but more data was requested
| RemoteStoreError_NoDataSinkProvided -- remoteStoreState_mDataSink is required but it is Nothing
| RemoteStoreError_NoNarSourceProvided
| RemoteStoreError_OperationFailed
| RemoteStoreError_ProtocolMismatch
@ -128,6 +133,7 @@ runRemoteStoreT r =
{ remoteStoreState_logs = mempty
, remoteStoreState_gotError = False
, remoteStoreState_mDataSource = Nothing
, remoteStoreState_mDataSink = Nothing
, remoteStoreState_mNarSource = Nothing
}
@ -252,7 +258,33 @@ class ( MonadIO m
=> m ()
clearDataSource = lift clearDataSource
setDataSink :: (ByteString -> IO ()) -> m ()
default setDataSink
:: ( MonadTrans t
, MonadRemoteStoreR r m'
, m ~ t m'
)
=> (ByteString -> IO ())
-> m ()
setDataSink x = lift (setDataSink x)
getDataSink :: m (Maybe (ByteString -> IO ()))
default getDataSink
:: ( MonadTrans t
, MonadRemoteStoreR r m'
, m ~ t m'
)
=> m (Maybe (ByteString -> IO ()))
getDataSink = lift getDataSink
clearDataSink :: m ()
default clearDataSink
:: ( MonadTrans t
, MonadRemoteStoreR r m'
, m ~ t m'
)
=> m ()
clearDataSink = lift clearDataSink
instance MonadRemoteStoreR r m => MonadRemoteStoreR r (StateT s m)
instance MonadRemoteStoreR r m => MonadRemoteStoreR r (ReaderT r m)
@ -282,6 +314,10 @@ instance ( MonadIO m
getDataSource = remoteStoreState_mDataSource <$> RemoteStoreT get
clearDataSource = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSource = Nothing }
setDataSink x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = pure x }
getDataSink = remoteStoreState_mDataSink <$> RemoteStoreT get
clearDataSink = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mDataSink = Nothing }
setNarSource x = RemoteStoreT $ modify $ \s -> s { remoteStoreState_mNarSource = pure x }
takeNarSource = RemoteStoreT $ do
x <- remoteStoreState_mNarSource <$> get