{-# 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))
, RemoteStoreState -> Maybe (ByteString -> IO ())
remoteStoreStateMDataSink :: Maybe (ByteString -> IO ())
, RemoteStoreState -> Maybe Word64
remoteStoreStateMDataSinkSize :: Maybe Word64
, 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
| RemoteStoreError_GenericIncrementalFail String ByteString
| 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
| RemoteStoreError_LoggerParserFail String ByteString
| RemoteStoreError_NoDataSourceProvided
| RemoteStoreError_DataSourceExhausted
| RemoteStoreError_DataSourceZeroLengthRead
| RemoteStoreError_DataSourceReadTooLarge
| RemoteStoreError_NoDataSinkProvided
| RemoteStoreError_NoDataSinkSizeProvided
| RemoteStoreError_NoNarSourceProvided
| RemoteStoreError_OperationFailed
| RemoteStoreError_ProtocolMismatch
| RemoteStoreError_RapairNotSupportedByRemoteStore
| RemoteStoreError_WorkerMagic2Mismatch
| RemoteStoreError_WorkerError WorkerError
| 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
data WorkerException
= WorkerException_ClientVersionTooOld
| WorkerException_ProtocolMismatch
| WorkerException_Error WorkerError
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)
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
, 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
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
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