{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
module System.Nix.Store.Remote.Server
( runProxyDaemon
, WorkerHelper
)
where
import Control.Concurrent.Classy.Async
import Control.Monad (join, void, when)
import Control.Monad.Conc.Class (MonadConc)
import Control.Monad.Except (MonadError, throwError)
import Control.Monad.Trans (lift)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.Default.Class (Default(def))
import Data.Foldable (traverse_)
import Data.IORef (IORef, atomicModifyIORef, newIORef)
import Data.Text (Text)
import Data.Void (Void, absurd)
import Data.Word (Word32)
import Network.Socket (Socket, accept, close, listen, maxListenQueue)
import System.Nix.Nar (NarSource)
import System.Nix.Store.Remote.Client (Run, doReq)
import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
import System.Nix.Store.Remote.Socket
import System.Nix.Store.Remote.Types.StoreRequest as R
import System.Nix.Store.Remote.Types.StoreReply
import System.Nix.Store.Remote.Types.ProtoVersion (ProtoVersion(..))
import System.Nix.Store.Remote.Types.Logger (BasicError(..), ErrorInfo, Logger(..))
import System.Nix.Store.Remote.MonadStore (MonadRemoteStore(..), WorkerError(..), WorkerException(..), RemoteStoreError(..), RemoteStoreT, runRemoteStoreT)
import System.Nix.Store.Remote.Types.Handshake (ServerHandshakeInput(..), ServerHandshakeOutput(..))
import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
import qualified Data.Some
import qualified Data.Text
import qualified Data.Text.IO
import qualified System.Timeout
import qualified Network.Socket.ByteString
type WorkerHelper m
= forall a
. ( Show a
, StoreReply a
)
=> RemoteStoreT m a
-> Run m a
chatty :: Bool
chatty :: Bool
chatty = Bool
False
dbg :: MonadIO m => Text -> m ()
dbg :: forall (m :: * -> *). MonadIO m => Text -> m ()
dbg = Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
chatty (m () -> m ()) -> (Text -> m ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Text -> IO ()) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Data.Text.IO.putStrLn
runProxyDaemon
:: forall m a
. ( MonadIO m
, MonadConc m
)
=> WorkerHelper m
-> RemoteStoreT m ()
-> Socket
-> m a
-> m a
runProxyDaemon :: forall (m :: * -> *) a.
(MonadIO m, MonadConc m) =>
WorkerHelper m -> RemoteStoreT m () -> Socket -> m a -> m a
runProxyDaemon WorkerHelper m
workerHelper RemoteStoreT m ()
postGreet Socket
lsock m a
k = do
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> Int -> IO ()
listen Socket
lsock Int
maxListenQueue
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
dbg Text
"listening"
let listener :: m Void
listener :: m Void
listener = do
(Socket
sock, SockAddr
_) <- IO (Socket, SockAddr) -> m (Socket, SockAddr)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Socket, SockAddr) -> m (Socket, SockAddr))
-> IO (Socket, SockAddr) -> m (Socket, SockAddr)
forall a b. (a -> b) -> a -> b
$ Socket -> IO (Socket, SockAddr)
accept Socket
lsock
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
dbg Text
"accepting"
((Void, ()) -> Void) -> m (Void, ()) -> m Void
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Void, ()) -> Void
forall a b. (a, b) -> a
fst
(m (Void, ()) -> m Void) -> m (Void, ()) -> m Void
forall a b. (a -> b) -> a -> b
$ m Void -> m () -> m (Void, ())
forall (m :: * -> *) a b. MonadConc m => m a -> m b -> m (a, b)
concurrently m Void
listener
(m () -> m (Void, ())) -> m () -> m (Void, ())
forall a b. (a -> b) -> a -> b
$ WorkerHelper m -> RemoteStoreT m () -> Socket -> m ()
forall (m :: * -> *).
MonadIO m =>
WorkerHelper m -> RemoteStoreT m () -> Socket -> m ()
processConnection RemoteStoreT m a -> Run m a
WorkerHelper m
workerHelper RemoteStoreT m ()
postGreet Socket
sock
(Void -> a) -> (a -> a) -> Either Void a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Void -> a
forall a. Void -> a
absurd a -> a
forall a. a -> a
id (Either Void a -> a) -> m (Either Void a) -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Void -> m a -> m (Either Void a)
forall (m :: * -> *) a b.
MonadConc m =>
m a -> m b -> m (Either a b)
race m Void
listener m a
k
processConnection
:: forall m
. MonadIO m
=> WorkerHelper m
-> RemoteStoreT m ()
-> Socket
-> m ()
processConnection :: forall (m :: * -> *).
MonadIO m =>
WorkerHelper m -> RemoteStoreT m () -> Socket -> m ()
processConnection WorkerHelper m
workerHelper RemoteStoreT m ()
postGreet Socket
sock = do
~() <- m (Either RemoteStoreError Any, DList Logger) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Either RemoteStoreError Any, DList Logger) -> m ())
-> m (Either RemoteStoreError Any, DList Logger) -> m ()
forall a b. (a -> b) -> a -> b
$ Socket
-> RemoteStoreT m Any
-> m (Either RemoteStoreError Any, DList Logger)
forall (m :: * -> *) a.
Monad m =>
Socket
-> RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger)
runRemoteStoreT Socket
sock (RemoteStoreT m Any
-> m (Either RemoteStoreError Any, DList Logger))
-> RemoteStoreT m Any
-> m (Either RemoteStoreError Any, DList Logger)
forall a b. (a -> b) -> a -> b
$ do
ServerHandshakeOutput{ProtoVersion
serverHandshakeOutputLeastCommonVersion :: ProtoVersion
serverHandshakeOutputClientVersion :: ProtoVersion
serverHandshakeOutputLeastCommonVersion :: ServerHandshakeOutput -> ProtoVersion
serverHandshakeOutputClientVersion :: ServerHandshakeOutput -> ProtoVersion
..}
<- MonadIO m =>
ServerHandshakeInput -> RemoteStoreT m ServerHandshakeOutput
ServerHandshakeInput -> RemoteStoreT m ServerHandshakeOutput
greet
ServerHandshakeInput
{ serverHandshakeInputNixVersion :: Text
serverHandshakeInputNixVersion = Text
"nixVersion (hnix-store-remote)"
, serverHandshakeInputOurVersion :: ProtoVersion
serverHandshakeInputOurVersion = ProtoVersion
forall a. Default a => a
def
, serverHandshakeInputTrust :: Maybe TrustedFlag
serverHandshakeInputTrust = Maybe TrustedFlag
forall a. Maybe a
Nothing
}
ProtoVersion -> RemoteStoreT m ()
forall (m :: * -> *). MonadRemoteStore m => ProtoVersion -> m ()
setProtoVersion ProtoVersion
serverHandshakeOutputLeastCommonVersion
TunnelLogger
tunnelLogger <- IO TunnelLogger -> RemoteStoreT m TunnelLogger
forall a. IO a -> RemoteStoreT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO TunnelLogger -> RemoteStoreT m TunnelLogger)
-> IO TunnelLogger -> RemoteStoreT m TunnelLogger
forall a b. (a -> b) -> a -> b
$ IO TunnelLogger
newTunnelLogger
TunnelLogger -> RemoteStoreT m ()
forall (m :: * -> *). MonadRemoteStore m => TunnelLogger -> m ()
startWork TunnelLogger
tunnelLogger
TunnelLogger -> RemoteStoreT m ()
forall (m :: * -> *). MonadRemoteStore m => TunnelLogger -> m ()
stopWork TunnelLogger
tunnelLogger
RemoteStoreT m ()
postGreet
let perform
:: ( Show a
, StoreReply a
)
=> StoreRequest a
-> RemoteStoreT m ()
perform :: forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
req = do
RemoteStoreT m ()
special <- case StoreRequest a
req of
AddToStore {} -> do
let proxyNarSource :: NarSource IO
proxyNarSource :: NarSource IO
proxyNarSource ByteString -> IO ()
f =
IO (Maybe ByteString) -> IO (Maybe ByteString)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO
(Int -> IO ByteString -> IO (Maybe ByteString)
forall a. Int -> IO a -> IO (Maybe a)
System.Timeout.timeout
Int
1000000
(Socket -> Int -> IO ByteString
Network.Socket.ByteString.recv Socket
sock Int
8)
)
IO (Maybe ByteString) -> (Maybe ByteString -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe ByteString
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just ByteString
x -> ByteString -> IO ()
f ByteString
x IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> NarSource IO
proxyNarSource ByteString -> IO ()
f
RemoteStoreT m () -> RemoteStoreT m (RemoteStoreT m ())
forall a. a -> RemoteStoreT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteStoreT m () -> RemoteStoreT m (RemoteStoreT m ()))
-> RemoteStoreT m () -> RemoteStoreT m (RemoteStoreT m ())
forall a b. (a -> b) -> a -> b
$ NarSource IO -> RemoteStoreT m ()
forall (m :: * -> *). MonadRemoteStore m => NarSource IO -> m ()
setNarSource NarSource IO
proxyNarSource
StoreRequest a
_ -> RemoteStoreT m () -> RemoteStoreT m (RemoteStoreT m ())
forall a. a -> RemoteStoreT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RemoteStoreT m () -> RemoteStoreT m (RemoteStoreT m ()))
-> RemoteStoreT m () -> RemoteStoreT m (RemoteStoreT m ())
forall a b. (a -> b) -> a -> b
$ () -> RemoteStoreT m ()
forall a. a -> RemoteStoreT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
(Either RemoteStoreError a, DList Logger)
res <-
TunnelLogger
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger)
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger)
forall (m :: * -> *) a.
MonadRemoteStore m =>
TunnelLogger -> m a -> m a
bracketLogger
TunnelLogger
tunnelLogger
(RemoteStoreT m (Either RemoteStoreError a, DList Logger)
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger))
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger)
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger)
forall a b. (a -> b) -> a -> b
$ m (Either RemoteStoreError a, DList Logger)
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger)
forall (m :: * -> *) a. Monad m => m a -> RemoteStoreT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
(m (Either RemoteStoreError a, DList Logger)
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger))
-> m (Either RemoteStoreError a, DList Logger)
-> RemoteStoreT m (Either RemoteStoreError a, DList Logger)
forall a b. (a -> b) -> a -> b
$ RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger)
WorkerHelper m
workerHelper
(RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger))
-> RemoteStoreT m a -> m (Either RemoteStoreError a, DList Logger)
forall a b. (a -> b) -> a -> b
$ RemoteStoreT m ()
special RemoteStoreT m () -> RemoteStoreT m a -> RemoteStoreT m a
forall a b.
RemoteStoreT m a -> RemoteStoreT m b -> RemoteStoreT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StoreRequest a -> RemoteStoreT m a
forall (m :: * -> *) a.
(MonadIO m, MonadRemoteStore m, StoreReply a, Show a) =>
StoreRequest a -> m a
doReq StoreRequest a
req
case (Either RemoteStoreError a, DList Logger)
-> Either RemoteStoreError a
forall a b. (a, b) -> a
fst (Either RemoteStoreError a, DList Logger)
res of
Left RemoteStoreError
e -> RemoteStoreError -> RemoteStoreT m ()
forall a. RemoteStoreError -> RemoteStoreT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError RemoteStoreError
e
Right a
reply ->
NixSerializer ProtoStoreConfig RemoteStoreError a
-> a -> RemoteStoreT m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS
((ReplySError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig ReplySError a
-> NixSerializer ProtoStoreConfig RemoteStoreError a
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
ReplySError -> RemoteStoreError
RemoteStoreError_SerializerReply
(NixSerializer ProtoStoreConfig ReplySError a
-> NixSerializer ProtoStoreConfig RemoteStoreError a)
-> NixSerializer ProtoStoreConfig ReplySError a
-> NixSerializer ProtoStoreConfig RemoteStoreError a
forall a b. (a -> b) -> a -> b
$ NixSerializer ProtoStoreConfig ReplySError a
forall a.
StoreReply a =>
NixSerializer ProtoStoreConfig ReplySError a
getReplyS
)
a
reply
let loop :: RemoteStoreT m Any
loop = do
Some StoreRequest
someReq <-
NixSerializer ProtoStoreConfig RemoteStoreError (Some StoreRequest)
-> RemoteStoreT m (Some StoreRequest)
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS
(NixSerializer
ProtoStoreConfig RemoteStoreError (Some StoreRequest)
-> RemoteStoreT m (Some StoreRequest))
-> NixSerializer
ProtoStoreConfig RemoteStoreError (Some StoreRequest)
-> RemoteStoreT m (Some StoreRequest)
forall a b. (a -> b) -> a -> b
$ (RequestSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig RequestSError (Some StoreRequest)
-> NixSerializer
ProtoStoreConfig RemoteStoreError (Some StoreRequest)
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
RequestSError -> RemoteStoreError
RemoteStoreError_SerializerRequest
NixSerializer ProtoStoreConfig RequestSError (Some StoreRequest)
forall r.
(HasProtoVersion r, HasStoreDir r) =>
NixSerializer r RequestSError (Some StoreRequest)
storeRequest
() <- Some StoreRequest
-> (forall {a}. StoreRequest a -> RemoteStoreT m ())
-> RemoteStoreT m ()
forall {k} (tag :: k -> *) b.
Some tag -> (forall (a :: k). tag a -> b) -> b
Data.Some.withSome Some StoreRequest
someReq ((forall {a}. StoreRequest a -> RemoteStoreT m ())
-> RemoteStoreT m ())
-> (forall {a}. StoreRequest a -> RemoteStoreT m ())
-> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ \case
r :: StoreRequest a
r@AddToStore {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@AddToStoreNar {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@AddTextToStore {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@AddSignatures {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@AddTempRoot {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@AddIndirectRoot {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@BuildDerivation {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@BuildPaths {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@CollectGarbage {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@EnsurePath {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@FindRoots {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@IsValidPath {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@NarFromPath {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryValidPaths {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryAllValidPaths {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QuerySubstitutablePaths {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryPathInfo {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryReferrers {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryValidDerivers {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryDerivationOutputs {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryDerivationOutputNames {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryPathFromHashPart {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@QueryMissing {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@OptimiseStore {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@SyncWithGC {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
r :: StoreRequest a
r@VerifyStore {} -> StoreRequest a -> RemoteStoreT m ()
forall a.
(Show a, StoreReply a) =>
StoreRequest a -> RemoteStoreT m ()
perform StoreRequest a
r
RemoteStoreT m Any
loop
RemoteStoreT m Any
loop
Text -> m ()
forall (m :: * -> *). MonadIO m => Text -> m ()
dbg Text
"daemon connection done"
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Socket -> IO ()
close Socket
sock
where
greet
:: MonadIO m
=> ServerHandshakeInput
-> RemoteStoreT m ServerHandshakeOutput
greet :: MonadIO m =>
ServerHandshakeInput -> RemoteStoreT m ServerHandshakeOutput
greet ServerHandshakeInput{Maybe TrustedFlag
Text
ProtoVersion
serverHandshakeInputNixVersion :: ServerHandshakeInput -> Text
serverHandshakeInputOurVersion :: ServerHandshakeInput -> ProtoVersion
serverHandshakeInputTrust :: ServerHandshakeInput -> Maybe TrustedFlag
serverHandshakeInputNixVersion :: Text
serverHandshakeInputOurVersion :: ProtoVersion
serverHandshakeInputTrust :: Maybe TrustedFlag
..} = do
WorkerMagic
magic <-
NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
-> RemoteStoreT m WorkerMagic
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS
(NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
-> RemoteStoreT m WorkerMagic)
-> NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
-> RemoteStoreT m WorkerMagic
forall a b. (a -> b) -> a -> b
$ (HandshakeSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
-> NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
HandshakeSError -> RemoteStoreError
RemoteStoreError_SerializerHandshake
NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
forall r. NixSerializer r HandshakeSError WorkerMagic
workerMagic
Bool -> RemoteStoreT m () -> RemoteStoreT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (WorkerMagic
magic WorkerMagic -> WorkerMagic -> Bool
forall a. Eq a => a -> a -> Bool
/= WorkerMagic
WorkerMagic_One)
(RemoteStoreT m () -> RemoteStoreT m ())
-> RemoteStoreT m () -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> RemoteStoreT m ()
forall a. RemoteStoreError -> RemoteStoreT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(RemoteStoreError -> RemoteStoreT m ())
-> RemoteStoreError -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ WorkerException -> RemoteStoreError
RemoteStoreError_WorkerException
WorkerException
WorkerException_ProtocolMismatch
NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
-> WorkerMagic -> RemoteStoreT m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS
((HandshakeSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
-> NixSerializer ProtoStoreConfig RemoteStoreError WorkerMagic
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
HandshakeSError -> RemoteStoreError
RemoteStoreError_SerializerHandshake
NixSerializer ProtoStoreConfig HandshakeSError WorkerMagic
forall r. NixSerializer r HandshakeSError WorkerMagic
workerMagic
)
WorkerMagic
WorkerMagic_Two
NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
-> ProtoVersion -> RemoteStoreT m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
forall r e. NixSerializer r e ProtoVersion
protoVersion ProtoVersion
serverHandshakeInputOurVersion
ProtoVersion
clientVersion <- NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
-> RemoteStoreT m ProtoVersion
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS NixSerializer ProtoStoreConfig RemoteStoreError ProtoVersion
forall r e. NixSerializer r e ProtoVersion
protoVersion
let leastCommonVersion :: ProtoVersion
leastCommonVersion = ProtoVersion -> ProtoVersion -> ProtoVersion
forall a. Ord a => a -> a -> a
min ProtoVersion
clientVersion ProtoVersion
serverHandshakeInputOurVersion
Bool -> RemoteStoreT m () -> RemoteStoreT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
clientVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
< Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
10)
(RemoteStoreT m () -> RemoteStoreT m ())
-> RemoteStoreT m () -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ RemoteStoreError -> RemoteStoreT m ()
forall a. RemoteStoreError -> RemoteStoreT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError
(RemoteStoreError -> RemoteStoreT m ())
-> RemoteStoreError -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ WorkerException -> RemoteStoreError
RemoteStoreError_WorkerException
WorkerException
WorkerException_ClientVersionTooOld
Bool -> RemoteStoreT m () -> RemoteStoreT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
clientVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
14) (RemoteStoreT m () -> RemoteStoreT m ())
-> RemoteStoreT m () -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ do
Word32
x :: Word32 <- NixSerializer ProtoStoreConfig RemoteStoreError Word32
-> RemoteStoreT m Word32
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS NixSerializer ProtoStoreConfig RemoteStoreError Word32
forall a r e. Integral a => NixSerializer r e a
int
Bool -> RemoteStoreT m () -> RemoteStoreT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word32
x Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word32
0) (RemoteStoreT m () -> RemoteStoreT m ())
-> RemoteStoreT m () -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ do
Word32
_ :: Word32 <- NixSerializer ProtoStoreConfig RemoteStoreError Word32
-> RemoteStoreT m Word32
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS NixSerializer ProtoStoreConfig RemoteStoreError Word32
forall a r e. Integral a => NixSerializer r e a
int
() -> RemoteStoreT m ()
forall a. a -> RemoteStoreT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool -> RemoteStoreT m () -> RemoteStoreT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
clientVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
11) (RemoteStoreT m () -> RemoteStoreT m ())
-> RemoteStoreT m () -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ do
Word32
_ :: Word32 <- NixSerializer ProtoStoreConfig RemoteStoreError Word32
-> RemoteStoreT m Word32
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m, Show a, Show e) =>
NixSerializer ProtoStoreConfig e a -> m a
sockGetS NixSerializer ProtoStoreConfig RemoteStoreError Word32
forall a r e. Integral a => NixSerializer r e a
int
() -> RemoteStoreT m ()
forall a. a -> RemoteStoreT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Bool -> RemoteStoreT m () -> RemoteStoreT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
clientVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
33) (RemoteStoreT m () -> RemoteStoreT m ())
-> RemoteStoreT m () -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ do
NixSerializer ProtoStoreConfig RemoteStoreError Text
-> Text -> RemoteStoreT m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS
((SError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig SError Text
-> NixSerializer ProtoStoreConfig RemoteStoreError Text
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
SError -> RemoteStoreError
RemoteStoreError_SerializerPut
NixSerializer ProtoStoreConfig SError Text
forall r. NixSerializer r SError Text
text
)
Text
serverHandshakeInputNixVersion
Bool -> RemoteStoreT m () -> RemoteStoreT m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtoVersion
clientVersion ProtoVersion -> ProtoVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= Word16 -> Word8 -> ProtoVersion
ProtoVersion Word16
1 Word8
35) (RemoteStoreT m () -> RemoteStoreT m ())
-> RemoteStoreT m () -> RemoteStoreT m ()
forall a b. (a -> b) -> a -> b
$ do
NixSerializer ProtoStoreConfig RemoteStoreError (Maybe TrustedFlag)
-> Maybe TrustedFlag -> RemoteStoreT m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS
((HandshakeSError -> RemoteStoreError)
-> NixSerializer
ProtoStoreConfig HandshakeSError (Maybe TrustedFlag)
-> NixSerializer
ProtoStoreConfig RemoteStoreError (Maybe TrustedFlag)
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS
HandshakeSError -> RemoteStoreError
RemoteStoreError_SerializerHandshake
NixSerializer ProtoStoreConfig HandshakeSError (Maybe TrustedFlag)
forall r. NixSerializer r HandshakeSError (Maybe TrustedFlag)
trustedFlag
)
Maybe TrustedFlag
serverHandshakeInputTrust
ServerHandshakeOutput -> RemoteStoreT m ServerHandshakeOutput
forall a. a -> RemoteStoreT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerHandshakeOutput
{ serverHandshakeOutputLeastCommonVersion :: ProtoVersion
serverHandshakeOutputLeastCommonVersion = ProtoVersion
leastCommonVersion
, serverHandshakeOutputClientVersion :: ProtoVersion
serverHandshakeOutputClientVersion = ProtoVersion
clientVersion
}
{-# WARNING _unimplemented "not yet implemented" #-}
_unimplemented :: RemoteStoreError
_unimplemented :: RemoteStoreError
_unimplemented = WorkerException -> RemoteStoreError
RemoteStoreError_WorkerException (WorkerException -> RemoteStoreError)
-> WorkerException -> RemoteStoreError
forall a b. (a -> b) -> a -> b
$ WorkerError -> WorkerException
WorkerException_Error (WorkerError -> WorkerException) -> WorkerError -> WorkerException
forall a b. (a -> b) -> a -> b
$ WorkerError
WorkerError_NotYetImplemented
bracketLogger
:: MonadRemoteStore m
=> TunnelLogger
-> m a
-> m a
bracketLogger :: forall (m :: * -> *) a.
MonadRemoteStore m =>
TunnelLogger -> m a -> m a
bracketLogger TunnelLogger
tunnelLogger m a
m = do
TunnelLogger -> m ()
forall (m :: * -> *). MonadRemoteStore m => TunnelLogger -> m ()
startWork TunnelLogger
tunnelLogger
a
a <- m a
m
TunnelLogger -> m ()
forall (m :: * -> *). MonadRemoteStore m => TunnelLogger -> m ()
stopWork TunnelLogger
tunnelLogger
a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
data TunnelLogger = TunnelLogger
{ TunnelLogger -> IORef TunnelLoggerState
_tunnelLogger_state :: IORef TunnelLoggerState
}
data TunnelLoggerState = TunnelLoggerState
{ TunnelLoggerState -> Bool
_tunnelLoggerState_canSendStderr :: Bool
, TunnelLoggerState -> [Logger]
_tunnelLoggerState_pendingMsgs :: [Logger]
}
newTunnelLogger :: IO TunnelLogger
newTunnelLogger :: IO TunnelLogger
newTunnelLogger = IORef TunnelLoggerState -> TunnelLogger
TunnelLogger (IORef TunnelLoggerState -> TunnelLogger)
-> IO (IORef TunnelLoggerState) -> IO TunnelLogger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TunnelLoggerState -> IO (IORef TunnelLoggerState)
forall a. a -> IO (IORef a)
newIORef (Bool -> [Logger] -> TunnelLoggerState
TunnelLoggerState Bool
False [])
enqueueMsg
:: ( MonadRemoteStore m
, MonadError LoggerSError m
)
=> TunnelLogger
-> Logger
-> m ()
enqueueMsg :: forall (m :: * -> *).
(MonadRemoteStore m, MonadError LoggerSError m) =>
TunnelLogger -> Logger -> m ()
enqueueMsg TunnelLogger
x Logger
l = TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ()
forall (m :: * -> *) a.
MonadRemoteStore m =>
TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m a)) -> m a
updateLogger TunnelLogger
x ((TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ())
-> (TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \st :: TunnelLoggerState
st@(TunnelLoggerState Bool
c [Logger]
p) -> case Bool
c of
Bool
True -> (TunnelLoggerState
st, NixSerializer ProtoStoreConfig LoggerSError Logger
-> Logger -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig LoggerSError Logger
forall r. HasProtoVersion r => NixSerializer r LoggerSError Logger
logger Logger
l)
Bool
False -> (Bool -> [Logger] -> TunnelLoggerState
TunnelLoggerState Bool
c (Logger
lLogger -> [Logger] -> [Logger]
forall a. a -> [a] -> [a]
:[Logger]
p), () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
_log
:: ( MonadRemoteStore m
, MonadError LoggerSError m
)
=> TunnelLogger
-> Text
-> m ()
_log :: forall (m :: * -> *).
(MonadRemoteStore m, MonadError LoggerSError m) =>
TunnelLogger -> Text -> m ()
_log TunnelLogger
l Text
s = TunnelLogger -> Logger -> m ()
forall (m :: * -> *).
(MonadRemoteStore m, MonadError LoggerSError m) =>
TunnelLogger -> Logger -> m ()
enqueueMsg TunnelLogger
l (Text -> Logger
Logger_Next Text
s)
startWork
:: MonadRemoteStore m
=> TunnelLogger
-> m ()
startWork :: forall (m :: * -> *). MonadRemoteStore m => TunnelLogger -> m ()
startWork TunnelLogger
x = TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ()
forall (m :: * -> *) a.
MonadRemoteStore m =>
TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m a)) -> m a
updateLogger TunnelLogger
x ((TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ())
-> (TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \(TunnelLoggerState Bool
_ [Logger]
p) -> (,)
(Bool -> [Logger] -> TunnelLoggerState
TunnelLoggerState Bool
True []) (m () -> (TunnelLoggerState, m ()))
-> m () -> (TunnelLoggerState, m ())
forall a b. (a -> b) -> a -> b
$
((Logger -> m ()) -> [Logger] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (NixSerializer ProtoStoreConfig RemoteStoreError Logger
-> Logger -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError Logger
logger') ([Logger] -> m ()) -> [Logger] -> m ()
forall a b. (a -> b) -> a -> b
$ [Logger] -> [Logger]
forall a. [a] -> [a]
reverse [Logger]
p)
where logger' :: NixSerializer ProtoStoreConfig RemoteStoreError Logger
logger' = (LoggerSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig LoggerSError Logger
-> NixSerializer ProtoStoreConfig RemoteStoreError Logger
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS LoggerSError -> RemoteStoreError
RemoteStoreError_SerializerLogger NixSerializer ProtoStoreConfig LoggerSError Logger
forall r. HasProtoVersion r => NixSerializer r LoggerSError Logger
logger
stopWork
:: MonadRemoteStore m
=> TunnelLogger
-> m ()
stopWork :: forall (m :: * -> *). MonadRemoteStore m => TunnelLogger -> m ()
stopWork TunnelLogger
x = TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ()
forall (m :: * -> *) a.
MonadRemoteStore m =>
TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m a)) -> m a
updateLogger TunnelLogger
x ((TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ())
-> (TunnelLoggerState -> (TunnelLoggerState, m ())) -> m ()
forall a b. (a -> b) -> a -> b
$ \TunnelLoggerState
_ -> (,)
(Bool -> [Logger] -> TunnelLoggerState
TunnelLoggerState Bool
False [])
(NixSerializer ProtoStoreConfig RemoteStoreError Logger
-> Logger -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS ((LoggerSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig LoggerSError Logger
-> NixSerializer ProtoStoreConfig RemoteStoreError Logger
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS LoggerSError -> RemoteStoreError
RemoteStoreError_SerializerLogger NixSerializer ProtoStoreConfig LoggerSError Logger
forall r. HasProtoVersion r => NixSerializer r LoggerSError Logger
logger) Logger
Logger_Last)
_stopWorkOnError
:: MonadRemoteStore m
=> TunnelLogger
-> ErrorInfo
-> m Bool
_stopWorkOnError :: forall (m :: * -> *).
MonadRemoteStore m =>
TunnelLogger -> ErrorInfo -> m Bool
_stopWorkOnError TunnelLogger
x ErrorInfo
ex = TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m Bool)) -> m Bool
forall (m :: * -> *) a.
MonadRemoteStore m =>
TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m a)) -> m a
updateLogger TunnelLogger
x ((TunnelLoggerState -> (TunnelLoggerState, m Bool)) -> m Bool)
-> (TunnelLoggerState -> (TunnelLoggerState, m Bool)) -> m Bool
forall a b. (a -> b) -> a -> b
$ \TunnelLoggerState
st ->
case TunnelLoggerState -> Bool
_tunnelLoggerState_canSendStderr TunnelLoggerState
st of
Bool
False -> (TunnelLoggerState
st, Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
Bool
True -> (,) (Bool -> [Logger] -> TunnelLoggerState
TunnelLoggerState Bool
False []) (m Bool -> (TunnelLoggerState, m Bool))
-> m Bool -> (TunnelLoggerState, m Bool)
forall a b. (a -> b) -> a -> b
$ do
m ProtoVersion
forall (m :: * -> *). MonadRemoteStore m => m ProtoVersion
getProtoVersion m ProtoVersion -> (ProtoVersion -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ProtoVersion
pv -> if ProtoVersion -> Word8
protoVersion_minor ProtoVersion
pv Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
26
then NixSerializer ProtoStoreConfig RemoteStoreError Logger
-> Logger -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError Logger
logger' (Either BasicError ErrorInfo -> Logger
Logger_Error (ErrorInfo -> Either BasicError ErrorInfo
forall a b. b -> Either a b
Right ErrorInfo
ex))
else NixSerializer ProtoStoreConfig RemoteStoreError Logger
-> Logger -> m ()
forall (m :: * -> *) e a.
(MonadRemoteStore m, MonadError e m) =>
NixSerializer ProtoStoreConfig e a -> a -> m ()
sockPutS NixSerializer ProtoStoreConfig RemoteStoreError Logger
logger' (Either BasicError ErrorInfo -> Logger
Logger_Error (BasicError -> Either BasicError ErrorInfo
forall a b. a -> Either a b
Left (Int -> Text -> BasicError
BasicError Int
0 (String -> Text
Data.Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ErrorInfo -> String
forall a. Show a => a -> String
show ErrorInfo
ex))))
Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
where logger' :: NixSerializer ProtoStoreConfig RemoteStoreError Logger
logger' = (LoggerSError -> RemoteStoreError)
-> NixSerializer ProtoStoreConfig LoggerSError Logger
-> NixSerializer ProtoStoreConfig RemoteStoreError Logger
forall e e' r a.
(e -> e') -> NixSerializer r e a -> NixSerializer r e' a
mapErrorS LoggerSError -> RemoteStoreError
RemoteStoreError_SerializerLogger NixSerializer ProtoStoreConfig LoggerSError Logger
forall r. HasProtoVersion r => NixSerializer r LoggerSError Logger
logger
updateLogger
:: MonadRemoteStore m
=> TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m a))
-> m a
updateLogger :: forall (m :: * -> *) a.
MonadRemoteStore m =>
TunnelLogger
-> (TunnelLoggerState -> (TunnelLoggerState, m a)) -> m a
updateLogger TunnelLogger
x = m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a)
-> ((TunnelLoggerState -> (TunnelLoggerState, m a)) -> m (m a))
-> (TunnelLoggerState -> (TunnelLoggerState, m a))
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (m a) -> m (m a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (m a) -> m (m a))
-> ((TunnelLoggerState -> (TunnelLoggerState, m a)) -> IO (m a))
-> (TunnelLoggerState -> (TunnelLoggerState, m a))
-> m (m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IORef TunnelLoggerState
-> (TunnelLoggerState -> (TunnelLoggerState, m a)) -> IO (m a)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef (TunnelLogger -> IORef TunnelLoggerState
_tunnelLogger_state TunnelLogger
x)