mirror of
https://github.com/haskell-nix/hnix-store.git
synced 2024-09-11 18:05:56 +03:00
remote/server: add proxyNarSource
This commit is contained in:
parent
e2381c89d5
commit
3d774b8187
@ -108,9 +108,9 @@ justdoit = do
|
|||||||
def
|
def
|
||||||
"/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
|
"/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
|
||||||
|
|
||||||
handler :: MonadIO m => WorkerHelper m
|
handler :: RemoteStoreT IO a -> IO a
|
||||||
handler k = do
|
handler k = do
|
||||||
x <- liftIO $ runStore $ doReq k
|
x <- runStore k
|
||||||
either (error . show) pure (fst x)
|
either (error . show) pure (fst x)
|
||||||
|
|
||||||
runDaemon
|
runDaemon
|
||||||
|
@ -22,6 +22,8 @@ import Data.Word (Word32)
|
|||||||
import qualified Data.Text
|
import qualified Data.Text
|
||||||
import qualified Data.Text.IO
|
import qualified Data.Text.IO
|
||||||
import Network.Socket (Socket, accept, close, listen, maxListenQueue)
|
import Network.Socket (Socket, accept, close, listen, maxListenQueue)
|
||||||
|
import System.Nix.Nar (NarSource)
|
||||||
|
import System.Nix.Store.Remote.Client (doReq)
|
||||||
import System.Nix.Store.Remote.Serializer (LoggerSError, mapErrorS, storeRequest, workerMagic, protoVersion, int, logger, text, trustedFlag)
|
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.Socket
|
||||||
import System.Nix.Store.Remote.Types.StoreRequest as R
|
import System.Nix.Store.Remote.Types.StoreRequest as R
|
||||||
@ -34,13 +36,16 @@ import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
|
|||||||
|
|
||||||
-- wip
|
-- wip
|
||||||
import Data.Some (withSome)
|
import Data.Some (withSome)
|
||||||
|
import qualified System.Timeout
|
||||||
|
import qualified Network.Socket.ByteString
|
||||||
|
|
||||||
type WorkerHelper m
|
type WorkerHelper m
|
||||||
= forall a
|
= forall a
|
||||||
. ( Show a
|
. ( Show a
|
||||||
, StoreReply a
|
, StoreReply a
|
||||||
)
|
)
|
||||||
=> StoreRequest a -> m a
|
=> RemoteStoreT m a
|
||||||
|
-> m a
|
||||||
|
|
||||||
chatty :: Bool
|
chatty :: Bool
|
||||||
chatty = False
|
chatty = False
|
||||||
@ -119,7 +124,30 @@ processConnection workerHelper postGreet sock = do
|
|||||||
=> StoreRequest a
|
=> StoreRequest a
|
||||||
-> RemoteStoreT m ()
|
-> RemoteStoreT m ()
|
||||||
perform req = do
|
perform req = do
|
||||||
resp <- bracketLogger tunnelLogger $ lift $ workerHelper req
|
|
||||||
|
special <- case req of
|
||||||
|
AddToStore {} -> do
|
||||||
|
let proxyNarSource :: NarSource IO
|
||||||
|
proxyNarSource f =
|
||||||
|
liftIO
|
||||||
|
(System.Timeout.timeout
|
||||||
|
1000000
|
||||||
|
(Network.Socket.ByteString.recv sock 8)
|
||||||
|
)
|
||||||
|
>>= \case
|
||||||
|
Nothing -> pure ()
|
||||||
|
Just x -> f x >> proxyNarSource f
|
||||||
|
|
||||||
|
pure $ setNarSource proxyNarSource
|
||||||
|
_ -> pure $ pure ()
|
||||||
|
|
||||||
|
resp <-
|
||||||
|
bracketLogger
|
||||||
|
tunnelLogger
|
||||||
|
$ lift
|
||||||
|
$ workerHelper
|
||||||
|
$ special >> doReq req
|
||||||
|
|
||||||
sockPutS
|
sockPutS
|
||||||
(mapErrorS
|
(mapErrorS
|
||||||
RemoteStoreError_SerializerReply
|
RemoteStoreError_SerializerReply
|
||||||
|
@ -213,7 +213,6 @@ withManInTheMiddleNixDaemon action =
|
|||||||
<=< fmap fst
|
<=< fmap fst
|
||||||
. runStoreConnection storeConn
|
. runStoreConnection storeConn
|
||||||
. (setStoreDir storeDir >>)
|
. (setStoreDir storeDir >>)
|
||||||
. doReq
|
|
||||||
|
|
||||||
in action $ \(mstore :: RemoteStoreT m a) ->
|
in action $ \(mstore :: RemoteStoreT m a) ->
|
||||||
runDaemonConnection handler
|
runDaemonConnection handler
|
||||||
|
Loading…
Reference in New Issue
Block a user