diff --git a/nix-serve-ng.cabal b/nix-serve-ng.cabal index 8808d5d..5218249 100644 --- a/nix-serve-ng.cabal +++ b/nix-serve-ng.cabal @@ -57,6 +57,7 @@ executable nix-serve-ng , optparse-applicative , vector , wai + , wai-extra , warp , warp-tls diff --git a/nix/nix-serve-ng.nix b/nix/nix-serve-ng.nix index e6eaf96..6a868c9 100644 --- a/nix/nix-serve-ng.nix +++ b/nix/nix-serve-ng.nix @@ -1,6 +1,6 @@ { mkDerivation, base, bsd-sysctl, bytestring, http-types, lib , managed, megaparsec, mtl, network, nixstore, nixutil -, optparse-applicative, vector, wai, warp, warp-tls +, optparse-applicative, vector, wai, wai-extra, warp, warp-tls }: mkDerivation { pname = "nix-serve-ng"; @@ -10,7 +10,7 @@ mkDerivation { isExecutable = true; executableHaskellDepends = [ base bsd-sysctl bytestring http-types managed megaparsec mtl - network optparse-applicative vector wai warp warp-tls + network optparse-applicative vector wai wai-extra warp warp-tls ]; executableSystemDepends = [ nixstore nixutil ]; description = "A drop-in replacement for nix-serve that's faster and more stable"; diff --git a/src/Main.hs b/src/Main.hs index 93dbbb8..6357915 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -12,25 +12,26 @@ import Data.Function ((&)) import Network.Socket (SockAddr(..)) import Network.Wai (Application) import Nix (PathInfo(..)) -import Options (Options(..), Socket(..), SSL(..)) +import Options (Options(..), Socket(..), SSL(..), Verbosity(..)) import Sysctl (_SO_MAX_CONN) -import qualified Control.Monad as Monad -import qualified Control.Monad.Except as Except -import qualified Data.ByteString as ByteString -import qualified Data.ByteString.Builder as Builder -import qualified Data.ByteString.Lazy as ByteString.Lazy -import qualified Data.Vector as Vector -import qualified Data.Void as Void -import qualified Network.HTTP.Types as Types -import qualified Network.Socket as Socket -import qualified Network.Wai as Wai -import qualified Network.Wai.Handler.Warp as Warp -import qualified Network.Wai.Handler.WarpTLS as WarpTLS +import qualified Control.Monad as Monad +import qualified Control.Monad.Except as Except +import qualified Data.ByteString as ByteString +import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString.Lazy as ByteString.Lazy +import qualified Data.Vector as Vector +import qualified Data.Void as Void +import qualified Network.HTTP.Types as Types +import qualified Network.Socket as Socket +import qualified Network.Wai as Wai +import qualified Network.Wai.Handler.Warp as Warp +import qualified Network.Wai.Handler.WarpTLS as WarpTLS +import qualified Network.Wai.Middleware.RequestLogger as RequestLogger import qualified Nix import qualified Options -import qualified Options.Applicative as Options -import qualified System.BSD.Sysctl as Sysctl +import qualified Options.Applicative as Options +import qualified System.BSD.Sysctl as Sysctl makeApplication :: Integer -> ByteString -> Application makeApplication priority storeDirectory request respond = do @@ -198,11 +199,18 @@ toSocket path = do main :: IO () main = do - options@Options{ priority } <- Options.execParser Options.parserInfo + options@Options{ priority, verbosity } <- do + Options.execParser Options.parserInfo storeDirectory <- Nix.getStoreDir - let application = makeApplication priority storeDirectory + let logger = + case verbosity of + Quiet -> id + Normal -> RequestLogger.logStdout + Verbose -> RequestLogger.logStdoutDev + + let application = logger (makeApplication priority storeDirectory) case options of Options{ ssl = Disabled, socket = TCP{ host, port } } -> do diff --git a/src/Options.hs b/src/Options.hs index 3b8f8ef..0c0d635 100644 --- a/src/Options.hs +++ b/src/Options.hs @@ -22,10 +22,13 @@ data Socket data SSL = Disabled | Enabled { cert :: FilePath, key :: FilePath } +data Verbosity = Quiet | Normal | Verbose + data Options = Options - { priority :: Integer - , socket :: Socket - , ssl :: SSL + { priority :: Integer + , socket :: Socket + , ssl :: SSL + , verbosity :: Verbosity } parseCert :: Parser FilePath @@ -114,6 +117,18 @@ parsePriority = <> Options.value 30 ) +parseVerbosity :: Parser Verbosity +parseVerbosity = + Options.flag' Quiet + ( Options.long "quiet" + <> Options.help "Disable logging" + ) + <|> Options.flag' Verbose + ( Options.long "verbose" + <> Options.help "Log verbosely" + ) + <|> pure Normal + parseOptions :: Parser Options parseOptions = do socket <- parseTcp <|> parseUnix @@ -122,6 +137,8 @@ parseOptions = do priority <- parsePriority + verbosity <- parseVerbosity + return Options{..} parseReader :: Parsec Void String a -> ReadM a @@ -167,6 +184,8 @@ parseListen = do priority <- parsePriority + verbosity <- parseVerbosity + return Options{..} parserInfo :: ParserInfo Options