module System.Nix.Store.Remote.Logger
( processOutput
) where
import Control.Monad.Except (throwError)
import Control.Monad.IO.Class (liftIO)
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, getDataSink, getStoreSocket, getProtoVersion)
import System.Nix.Store.Remote.Types.Logger (Logger(..))
import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion)
import qualified Control.Monad
import qualified Data.Serialize.Get
import qualified Data.Serializer
import qualified Network.Socket.ByteString
processOutput
:: MonadRemoteStore m
=> m ()
processOutput :: forall (m :: * -> *). MonadRemoteStore m => m ()
processOutput = do
ProtoVersion
protoVersion <- m ProtoVersion
forall (m :: * -> *). MonadRemoteStore m => m ProtoVersion
getProtoVersion
m ByteString
forall (m :: * -> *). MonadRemoteStore m => m ByteString
sockGet8 m ByteString -> (ByteString -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result (Either LoggerSError Logger) -> m ()
forall (m :: * -> *).
MonadRemoteStore m =>
Result (Either LoggerSError Logger) -> m ()
go (Result (Either LoggerSError Logger) -> m ())
-> (ByteString -> Result (Either LoggerSError Logger))
-> ByteString
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtoVersion -> ByteString -> Result (Either LoggerSError Logger)
decoder ProtoVersion
protoVersion)
where
decoder
:: ProtoVersion
-> ByteString
-> Result (Either LoggerSError Logger)
decoder :: ProtoVersion -> ByteString -> Result (Either LoggerSError Logger)
decoder ProtoVersion
protoVersion =
Get (Either LoggerSError Logger)
-> ByteString -> Result (Either LoggerSError Logger)
forall a. Get a -> ByteString -> Result a
Data.Serialize.Get.runGetPartial
(ProtoVersion
-> SerialT ProtoVersion LoggerSError Get Logger
-> Get (Either LoggerSError Logger)
forall (m :: * -> *) r e a.
Monad m =>
r -> SerialT r e m a -> m (Either e a)
runSerialT ProtoVersion
protoVersion (SerialT ProtoVersion LoggerSError Get Logger
-> Get (Either LoggerSError Logger))
-> SerialT ProtoVersion LoggerSError Get Logger
-> Get (Either LoggerSError Logger)
forall a b. (a -> b) -> a -> b
$ Serializer (SerialT ProtoVersion LoggerSError) Logger
-> SerialT ProtoVersion LoggerSError Get Logger
forall (t :: (* -> *) -> * -> *) a. Serializer t a -> t Get a
Data.Serializer.getS Serializer (SerialT ProtoVersion LoggerSError) Logger
forall r. HasProtoVersion r => NixSerializer r LoggerSError Logger
logger)
go
:: MonadRemoteStore m
=> Result (Either LoggerSError Logger)
-> m ()
go :: forall (m :: * -> *).
MonadRemoteStore m =>
Result (Either LoggerSError Logger) -> m ()
go (Done Either LoggerSError Logger
ectrl ByteString
leftover) = do
let loop :: m ()
loop = do
ProtoVersion
protoVersion <- m ProtoVersion
forall (m :: * -> *). MonadRemoteStore m => m ProtoVersion
getProtoVersion
m ByteString
forall (m :: * -> *). MonadRemoteStore m => m ByteString
sockGet8 m ByteString -> (ByteString -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Result (Either LoggerSError Logger) -> m ()
forall (m :: * -> *).
MonadRemoteStore m =>
Result (Either LoggerSError Logger) -> m ()
go (Result (Either LoggerSError Logger) -> m ())
-> (ByteString -> Result (Either LoggerSError Logger))
-> ByteString
-> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtoVersion -> ByteString -> Result (Either LoggerSError Logger)
decoder ProtoVersion
protoVersion)
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
Control.Monad.unless (ByteString
leftover ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
forall a. Monoid a => a
mempty) (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 -> m ()) -> RemoteStoreError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> RemoteStoreError
RemoteStoreError_LoggerLeftovers
(Either LoggerSError Logger -> String
forall a. Show a => a -> String
show Either LoggerSError Logger
ectrl)
ByteString
leftover
case Either LoggerSError Logger
ectrl of
Left LoggerSError
e -> RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RemoteStoreError -> m ()) -> RemoteStoreError -> m ()
forall a b. (a -> b) -> a -> b
$ LoggerSError -> RemoteStoreError
RemoteStoreError_SerializerLogger LoggerSError
e
Right Logger
ctrl -> do
case Logger
ctrl of
Logger_Error Either BasicError ErrorInfo
e -> RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (RemoteStoreError -> m ()) -> RemoteStoreError -> m ()
forall a b. (a -> b) -> a -> b
$ Either BasicError ErrorInfo -> RemoteStoreError
RemoteStoreError_LoggerError Either BasicError ErrorInfo
e
Logger
Logger_Last -> Logger -> m ()
forall (m :: * -> *). MonadRemoteStore m => Logger -> m ()
appendLog Logger
Logger_Last
Logger_Read Word64
size -> do
Maybe (Word64 -> IO (Maybe ByteString))
mSource <- m (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (Word64 -> IO (Maybe ByteString)))
getDataSource
case Maybe (Word64 -> IO (Maybe ByteString))
mSource of
Maybe (Word64 -> IO (Maybe ByteString))
Nothing ->
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)
source -> do
Maybe ByteString
mChunk <- 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)
source Word64
size
case Maybe ByteString
mChunk of
Maybe ByteString
Nothing -> RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_DataSourceExhausted
Just ByteString
chunk -> do
Socket
sock <- 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
$ Socket -> ByteString -> IO ()
Network.Socket.ByteString.sendAll Socket
sock ByteString
chunk
m ()
loop
Logger_Write ByteString
out -> do
Maybe (ByteString -> IO ())
mSink <- m (Maybe (ByteString -> IO ()))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (ByteString -> IO ()))
getDataSink
case Maybe (ByteString -> IO ())
mSink of
Maybe (ByteString -> IO ())
Nothing ->
RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
RemoteStoreError_NoDataSinkProvided
Just ByteString -> IO ()
sink -> do
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
out
m ()
loop
x :: Logger
x@(Logger_Next Text
_) -> Logger -> m ()
forall (m :: * -> *). MonadRemoteStore m => Logger -> m ()
appendLog Logger
x m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
loop
x :: Logger
x@(Logger_StartActivity {}) -> Logger -> m ()
forall (m :: * -> *). MonadRemoteStore m => Logger -> m ()
appendLog Logger
x m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
loop
x :: Logger
x@(Logger_StopActivity {}) -> Logger -> m ()
forall (m :: * -> *). MonadRemoteStore m => Logger -> m ()
appendLog Logger
x m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
loop
x :: Logger
x@(Logger_Result {}) -> Logger -> m ()
forall (m :: * -> *). MonadRemoteStore m => Logger -> m ()
appendLog Logger
x m () -> m () -> m ()
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> m ()
loop
go (Partial ByteString -> Result (Either LoggerSError Logger)
k) = do
ByteString
chunk <- m ByteString
forall (m :: * -> *). MonadRemoteStore m => m ByteString
sockGet8
Result (Either LoggerSError Logger) -> m ()
forall (m :: * -> *).
MonadRemoteStore m =>
Result (Either LoggerSError Logger) -> m ()
go (ByteString -> Result (Either LoggerSError Logger)
k ByteString
chunk)
go (Fail String
msg ByteString
leftover) =
RemoteStoreError -> m ()
forall a. RemoteStoreError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(RemoteStoreError -> m ()) -> RemoteStoreError -> m ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> RemoteStoreError
RemoteStoreError_LoggerParserFail
String
msg
ByteString
leftover