Skip to content

Commit

Permalink
remote: implement Logger_Write
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
sorki committed Dec 3, 2023
1 parent ee54562 commit 58011db
Show file tree
Hide file tree
Showing 2 changed files with 45 additions and 4 deletions.
13 changes: 9 additions & 4 deletions hnix-store-remote/src/System/Nix/Store/Remote/Logger.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand Down
36 changes: 36 additions & 0 deletions hnix-store-remote/src/System/Nix/Store/Remote/MonadStore.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}

Expand All @@ -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
Expand Down Expand Up @@ -128,6 +133,7 @@ runRemoteStoreT r =
{ remoteStoreState_logs = mempty
, remoteStoreState_gotError = False
, remoteStoreState_mDataSource = Nothing
, remoteStoreState_mDataSink = Nothing
, remoteStoreState_mNarSource = Nothing
}

Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down

0 comments on commit 58011db

Please sign in to comment.