Add support for streaming NAR output (#1)

Before this change the NAR contents would be buffered in memory before
supplying them to the client.  Now each chunk is instantly flushed
to the client when it's available.

This requires reworking things so that we use a `StreamingBody`,
which in turn requires passing a Haskell callback to the C code to
invoke.
This commit is contained in:
Gabriella Gonzalez 2022-08-23 16:32:34 -07:00 committed by GitHub
parent 319e70637e
commit 0242d8bebb
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
3 changed files with 86 additions and 33 deletions

View File

@ -159,20 +159,40 @@ void signString
copyString(signature, output);
}
void dumpPath(char const * const hashPart, struct string * const output) {
bool dumpPath
( char const * const hashPart
, bool (* const callback)(struct string const * const)
)
{
ref<Store> store = getStore();
std::optional<StorePath> storePath =
store->queryPathFromHashPart(hashPart);
if (storePath.has_value()) {
StringSink sink;
LambdaSink sink([=](std::string_view v) {
struct string s = { .data = v.data(), .size = v.size() };
store->narFromPath(storePath.value(), sink);
bool succeeded = (*callback)(&s);
copyString(sink.s, output);
if (!succeeded) {
// We don't really care about the error message. The only
// reason for throwing an exception here is that this is the
// only way that a Nix sink can exit early.
throw std::runtime_error("");
}
});
try {
store->narFromPath(storePath.value(), sink);
} catch (const std::runtime_error & e) {
// Intentionally do nothing. We're only using the exception as a
// short-circuiting mechanism.
}
return true;
} else {
*output = emptyString;
return false;
}
}

View File

@ -12,10 +12,11 @@ import Data.CharSet.ByteSet (ByteSet(..))
import Data.Function ((&))
import Network.Socket (SockAddr(..))
import Network.Wai (Application)
import Nix (PathInfo(..))
import Nix (NoSuchPath(..), PathInfo(..))
import Numeric.Natural (Natural)
import Options (Options(..), Socket(..), SSL(..), Verbosity(..))
import qualified Control.Exception as Exception
import qualified Control.Monad as Monad
import qualified Control.Monad.Except as Except
import qualified Data.ByteString as ByteString
@ -112,8 +113,8 @@ makeApplication ApplicationOptions{..} request respond = do
maybeStorePath <- liftIO (Nix.queryPathFromHashPart hashPart)
storePath <- case maybeStorePath of
Nothing -> noSuchPath
Just storePath -> return storePath
Left NoSuchPath -> noSuchPath
Right storePath -> return storePath
pathInfo@PathInfo{..} <- liftIO (Nix.queryPathInfo storePath)
@ -230,8 +231,8 @@ makeApplication ApplicationOptions{..} request respond = do
maybeStorePath <- liftIO (Nix.queryPathFromHashPart hashPart)
storePath <- case maybeStorePath of
Nothing -> noSuchPath
Just storePath -> return storePath
Left NoSuchPath-> noSuchPath
Right storePath -> return storePath
PathInfo{ narHash } <- liftIO (Nix.queryPathInfo storePath)
@ -249,18 +250,21 @@ makeApplication ApplicationOptions{..} request respond = do
done response
maybeBytes <- liftIO (Nix.dumpPath hashPart)
let streamingBody write flush = do
result <- Nix.dumpPath hashPart callback
bytes <- case maybeBytes of
Nothing -> noSuchPath
Just bytes -> return bytes
let lazyBytes = ByteString.Lazy.fromStrict bytes
case result of
Left exception -> Exception.throwIO exception
Right x -> return x
where
callback builder = do
() <- write builder
flush
let headers = [ ("Content-Type", "text/plain") ]
let response =
Wai.responseLBS Types.status200 headers lazyBytes
Wai.responseStream Types.status200 headers streamingBody
done response

View File

@ -1,4 +1,6 @@
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE MultiWayIf #-}
@ -9,20 +11,23 @@
module Nix where
import Control.Applicative (empty)
import Control.Exception (Exception, SomeException)
import Control.Monad.Managed (Managed)
import Data.ByteString (ByteString)
import Data.ByteString.Builder (Builder)
import Data.Vector (Vector)
import Data.Word (Word64)
import Foreign (Ptr, Storable(..))
import Foreign (FunPtr, Ptr, Storable(..))
import Foreign.C (CChar, CLong, CSize, CString)
import qualified Control.Exception as Exception
import qualified Control.Monad as Monad
import qualified Control.Monad.Managed as Managed
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Base16 as Base16
import qualified Data.ByteString.Base32 as Base32
import qualified Data.ByteString.Builder as Builder
import qualified Data.IORef as IORef
import qualified Data.Vector as Vector
import qualified Data.Vector.Storable as Vector.Storable
import qualified Foreign
@ -153,7 +158,7 @@ data PathInfo = PathInfo
, narSize :: Word64
, references :: Vector ByteString
, sigs :: Vector ByteString
} deriving (Show)
} deriving stock (Show)
fromCPathInfo :: CPathInfo -> IO PathInfo
fromCPathInfo CPathInfo{ deriver, narHash, narSize, references, sigs } = do
@ -187,10 +192,14 @@ getStoreDir =
string_ <- peek output
fromString_ string_
data NoSuchPath = NoSuchPath
deriving anyclass (Exception)
deriving stock (Show)
foreign import ccall "queryPathFromHashPart" queryPathFromHashPart_
:: CString -> Ptr String_ -> IO ()
queryPathFromHashPart :: ByteString -> IO (Maybe ByteString)
queryPathFromHashPart :: ByteString -> IO (Either NoSuchPath ByteString)
queryPathFromHashPart hashPart = do
ByteString.useAsCString hashPart \cHashPart -> do
Foreign.alloca \output -> do
@ -199,8 +208,8 @@ queryPathFromHashPart hashPart = do
Exception.bracket_ open close do
string_@String_{ data_} <- peek output
if data_ == Foreign.nullPtr
then return Nothing
else fmap Just (fromString_ string_)
then return (Left NoSuchPath)
else fmap Right (fromString_ string_)
foreign import ccall "queryPathInfo" queryPathInfo_
:: CString -> Ptr CPathInfo -> IO ()
@ -262,19 +271,36 @@ signString secretKey fingerprint =
fromString_ string_
foreign import ccall "dumpPath" dumpPath_
:: CString -> Ptr String_ -> IO ()
:: CString -> FunPtr (Ptr String_ -> IO Bool) -> IO Bool
dumpPath :: ByteString -> (Builder -> IO ()) -> IO (Either SomeException ())
dumpPath hashPart builderCallback = do
result <- IORef.newIORef (Right ())
let cCallback :: Ptr String_ -> IO Bool
cCallback pointer = do
string_ <- Foreign.peek pointer
byteString <- fromString_ string_
let handler :: SomeException -> IO Bool
handler exception = do
IORef.writeIORef result (Left exception)
return False
Exception.handle handler do
builderCallback (Builder.byteString byteString)
return True
wrappedCCallback <- wrapCallback cCallback
dumpPath :: ByteString -> IO (Maybe ByteString)
dumpPath hashPart = do
ByteString.useAsCString hashPart \cHashPart -> do
Foreign.alloca \output -> do
let open = dumpPath_ cHashPart output
let close = freeString output
Exception.bracket_ open close do
string_@String_{ data_} <- peek output
if data_ == Foreign.nullPtr
then return Nothing
else fmap Just (fromString_ string_)
success <- dumpPath_ cHashPart wrappedCCallback
Monad.when (not success) do
IORef.writeIORef result (Left (Exception.toException NoSuchPath))
IORef.readIORef result
foreign import ccall "dumpLog" dumpLog_
:: CString -> Ptr String_ -> IO ()
@ -290,3 +316,6 @@ dumpLog baseName = do
if data_ == Foreign.nullPtr
then return Nothing
else fmap Just (fromString_ string_)
foreign import ccall "wrapper" wrapCallback
:: (Ptr String_ -> IO Bool) -> IO (FunPtr (Ptr String_ -> IO Bool))