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
|
||||
"/nix/store/yyznqbwam67cmp7zfwk0rkgmi9yqsdsm-hnix-store-core-0.8.0.0"
|
||||
|
||||
handler :: MonadIO m => WorkerHelper m
|
||||
handler :: RemoteStoreT IO a -> IO a
|
||||
handler k = do
|
||||
x <- liftIO $ runStore $ doReq k
|
||||
x <- runStore k
|
||||
either (error . show) pure (fst x)
|
||||
|
||||
runDaemon
|
||||
|
@ -22,6 +22,8 @@ import Data.Word (Word32)
|
||||
import qualified Data.Text
|
||||
import qualified Data.Text.IO
|
||||
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.Socket
|
||||
import System.Nix.Store.Remote.Types.StoreRequest as R
|
||||
@ -34,13 +36,16 @@ import System.Nix.Store.Remote.Types.WorkerMagic (WorkerMagic(..))
|
||||
|
||||
-- wip
|
||||
import Data.Some (withSome)
|
||||
import qualified System.Timeout
|
||||
import qualified Network.Socket.ByteString
|
||||
|
||||
type WorkerHelper m
|
||||
= forall a
|
||||
. ( Show a
|
||||
, StoreReply a
|
||||
)
|
||||
=> StoreRequest a -> m a
|
||||
=> RemoteStoreT m a
|
||||
-> m a
|
||||
|
||||
chatty :: Bool
|
||||
chatty = False
|
||||
@ -119,7 +124,30 @@ processConnection workerHelper postGreet sock = do
|
||||
=> StoreRequest a
|
||||
-> RemoteStoreT m ()
|
||||
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
|
||||
(mapErrorS
|
||||
RemoteStoreError_SerializerReply
|
||||
|
@ -213,7 +213,6 @@ withManInTheMiddleNixDaemon action =
|
||||
<=< fmap fst
|
||||
. runStoreConnection storeConn
|
||||
. (setStoreDir storeDir >>)
|
||||
. doReq
|
||||
|
||||
in action $ \(mstore :: RemoteStoreT m a) ->
|
||||
runDaemonConnection handler
|
||||
|
Loading…
Reference in New Issue
Block a user