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
          -- These two terminate the logger loop
          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

          -- Read data from source
          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

          -- Write data to sink
          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

          -- Following we just append and loop
          -- but listed here explicitely for posterity
          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