Add benchmark suite

benchmark/Main.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE BlockArguments    #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import Control.Applicative (empty)
+import Data.Foldable (traverse_)
+import Data.Vector (Vector)
+import Numeric.Natural (Natural)
+import Turtle (d)
+
+import qualified Control.Concurrent.Async as Async
+import qualified Data.ByteString.Lazy as ByteString
+import qualified Data.ByteString.Lazy.Char8 as Char8
+import qualified Data.Text as Text
+import qualified Data.Vector as Vector
+import qualified Network.HTTP.Client as HTTP
+import qualified System.IO as IO
+import qualified System.IO.Temp as Temp
+import qualified Test.Tasty.Bench as Bench
+import qualified Turtle
+
+prepare :: Natural -> IO (Vector FilePath)
+prepare maxSize =
+    Temp.withSystemTempFile "zeros" \tempFile handle -> do
+        IO.hClose handle
+
+        let generate i = do
+                let size =
+                        truncate
+                            (   fromIntegral maxSize
+                            ** (fromIntegral i / fromIntegral numFiles)
+                            :: Double
+                            )
+
+                ByteString.writeFile tempFile (ByteString.replicate size 0)
+
+                text <- Turtle.single do
+                    Turtle.inproc "nix-store"
+                        [ "--add", Text.pack tempFile ]
+                        empty
+
+                return (Text.unpack (Turtle.lineToText text))
+
+        Vector.generateM (fromIntegral numFiles) generate
+
+port :: Int
+port = 8000
+
+numFiles :: Natural
+numFiles = 10
+
+runNixServe :: IO ()
+runNixServe =
+   Turtle.procs "nix-serve"
+       [ "--quiet", "--port", Turtle.format d port ]
+       empty
+
+host :: String
+host = "http://localhost:" <> show port
+
+main :: IO ()
+main = do
+    manager <- HTTP.newManager HTTP.defaultManagerSettings
+
+    Async.withAsync runNixServe \_ -> do
+        let fetchNarInfo file = do
+                let hash = take 32 (drop 11 file)
+
+                request <- HTTP.parseRequest (host <> "/" <> hash <> ".narinfo")
+
+                response <- HTTP.httpLbs request manager
+
+                return (HTTP.responseBody response)
+
+        let fetchNar file = do
+                bytes <- fetchNarInfo file
+
+                let relativePath =
+                        ( Char8.unpack
+                        . ByteString.drop 5
+                        . (!! 1)
+                        . Char8.lines
+                        ) bytes
+
+                request <- HTTP.parseRequest (host <> "/" <> relativePath)
+
+                response <- HTTP.httpLbs request manager
+
+                return (HTTP.responseBody response)
+
+        Bench.defaultMain
+            [ Bench.env (prepare 1000000) \files -> do
+                Bench.bench ("fetch present NAR info ×" <> show numFiles)
+                    (Bench.nfAppIO (traverse_ fetchNarInfo) files)
+            , Bench.bench "fetch absent NAR info ×1"
+                (Bench.nfAppIO fetchNarInfo "/nix/store/00000000000000000000000000000000")
+            , Bench.env (prepare 1000000) \files -> do
+                Bench.bench ("fetch present NAR ×" <> show numFiles)
+                    (Bench.nfAppIO (traverse_ fetchNar) files)
+            ]

flake.nix

@@ -61,7 +61,8 @@
 
           defaultApp = apps.default;
 
-          devShells.default = pkgs.haskellPackages.nix-serve-ng.env;
+          devShells.default =
+            (pkgs.haskell.lib.doBenchmark pkgs.haskellPackages.nix-serve-ng).env;
 
           devShell = devShells.default;
         });

nix-serve-ng.cabal

@@ -68,3 +68,24 @@ executable nix-serve
     default-language: Haskell2010
 
     ghc-options:      -Wall -threaded -O2 -rtsopts
+
+benchmark benchmark
+    hs-source-dirs:   benchmark
+
+    main-is:          Main.hs
+
+    type:             exitcode-stdio-1.0
+
+    build-depends:    base
+                    , async
+                    , bytestring
+                    , http-client
+                    , text
+                    , turtle
+                    , tasty-bench
+                    , temporary
+                    , vector
+
+    default-language: Haskell2010
+
+    ghc-options:      -Wall -O2 -threaded

nix/nix-serve-ng.nix

@@ -1,6 +1,7 @@
-{ mkDerivation, base, base16, base32, bytestring, charset
-, http-types, lib, managed, megaparsec, mtl, network, nix
-, optparse-applicative, vector, wai, wai-extra, warp, warp-tls
+{ mkDerivation, async, base, base16, base32, bytestring, charset
+, http-client, http-types, managed, megaparsec, mtl, network, nix
+, optparse-applicative, stdenv, tasty-bench, temporary, turtle
+, vector, wai, wai-extra, warp, warp-tls
 }:
 mkDerivation {
   pname = "nix-serve-ng";
@@ -13,6 +14,10 @@ mkDerivation {
     mtl network optparse-applicative vector wai wai-extra warp warp-tls
   ];
   executablePkgconfigDepends = [ nix ];
+  benchmarkHaskellDepends = [
+    async base bytestring http-client tasty-bench temporary turtle
+    vector
+  ];
   description = "A drop-in replacement for nix-serve that's faster and more stable";
-  license = lib.licenses.asl20;
+  license = stdenv.lib.licenses.asl20;
 }