{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module System.Nix.Store.Remote.MonadStore
  ( RemoteStoreState(..)
  , RemoteStoreError(..)
  , WorkerError(..)
  , WorkerException(..)
  , RemoteStoreT
  , runRemoteStoreT
  , MonadRemoteStore(..)
  ) where

import Control.Exception (SomeException)
import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow)
import Control.Monad.Except (MonadError)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.Reader (MonadReader, ask)
import Control.Monad.State.Strict (get, gets, modify)
import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Trans.State.Strict (StateT, runStateT)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Data.ByteString (ByteString)
import Data.Default.Class (Default(def))
import Data.DList (DList)
import Data.Word (Word64)
import Network.Socket (Socket)
import System.Nix.Nar (NarSource)
import System.Nix.StorePath (HasStoreDir(..), StoreDir)
import System.Nix.Store.Remote.Serializer (HandshakeSError, LoggerSError, RequestSError, ReplySError, SError)
import System.Nix.Store.Remote.Types.Logger (Logger, BasicError, ErrorInfo)
import System.Nix.Store.Remote.Types.ProtoVersion (HasProtoVersion(..), ProtoVersion)
import System.Nix.Store.Remote.Types.StoreConfig (ProtoStoreConfig(..))

import qualified Data.DList

data RemoteStoreState = RemoteStoreState {
    RemoteStoreState -> ProtoStoreConfig
remoteStoreStateConfig :: ProtoStoreConfig
  , RemoteStoreState -> DList Logger
remoteStoreStateLogs :: DList Logger
  , RemoteStoreState -> Maybe (Word64 -> IO (Maybe ByteString))
remoteStoreStateMDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
  -- ^ Source for @Logger_Read@, this will be called repeatedly
  -- 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 -> Maybe (ByteString -> IO ())
remoteStoreStateMDataSink :: Maybe (ByteString -> IO ())
  -- ^ Sink for @Logger_Write@, called repeatedly by the daemon
  -- to dump us some data. Used by @ExportPath@ operation.
  , RemoteStoreState -> Maybe Word64
remoteStoreStateMDataSinkSize :: Maybe Word64
  -- ^ Byte length to be written to the sink, for NarForPath
  , RemoteStoreState -> Maybe (NarSource IO)
remoteStoreStateMNarSource :: Maybe (NarSource IO)
  }

instance HasStoreDir RemoteStoreState where
  hasStoreDir :: RemoteStoreState -> StoreDir
hasStoreDir = ProtoStoreConfig -> StoreDir
forall r. HasStoreDir r => r -> StoreDir
hasStoreDir (ProtoStoreConfig -> StoreDir)
-> (RemoteStoreState -> ProtoStoreConfig)
-> RemoteStoreState
-> StoreDir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteStoreState -> ProtoStoreConfig
remoteStoreStateConfig

instance HasProtoVersion RemoteStoreState where
  hasProtoVersion :: RemoteStoreState -> ProtoVersion
hasProtoVersion = ProtoStoreConfig -> ProtoVersion
forall r. HasProtoVersion r => r -> ProtoVersion
hasProtoVersion (ProtoStoreConfig -> ProtoVersion)
-> (RemoteStoreState -> ProtoStoreConfig)
-> RemoteStoreState
-> ProtoVersion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteStoreState -> ProtoStoreConfig
remoteStoreStateConfig

data RemoteStoreError
  = RemoteStoreError_Fixme String
  | RemoteStoreError_BuildFailed
  | RemoteStoreError_ClientVersionTooOld
  | RemoteStoreError_DerivationParse String
  | RemoteStoreError_Disconnected
  | RemoteStoreError_GetAddrInfoFailed
  | RemoteStoreError_GenericIncrementalLeftovers String ByteString -- when there are bytes left over after genericIncremental parser is done, (Done x leftover), first param is show x
  | RemoteStoreError_GenericIncrementalFail String ByteString -- when genericIncremental parser returns ((Fail msg leftover) :: Result)
  | RemoteStoreError_SerializerGet SError
  | RemoteStoreError_SerializerHandshake HandshakeSError
  | RemoteStoreError_SerializerLogger LoggerSError
  | RemoteStoreError_SerializerPut SError
  | RemoteStoreError_SerializerRequest RequestSError
  | RemoteStoreError_SerializerReply ReplySError
  | RemoteStoreError_IOException SomeException
  | RemoteStoreError_LoggerError (Either BasicError ErrorInfo)
  | RemoteStoreError_LoggerLeftovers String ByteString -- when there are bytes left over after incremental logger parser is done, (Done x leftover), first param is show x
  | RemoteStoreError_LoggerParserFail String ByteString -- when incremental parser returns ((Fail msg leftover) :: Result)
  | RemoteStoreError_NoDataSourceProvided -- remoteStoreStateMDataSource is required but it is Nothing
  | RemoteStoreError_DataSourceExhausted -- remoteStoreStateMDataSource returned Nothing but more data was requested
  | RemoteStoreError_DataSourceZeroLengthRead -- remoteStoreStateMDataSource returned a zero length ByteString
  | RemoteStoreError_DataSourceReadTooLarge -- remoteStoreStateMDataSource returned a ByteString larger than the chunk size requested or the remaining bytes
  | RemoteStoreError_NoDataSinkProvided -- remoteStoreStateMDataSink is required but it is Nothing
  | RemoteStoreError_NoDataSinkSizeProvided -- remoteStoreStateMDataSinkSize is required but it is Nothing
  | RemoteStoreError_NoNarSourceProvided
  | RemoteStoreError_OperationFailed
  | RemoteStoreError_ProtocolMismatch
  | RemoteStoreError_RapairNotSupportedByRemoteStore -- "repairing is not supported when building through the Nix daemon"
  | RemoteStoreError_WorkerMagic2Mismatch
  | RemoteStoreError_WorkerError WorkerError
  -- bad / redundant
  | RemoteStoreError_WorkerException WorkerException
  deriving Int -> RemoteStoreError -> ShowS
[RemoteStoreError] -> ShowS
RemoteStoreError -> String
(Int -> RemoteStoreError -> ShowS)
-> (RemoteStoreError -> String)
-> ([RemoteStoreError] -> ShowS)
-> Show RemoteStoreError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RemoteStoreError -> ShowS
showsPrec :: Int -> RemoteStoreError -> ShowS
$cshow :: RemoteStoreError -> String
show :: RemoteStoreError -> String
$cshowList :: [RemoteStoreError] -> ShowS
showList :: [RemoteStoreError] -> ShowS
Show

-- | fatal error in worker interaction which should disconnect client.
data WorkerException
  = WorkerException_ClientVersionTooOld
  | WorkerException_ProtocolMismatch
  | WorkerException_Error WorkerError
  -- ^ allowed error outside allowed worker state
--  | WorkerException_DecodingError DecodingError
--  | WorkerException_BuildFailed StorePath
  deriving (WorkerException -> WorkerException -> Bool
(WorkerException -> WorkerException -> Bool)
-> (WorkerException -> WorkerException -> Bool)
-> Eq WorkerException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkerException -> WorkerException -> Bool
== :: WorkerException -> WorkerException -> Bool
$c/= :: WorkerException -> WorkerException -> Bool
/= :: WorkerException -> WorkerException -> Bool
Eq, Eq WorkerException
Eq WorkerException =>
(WorkerException -> WorkerException -> Ordering)
-> (WorkerException -> WorkerException -> Bool)
-> (WorkerException -> WorkerException -> Bool)
-> (WorkerException -> WorkerException -> Bool)
-> (WorkerException -> WorkerException -> Bool)
-> (WorkerException -> WorkerException -> WorkerException)
-> (WorkerException -> WorkerException -> WorkerException)
-> Ord WorkerException
WorkerException -> WorkerException -> Bool
WorkerException -> WorkerException -> Ordering
WorkerException -> WorkerException -> WorkerException
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WorkerException -> WorkerException -> Ordering
compare :: WorkerException -> WorkerException -> Ordering
$c< :: WorkerException -> WorkerException -> Bool
< :: WorkerException -> WorkerException -> Bool
$c<= :: WorkerException -> WorkerException -> Bool
<= :: WorkerException -> WorkerException -> Bool
$c> :: WorkerException -> WorkerException -> Bool
> :: WorkerException -> WorkerException -> Bool
$c>= :: WorkerException -> WorkerException -> Bool
>= :: WorkerException -> WorkerException -> Bool
$cmax :: WorkerException -> WorkerException -> WorkerException
max :: WorkerException -> WorkerException -> WorkerException
$cmin :: WorkerException -> WorkerException -> WorkerException
min :: WorkerException -> WorkerException -> WorkerException
Ord, Int -> WorkerException -> ShowS
[WorkerException] -> ShowS
WorkerException -> String
(Int -> WorkerException -> ShowS)
-> (WorkerException -> String)
-> ([WorkerException] -> ShowS)
-> Show WorkerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkerException -> ShowS
showsPrec :: Int -> WorkerException -> ShowS
$cshow :: WorkerException -> String
show :: WorkerException -> String
$cshowList :: [WorkerException] -> ShowS
showList :: [WorkerException] -> ShowS
Show)

-- | Non-fatal (to server) errors in worker interaction
data WorkerError
  = WorkerError_SendClosed
  | WorkerError_InvalidOperation Word64
  | WorkerError_NotYetImplemented
  | WorkerError_UnsupportedOperation
  deriving (WorkerError -> WorkerError -> Bool
(WorkerError -> WorkerError -> Bool)
-> (WorkerError -> WorkerError -> Bool) -> Eq WorkerError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkerError -> WorkerError -> Bool
== :: WorkerError -> WorkerError -> Bool
$c/= :: WorkerError -> WorkerError -> Bool
/= :: WorkerError -> WorkerError -> Bool
Eq, Eq WorkerError
Eq WorkerError =>
(WorkerError -> WorkerError -> Ordering)
-> (WorkerError -> WorkerError -> Bool)
-> (WorkerError -> WorkerError -> Bool)
-> (WorkerError -> WorkerError -> Bool)
-> (WorkerError -> WorkerError -> Bool)
-> (WorkerError -> WorkerError -> WorkerError)
-> (WorkerError -> WorkerError -> WorkerError)
-> Ord WorkerError
WorkerError -> WorkerError -> Bool
WorkerError -> WorkerError -> Ordering
WorkerError -> WorkerError -> WorkerError
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WorkerError -> WorkerError -> Ordering
compare :: WorkerError -> WorkerError -> Ordering
$c< :: WorkerError -> WorkerError -> Bool
< :: WorkerError -> WorkerError -> Bool
$c<= :: WorkerError -> WorkerError -> Bool
<= :: WorkerError -> WorkerError -> Bool
$c> :: WorkerError -> WorkerError -> Bool
> :: WorkerError -> WorkerError -> Bool
$c>= :: WorkerError -> WorkerError -> Bool
>= :: WorkerError -> WorkerError -> Bool
$cmax :: WorkerError -> WorkerError -> WorkerError
max :: WorkerError -> WorkerError -> WorkerError
$cmin :: WorkerError -> WorkerError -> WorkerError
min :: WorkerError -> WorkerError -> WorkerError
Ord, Int -> WorkerError -> ShowS
[WorkerError] -> ShowS
WorkerError -> String
(Int -> WorkerError -> ShowS)
-> (WorkerError -> String)
-> ([WorkerError] -> ShowS)
-> Show WorkerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkerError -> ShowS
showsPrec :: Int -> WorkerError -> ShowS
$cshow :: WorkerError -> String
show :: WorkerError -> String
$cshowList :: [WorkerError] -> ShowS
showList :: [WorkerError] -> ShowS
Show)

newtype RemoteStoreT m a = RemoteStoreT
  { forall (m :: * -> *) a.
RemoteStoreT m a
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
_unRemoteStoreT
      :: ExceptT RemoteStoreError
          (StateT RemoteStoreState
            (ReaderT Socket m)) a
  }
  deriving
    ( (forall a b. (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b)
-> (forall a b. a -> RemoteStoreT m b -> RemoteStoreT m a)
-> Functor (RemoteStoreT m)
forall a b. a -> RemoteStoreT m b -> RemoteStoreT m a
forall a b. (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
forall (m :: * -> *) a b.
Functor m =>
a -> RemoteStoreT m b -> RemoteStoreT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
fmap :: forall a b. (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> RemoteStoreT m b -> RemoteStoreT m a
<$ :: forall a b. a -> RemoteStoreT m b -> RemoteStoreT m a
Functor
    , Functor (RemoteStoreT m)
Functor (RemoteStoreT m) =>
(forall a. a -> RemoteStoreT m a)
-> (forall a b.
    RemoteStoreT m (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b)
-> (forall a b c.
    (a -> b -> c)
    -> RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m c)
-> (forall a b.
    RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b)
-> (forall a b.
    RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m a)
-> Applicative (RemoteStoreT m)
forall a. a -> RemoteStoreT m a
forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m a
forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
forall a b.
RemoteStoreT m (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
forall a b c.
(a -> b -> c)
-> RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m c
forall (m :: * -> *). Monad m => Functor (RemoteStoreT m)
forall (m :: * -> *) a. Monad m => a -> RemoteStoreT m a
forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m a
forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> RemoteStoreT m a
pure :: forall a. a -> RemoteStoreT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
<*> :: forall a b.
RemoteStoreT m (a -> b) -> RemoteStoreT m a -> RemoteStoreT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c)
-> RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m c
liftA2 :: forall a b c.
(a -> b -> c)
-> RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
*> :: forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m a
<* :: forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m a
Applicative
    , Applicative (RemoteStoreT m)
Applicative (RemoteStoreT m) =>
(forall a b.
 RemoteStoreT m a -> (a -> RemoteStoreT m b) -> RemoteStoreT m b)
-> (forall a b.
    RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b)
-> (forall a. a -> RemoteStoreT m a)
-> Monad (RemoteStoreT m)
forall a. a -> RemoteStoreT m a
forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
forall a b.
RemoteStoreT m a -> (a -> RemoteStoreT m b) -> RemoteStoreT m b
forall (m :: * -> *). Monad m => Applicative (RemoteStoreT m)
forall (m :: * -> *) a. Monad m => a -> RemoteStoreT m a
forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> (a -> RemoteStoreT m b) -> RemoteStoreT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> (a -> RemoteStoreT m b) -> RemoteStoreT m b
>>= :: forall a b.
RemoteStoreT m a -> (a -> RemoteStoreT m b) -> RemoteStoreT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
>> :: forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> RemoteStoreT m a
return :: forall a. a -> RemoteStoreT m a
Monad
    , MonadReader Socket
    --, MonadState StoreState -- Avoid making the internal state explicit
    , MonadError RemoteStoreError
    , MonadThrow (RemoteStoreT m)
MonadThrow (RemoteStoreT m) =>
(forall e a.
 (HasCallStack, Exception e) =>
 RemoteStoreT m a -> (e -> RemoteStoreT m a) -> RemoteStoreT m a)
-> MonadCatch (RemoteStoreT m)
forall e a.
(HasCallStack, Exception e) =>
RemoteStoreT m a -> (e -> RemoteStoreT m a) -> RemoteStoreT m a
forall (m :: * -> *). MonadCatch m => MonadThrow (RemoteStoreT m)
forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
RemoteStoreT m a -> (e -> RemoteStoreT m a) -> RemoteStoreT m a
forall (m :: * -> *).
MonadThrow m =>
(forall e a.
 (HasCallStack, Exception e) =>
 m a -> (e -> m a) -> m a)
-> MonadCatch m
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, HasCallStack, Exception e) =>
RemoteStoreT m a -> (e -> RemoteStoreT m a) -> RemoteStoreT m a
catch :: forall e a.
(HasCallStack, Exception e) =>
RemoteStoreT m a -> (e -> RemoteStoreT m a) -> RemoteStoreT m a
MonadCatch
    , MonadCatch (RemoteStoreT m)
MonadCatch (RemoteStoreT m) =>
(forall b.
 HasCallStack =>
 ((forall a. RemoteStoreT m a -> RemoteStoreT m a)
  -> RemoteStoreT m b)
 -> RemoteStoreT m b)
-> (forall b.
    HasCallStack =>
    ((forall a. RemoteStoreT m a -> RemoteStoreT m a)
     -> RemoteStoreT m b)
    -> RemoteStoreT m b)
-> (forall a b c.
    HasCallStack =>
    RemoteStoreT m a
    -> (a -> ExitCase b -> RemoteStoreT m c)
    -> (a -> RemoteStoreT m b)
    -> RemoteStoreT m (b, c))
-> MonadMask (RemoteStoreT m)
forall b.
HasCallStack =>
((forall a. RemoteStoreT m a -> RemoteStoreT m a)
 -> RemoteStoreT m b)
-> RemoteStoreT m b
forall a b c.
HasCallStack =>
RemoteStoreT m a
-> (a -> ExitCase b -> RemoteStoreT m c)
-> (a -> RemoteStoreT m b)
-> RemoteStoreT m (b, c)
forall (m :: * -> *). MonadMask m => MonadCatch (RemoteStoreT m)
forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. RemoteStoreT m a -> RemoteStoreT m a)
 -> RemoteStoreT m b)
-> RemoteStoreT m b
forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
RemoteStoreT m a
-> (a -> ExitCase b -> RemoteStoreT m c)
-> (a -> RemoteStoreT m b)
-> RemoteStoreT m (b, c)
forall (m :: * -> *).
MonadCatch m =>
(forall b. HasCallStack => ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b.
    HasCallStack =>
    ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    HasCallStack =>
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
$cmask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. RemoteStoreT m a -> RemoteStoreT m a)
 -> RemoteStoreT m b)
-> RemoteStoreT m b
mask :: forall b.
HasCallStack =>
((forall a. RemoteStoreT m a -> RemoteStoreT m a)
 -> RemoteStoreT m b)
-> RemoteStoreT m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
(MonadMask m, HasCallStack) =>
((forall a. RemoteStoreT m a -> RemoteStoreT m a)
 -> RemoteStoreT m b)
-> RemoteStoreT m b
uninterruptibleMask :: forall b.
HasCallStack =>
((forall a. RemoteStoreT m a -> RemoteStoreT m a)
 -> RemoteStoreT m b)
-> RemoteStoreT m b
$cgeneralBracket :: forall (m :: * -> *) a b c.
(MonadMask m, HasCallStack) =>
RemoteStoreT m a
-> (a -> ExitCase b -> RemoteStoreT m c)
-> (a -> RemoteStoreT m b)
-> RemoteStoreT m (b, c)
generalBracket :: forall a b c.
HasCallStack =>
RemoteStoreT m a
-> (a -> ExitCase b -> RemoteStoreT m c)
-> (a -> RemoteStoreT m b)
-> RemoteStoreT m (b, c)
MonadMask
    , Monad (RemoteStoreT m)
Monad (RemoteStoreT m) =>
(forall e a. (HasCallStack, Exception e) => e -> RemoteStoreT m a)
-> MonadThrow (RemoteStoreT m)
forall e a. (HasCallStack, Exception e) => e -> RemoteStoreT m a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (RemoteStoreT m)
forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> RemoteStoreT m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, HasCallStack, Exception e) =>
e -> RemoteStoreT m a
throwM :: forall e a. (HasCallStack, Exception e) => e -> RemoteStoreT m a
MonadThrow
    , Monad (RemoteStoreT m)
Monad (RemoteStoreT m) =>
(forall a. IO a -> RemoteStoreT m a) -> MonadIO (RemoteStoreT m)
forall a. IO a -> RemoteStoreT m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (RemoteStoreT m)
forall (m :: * -> *) a. MonadIO m => IO a -> RemoteStoreT m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> RemoteStoreT m a
liftIO :: forall a. IO a -> RemoteStoreT m a
MonadIO
    )

instance MonadTrans RemoteStoreT where
  lift :: forall (m :: * -> *) a. Monad m => m a -> RemoteStoreT m a
lift = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
 -> RemoteStoreT m a)
-> (m a
    -> ExceptT
         RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a)
-> m a
-> RemoteStoreT m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateT RemoteStoreState (ReaderT Socket m) a
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT RemoteStoreError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT RemoteStoreState (ReaderT Socket m) a
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a)
-> (m a -> StateT RemoteStoreState (ReaderT Socket m) a)
-> m a
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT Socket m a -> StateT RemoteStoreState (ReaderT Socket m) a
forall (m :: * -> *) a.
Monad m =>
m a -> StateT RemoteStoreState m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ReaderT Socket m a
 -> StateT RemoteStoreState (ReaderT Socket m) a)
-> (m a -> ReaderT Socket m a)
-> m a
-> StateT RemoteStoreState (ReaderT Socket m) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m a -> ReaderT Socket m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT Socket m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- | Runner for @RemoteStoreT@
runRemoteStoreT
  :: Monad m
  => Socket
  -> RemoteStoreT m a
  -> m (Either RemoteStoreError a, DList Logger)
runRemoteStoreT :: forall (m :: * -> *) a.
Monad m =>
Socket
-> RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger)
runRemoteStoreT Socket
sock =
    ((Either RemoteStoreError a, RemoteStoreState)
 -> (Either RemoteStoreError a, DList Logger))
-> m (Either RemoteStoreError a, RemoteStoreState)
-> m (Either RemoteStoreError a, DList Logger)
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(Either RemoteStoreError a
res, RemoteStoreState{Maybe Word64
Maybe (Word64 -> IO (Maybe ByteString))
Maybe (ByteString -> IO ())
Maybe (NarSource IO)
DList Logger
ProtoStoreConfig
remoteStoreStateConfig :: RemoteStoreState -> ProtoStoreConfig
remoteStoreStateLogs :: RemoteStoreState -> DList Logger
remoteStoreStateMDataSource :: RemoteStoreState -> Maybe (Word64 -> IO (Maybe ByteString))
remoteStoreStateMDataSink :: RemoteStoreState -> Maybe (ByteString -> IO ())
remoteStoreStateMDataSinkSize :: RemoteStoreState -> Maybe Word64
remoteStoreStateMNarSource :: RemoteStoreState -> Maybe (NarSource IO)
remoteStoreStateConfig :: ProtoStoreConfig
remoteStoreStateLogs :: DList Logger
remoteStoreStateMDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
remoteStoreStateMDataSink :: Maybe (ByteString -> IO ())
remoteStoreStateMDataSinkSize :: Maybe Word64
remoteStoreStateMNarSource :: Maybe (NarSource IO)
..}) -> (Either RemoteStoreError a
res, DList Logger
remoteStoreStateLogs))
  (m (Either RemoteStoreError a, RemoteStoreState)
 -> m (Either RemoteStoreError a, DList Logger))
-> (RemoteStoreT m a
    -> m (Either RemoteStoreError a, RemoteStoreState))
-> RemoteStoreT m a
-> m (Either RemoteStoreError a, DList Logger)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ReaderT Socket m (Either RemoteStoreError a, RemoteStoreState)
-> Socket -> m (Either RemoteStoreError a, RemoteStoreState)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`runReaderT` Socket
sock)
  (ReaderT Socket m (Either RemoteStoreError a, RemoteStoreState)
 -> m (Either RemoteStoreError a, RemoteStoreState))
-> (RemoteStoreT m a
    -> ReaderT Socket m (Either RemoteStoreError a, RemoteStoreState))
-> RemoteStoreT m a
-> m (Either RemoteStoreError a, RemoteStoreState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StateT
  RemoteStoreState (ReaderT Socket m) (Either RemoteStoreError a)
-> RemoteStoreState
-> ReaderT Socket m (Either RemoteStoreError a, RemoteStoreState)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
`runStateT` RemoteStoreState
emptyState)
  (StateT
   RemoteStoreState (ReaderT Socket m) (Either RemoteStoreError a)
 -> ReaderT Socket m (Either RemoteStoreError a, RemoteStoreState))
-> (RemoteStoreT m a
    -> StateT
         RemoteStoreState (ReaderT Socket m) (Either RemoteStoreError a))
-> RemoteStoreT m a
-> ReaderT Socket m (Either RemoteStoreError a, RemoteStoreState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> StateT
     RemoteStoreState (ReaderT Socket m) (Either RemoteStoreError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT
  (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
 -> StateT
      RemoteStoreState (ReaderT Socket m) (Either RemoteStoreError a))
-> (RemoteStoreT m a
    -> ExceptT
         RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a)
-> RemoteStoreT m a
-> StateT
     RemoteStoreState (ReaderT Socket m) (Either RemoteStoreError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RemoteStoreT m a
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
forall (m :: * -> *) a.
RemoteStoreT m a
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
_unRemoteStoreT
  where
    emptyState :: RemoteStoreState
emptyState = RemoteStoreState
      { remoteStoreStateConfig :: ProtoStoreConfig
remoteStoreStateConfig = ProtoStoreConfig
forall a. Default a => a
def
      , remoteStoreStateLogs :: DList Logger
remoteStoreStateLogs = DList Logger
forall a. Monoid a => a
mempty
      , remoteStoreStateMDataSource :: Maybe (Word64 -> IO (Maybe ByteString))
remoteStoreStateMDataSource = Maybe (Word64 -> IO (Maybe ByteString))
forall a. Maybe a
Nothing
      , remoteStoreStateMDataSink :: Maybe (ByteString -> IO ())
remoteStoreStateMDataSink = Maybe (ByteString -> IO ())
forall a. Maybe a
Nothing
      , remoteStoreStateMDataSinkSize :: Maybe Word64
remoteStoreStateMDataSinkSize = Maybe Word64
forall a. Maybe a
Nothing
      , remoteStoreStateMNarSource :: Maybe (NarSource IO)
remoteStoreStateMNarSource = Maybe (NarSource IO)
forall a. Maybe a
Nothing
      }

class ( MonadIO m
      , MonadError RemoteStoreError m
      )
      => MonadRemoteStore m where

  appendLog :: Logger -> m ()
  default appendLog
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => Logger
    -> m ()
  appendLog = m' () -> m ()
m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m' () -> m ()) -> (Logger -> m' ()) -> Logger -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Logger -> m' ()
forall (m :: * -> *). MonadRemoteStore m => Logger -> m ()
appendLog

  getConfig :: m ProtoStoreConfig
  default getConfig
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => m ProtoStoreConfig
  getConfig = m' ProtoStoreConfig -> t m' ProtoStoreConfig
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' ProtoStoreConfig
forall (m :: * -> *). MonadRemoteStore m => m ProtoStoreConfig
getConfig

  getStoreDir :: m StoreDir
  default getStoreDir
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => m StoreDir
  getStoreDir = m' StoreDir -> t m' StoreDir
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' StoreDir
forall (m :: * -> *). MonadRemoteStore m => m StoreDir
getStoreDir

  setStoreDir :: StoreDir -> m ()
  default setStoreDir
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => StoreDir
    -> m ()
  setStoreDir = m' () -> m ()
m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m' () -> m ()) -> (StoreDir -> m' ()) -> StoreDir -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreDir -> m' ()
forall (m :: * -> *). MonadRemoteStore m => StoreDir -> m ()
setStoreDir

  -- | Get @ProtoVersion@ from state
  getProtoVersion :: m ProtoVersion
  default getProtoVersion
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => m ProtoVersion
  getProtoVersion = m' ProtoVersion -> t m' ProtoVersion
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' ProtoVersion
forall (m :: * -> *). MonadRemoteStore m => m ProtoVersion
getProtoVersion

  setProtoVersion :: ProtoVersion -> m ()
  default setProtoVersion
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => ProtoVersion
    -> m ()
  setProtoVersion = m' () -> m ()
m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m' () -> m ()) -> (ProtoVersion -> m' ()) -> ProtoVersion -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtoVersion -> m' ()
forall (m :: * -> *). MonadRemoteStore m => ProtoVersion -> m ()
setProtoVersion

  getStoreSocket :: m Socket
  default getStoreSocket
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => m Socket
  getStoreSocket = m' Socket -> t m' Socket
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' Socket
forall (m :: * -> *). MonadRemoteStore m => m Socket
getStoreSocket

  setNarSource :: NarSource IO -> m ()
  default setNarSource
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => NarSource IO
   -> m ()
  setNarSource NarSource IO
x = m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (NarSource IO -> m' ()
forall (m :: * -> *). MonadRemoteStore m => NarSource IO -> m ()
setNarSource NarSource IO
x)

  takeNarSource :: m (Maybe (NarSource IO))
  default takeNarSource
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => m (Maybe (NarSource IO))
  takeNarSource = m' (Maybe (NarSource IO)) -> t m' (Maybe (NarSource IO))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (Maybe (NarSource IO))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (NarSource IO))
takeNarSource

  setDataSource :: (Word64 -> IO (Maybe ByteString)) -> m ()
  default setDataSource
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => (Word64 -> IO (Maybe ByteString))
   -> m ()
  setDataSource Word64 -> IO (Maybe ByteString)
x = m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((Word64 -> IO (Maybe ByteString)) -> m' ()
forall (m :: * -> *).
MonadRemoteStore m =>
(Word64 -> IO (Maybe ByteString)) -> m ()
setDataSource Word64 -> IO (Maybe ByteString)
x)

  takeDataSource :: m (Maybe (Word64 -> IO (Maybe ByteString)))
  default takeDataSource
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => m (Maybe (Word64 -> IO (Maybe ByteString)))
  takeDataSource = m' (Maybe (Word64 -> IO (Maybe ByteString)))
-> t m' (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (Word64 -> IO (Maybe ByteString)))
takeDataSource

  getDataSource :: m (Maybe (Word64 -> IO (Maybe ByteString)))
  default getDataSource
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => m (Maybe (Word64 -> IO (Maybe ByteString)))
  getDataSource = m' (Maybe (Word64 -> IO (Maybe ByteString)))
-> t m' (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (Word64 -> IO (Maybe ByteString)))
getDataSource

  clearDataSource :: m ()
  default clearDataSource
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => m ()
  clearDataSource = m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' ()
forall (m :: * -> *). MonadRemoteStore m => m ()
clearDataSource

  setDataSink :: (ByteString -> IO ()) -> m ()
  default setDataSink
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => (ByteString -> IO ())
   -> m ()
  setDataSink ByteString -> IO ()
x = m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ((ByteString -> IO ()) -> m' ()
forall (m :: * -> *).
MonadRemoteStore m =>
(ByteString -> IO ()) -> m ()
setDataSink ByteString -> IO ()
x)

  getDataSink :: m (Maybe (ByteString -> IO ()))
  default getDataSink
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => m (Maybe (ByteString -> IO ()))
  getDataSink = m' (Maybe (ByteString -> IO ()))
-> t m' (Maybe (ByteString -> IO ()))
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (Maybe (ByteString -> IO ()))
forall (m :: * -> *).
MonadRemoteStore m =>
m (Maybe (ByteString -> IO ()))
getDataSink

  clearDataSink :: m ()
  default clearDataSink
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => m ()
  clearDataSink = m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' ()
forall (m :: * -> *). MonadRemoteStore m => m ()
clearDataSink

  setDataSinkSize :: Word64 -> m ()
  default setDataSinkSize
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => Word64
   -> m ()
  setDataSinkSize Word64
x = m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Word64 -> m' ()
forall (m :: * -> *). MonadRemoteStore m => Word64 -> m ()
setDataSinkSize Word64
x)

  getDataSinkSize :: m (Maybe Word64)
  default getDataSinkSize
   :: ( MonadTrans t
      , MonadRemoteStore m'
      , m ~ t m'
      )
   => m (Maybe Word64)
  getDataSinkSize = m' (Maybe Word64) -> t m' (Maybe Word64)
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' (Maybe Word64)
forall (m :: * -> *). MonadRemoteStore m => m (Maybe Word64)
getDataSinkSize

  clearDataSinkSize :: m ()
  default clearDataSinkSize
    :: ( MonadTrans t
       , MonadRemoteStore m'
       , m ~ t m'
       )
    => m ()
  clearDataSinkSize = m' () -> t m' ()
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m' ()
forall (m :: * -> *). MonadRemoteStore m => m ()
clearDataSinkSize

instance MonadRemoteStore m => MonadRemoteStore (StateT s m)
instance MonadRemoteStore m => MonadRemoteStore (ReaderT r m)
instance MonadRemoteStore m => MonadRemoteStore (ExceptT RemoteStoreError m)

instance MonadIO m => MonadRemoteStore (RemoteStoreT m) where

  getConfig :: RemoteStoreT m ProtoStoreConfig
getConfig = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  ProtoStoreConfig
-> RemoteStoreT m ProtoStoreConfig
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError
   (StateT RemoteStoreState (ReaderT Socket m))
   ProtoStoreConfig
 -> RemoteStoreT m ProtoStoreConfig)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     ProtoStoreConfig
-> RemoteStoreT m ProtoStoreConfig
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> ProtoStoreConfig)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     ProtoStoreConfig
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RemoteStoreState -> ProtoStoreConfig
remoteStoreStateConfig
  getProtoVersion :: RemoteStoreT m ProtoVersion
getProtoVersion = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  ProtoVersion
-> RemoteStoreT m ProtoVersion
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError
   (StateT RemoteStoreState (ReaderT Socket m))
   ProtoVersion
 -> RemoteStoreT m ProtoVersion)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     ProtoVersion
-> RemoteStoreT m ProtoVersion
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> ProtoVersion)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     ProtoVersion
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RemoteStoreState -> ProtoVersion
forall r. HasProtoVersion r => r -> ProtoVersion
hasProtoVersion
  setProtoVersion :: ProtoVersion -> RemoteStoreT m ()
setProtoVersion ProtoVersion
pv =
    ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s ->
      RemoteStoreState
s { remoteStoreStateConfig =
            (remoteStoreStateConfig s) { protoStoreConfigProtoVersion = pv }
      }
  getStoreDir :: RemoteStoreT m StoreDir
getStoreDir = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  StoreDir
-> RemoteStoreT m StoreDir
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError
   (StateT RemoteStoreState (ReaderT Socket m))
   StoreDir
 -> RemoteStoreT m StoreDir)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     StoreDir
-> RemoteStoreT m StoreDir
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> StoreDir)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     StoreDir
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RemoteStoreState -> StoreDir
forall r. HasStoreDir r => r -> StoreDir
hasStoreDir
  setStoreDir :: StoreDir -> RemoteStoreT m ()
setStoreDir StoreDir
sd =
    ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s ->
      RemoteStoreState
s { remoteStoreStateConfig =
            (remoteStoreStateConfig s) { protoStoreConfigDir = sd }
      }

  getStoreSocket :: RemoteStoreT m Socket
getStoreSocket = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  Socket
-> RemoteStoreT m Socket
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  Socket
forall r (m :: * -> *). MonadReader r m => m r
ask

  appendLog :: Logger -> RemoteStoreT m ()
appendLog Logger
x =
    ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT
    (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify
    ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateLogs = remoteStoreStateLogs s `Data.DList.snoc` x }

  setDataSource :: (Word64 -> IO (Maybe ByteString)) -> RemoteStoreT m ()
setDataSource Word64 -> IO (Maybe ByteString)
x = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMDataSource = pure x }
  getDataSource :: RemoteStoreT m (Maybe (Word64 -> IO (Maybe ByteString)))
getDataSource = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  (Maybe (Word64 -> IO (Maybe ByteString)))
-> RemoteStoreT m (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT ((RemoteStoreState -> Maybe (Word64 -> IO (Maybe ByteString)))
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (Word64 -> IO (Maybe ByteString)))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RemoteStoreState -> Maybe (Word64 -> IO (Maybe ByteString))
remoteStoreStateMDataSource)
  clearDataSource :: RemoteStoreT m ()
clearDataSource = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMDataSource = Nothing }

  takeDataSource :: RemoteStoreT m (Maybe (Word64 -> IO (Maybe ByteString)))
takeDataSource = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  (Maybe (Word64 -> IO (Maybe ByteString)))
-> RemoteStoreT m (Maybe (Word64 -> IO (Maybe ByteString)))
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError
   (StateT RemoteStoreState (ReaderT Socket m))
   (Maybe (Word64 -> IO (Maybe ByteString)))
 -> RemoteStoreT m (Maybe (Word64 -> IO (Maybe ByteString))))
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (Word64 -> IO (Maybe ByteString)))
-> RemoteStoreT m (Maybe (Word64 -> IO (Maybe ByteString)))
forall a b. (a -> b) -> a -> b
$ do
    Maybe (Word64 -> IO (Maybe ByteString))
x <- RemoteStoreState -> Maybe (Word64 -> IO (Maybe ByteString))
remoteStoreStateMDataSource (RemoteStoreState -> Maybe (Word64 -> IO (Maybe ByteString)))
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     RemoteStoreState
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (Word64 -> IO (Maybe ByteString)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  RemoteStoreState
forall s (m :: * -> *). MonadState s m => m s
get
    (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMDataSource = Nothing }
    Maybe (Word64 -> IO (Maybe ByteString))
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (Word64 -> IO (Maybe ByteString)))
forall a.
a
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Word64 -> IO (Maybe ByteString))
x

  setDataSink :: (ByteString -> IO ()) -> RemoteStoreT m ()
setDataSink ByteString -> IO ()
x = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMDataSink = pure x }
  getDataSink :: RemoteStoreT m (Maybe (ByteString -> IO ()))
getDataSink = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  (Maybe (ByteString -> IO ()))
-> RemoteStoreT m (Maybe (ByteString -> IO ()))
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT ((RemoteStoreState -> Maybe (ByteString -> IO ()))
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (ByteString -> IO ()))
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RemoteStoreState -> Maybe (ByteString -> IO ())
remoteStoreStateMDataSink)
  clearDataSink :: RemoteStoreT m ()
clearDataSink = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMDataSink = Nothing }

  setDataSinkSize :: Word64 -> RemoteStoreT m ()
setDataSinkSize Word64
x = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMDataSinkSize = pure x }
  getDataSinkSize :: RemoteStoreT m (Maybe Word64)
getDataSinkSize = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  (Maybe Word64)
-> RemoteStoreT m (Maybe Word64)
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT ((RemoteStoreState -> Maybe Word64)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe Word64)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets RemoteStoreState -> Maybe Word64
remoteStoreStateMDataSinkSize)
  clearDataSinkSize :: RemoteStoreT m ()
clearDataSinkSize = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMDataSinkSize = Nothing }

  setNarSource :: NarSource IO -> RemoteStoreT m ()
setNarSource NarSource IO
x = ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
 -> RemoteStoreT m ())
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMNarSource = pure x }
  takeNarSource :: RemoteStoreT m (Maybe (NarSource IO))
takeNarSource = ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  (Maybe (NarSource IO))
-> RemoteStoreT m (Maybe (NarSource IO))
forall (m :: * -> *) a.
ExceptT
  RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
-> RemoteStoreT m a
RemoteStoreT (ExceptT
   RemoteStoreError
   (StateT RemoteStoreState (ReaderT Socket m))
   (Maybe (NarSource IO))
 -> RemoteStoreT m (Maybe (NarSource IO)))
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (NarSource IO))
-> RemoteStoreT m (Maybe (NarSource IO))
forall a b. (a -> b) -> a -> b
$ do
    Maybe (NarSource IO)
x <- RemoteStoreState -> Maybe (NarSource IO)
remoteStoreStateMNarSource (RemoteStoreState -> Maybe (NarSource IO))
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     RemoteStoreState
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (NarSource IO))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT
  RemoteStoreError
  (StateT RemoteStoreState (ReaderT Socket m))
  RemoteStoreState
forall s (m :: * -> *). MonadState s m => m s
get
    (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((RemoteStoreState -> RemoteStoreState)
 -> ExceptT
      RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ())
-> (RemoteStoreState -> RemoteStoreState)
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) ()
forall a b. (a -> b) -> a -> b
$ \RemoteStoreState
s -> RemoteStoreState
s { remoteStoreStateMNarSource = Nothing }
    Maybe (NarSource IO)
-> ExceptT
     RemoteStoreError
     (StateT RemoteStoreState (ReaderT Socket m))
     (Maybe (NarSource IO))
forall a.
a
-> ExceptT
     RemoteStoreError (StateT RemoteStoreState (ReaderT Socket m)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (NarSource IO)
x