{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Options where
import Control.Applicative (optional, (<|>))
import Data.String (IsString(..))
import Data.Void (Void)
import Network.Wai.Handler.Warp (HostPreference, Port)
import Numeric.Natural (Natural)
import Options.Applicative (Parser, ParserInfo, ReadM)
import Text.Megaparsec (Parsec)
import qualified Options.Applicative as Options
import qualified Text.Megaparsec as Megaparsec
import qualified Text.Megaparsec.Char.Lexer as Lexer
data Socket
= TCP { host :: HostPreference, port :: Port }
| Unix { backlog :: Natural, path :: FilePath }
data SSL = Disabled | Enabled { cert :: FilePath, key :: FilePath }
data Verbosity = Quiet | Normal | Verbose
data Options = Options
{ priority :: Integer
, socket :: Socket
, ssl :: SSL
, timeout :: Natural
, verbosity :: Verbosity
}
parseCert :: Parser FilePath
parseCert =
Options.strOption
( Options.long "ssl-cert"
<> Options.help "The path to the SSL certificate file"
<> Options.metavar "FILE"
)
parseKey :: Parser FilePath
parseKey =
Options.strOption
( Options.long "ssl-key"
<> Options.help "The path to the SSL key file"
<> Options.metavar "FILE"
)
parseSslEnabled :: Parser SSL
parseSslEnabled = do
-- [NOTE: enable-ssl]
--
-- We parse this for backwards compatibility with nix-serve, but ignore
-- it. Instead, we use the presence of the --ssl-key and --ssl-cert
-- options to detect whether SSL is enabled
Options.switch
( Options.long "enable-ssl"
<> Options.internal
)
cert <- parseCert
key <- parseKey
return Enabled{..}
parseSsl :: Parser SSL
parseSsl = parseSslEnabled <|> pure Disabled
parseTcp :: Parser Socket
parseTcp = do
host <- Options.strOption
( Options.long "host"
<> Options.help "The hostname to bind to"
<> Options.metavar "*|*4|!4|*6|!6|IPv4|IPv6"
-- The default host for warp is "*4", but we specify a default of
-- "*" for backwards compatibility with nix-serve, which defaults to
-- binding to any IP address. Also, binding to any IP address is
-- probably a better default anyway than binding to only IPv4
-- addresses.
<> Options.value "*"
<> Options.showDefaultWith (\_ -> "*")
)
port <- Options.option Options.auto
( Options.long "port"
<> Options.help "The port to bind to"
<> Options.metavar "0-65535"
-- This is also for backwards compatibility with nix-serve, which
-- defaults to port 5000.
<> Options.value 5000
)
return TCP{..}
defaultBacklog :: Natural
defaultBacklog = 1024
parseUnix :: Parser Socket
parseUnix = do
backlog <- Options.option Options.auto
( Options.long "backlog"
<> Options.help "The maximum number of connections allowed for the backlog"
<> Options.metavar "INTEGER"
<> Options.value defaultBacklog
)
path <- Options.strOption
( Options.long "socket"
<> Options.short 'S'
<> Options.help "The socket to bind to"
<> Options.metavar "PATH"
)
return Unix{..}
parseSocket :: Parser Socket
parseSocket = parseTcp <|> parseUnix
parsePriority :: Parser Integer
parsePriority =
Options.option Options.auto
( Options.long "priority"
<> Options.help "The priority of the cache (lower is higher priority)"
<> Options.metavar "INTEGER"
<> Options.value 30
)
parseTimeout :: Parser Natural
parseTimeout =
Options.option Options.auto
( Options.long "timeout"
<> Options.help "Timeout for requests"
<> Options.metavar "SECONDS"
-- nix-serve does not timeout requests, but warp insists on a
-- timeout, so we use the same default timeout as hydra
<> Options.value (10 * 60)
)
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
ssl <- parseSsl
priority <- parsePriority
timeout <- parseTimeout
verbosity <- parseVerbosity
return Options{..}
parseReader :: Parsec Void String a -> ReadM a
parseReader parser =
Options.eitherReader \string -> do
case Megaparsec.parse parser "(input)" string of
Left bundle -> Left (Megaparsec.errorBundlePretty bundle)
Right a -> Right a
-- This is only for backwards compatibility with nix-serve, which supports
-- the --listen option
parseListen :: Parser Options
parseListen = do
let parseTcpListen :: Parsec Void String Socket
parseTcpListen = do
host <- parseHost <|> pure "*"
_ <- ":"
port <- Lexer.decimal
-- See: [NOTE: enable-ssl]
_ <- optional ":ssl"
return TCP{..}
let parseUnixListen :: Parsec Void String Socket
parseUnixListen = do
let backlog = defaultBacklog
path <- Megaparsec.takeRest
return Unix{..}
let parseSocketListen = parseTcpListen <|> parseUnixListen
ssl <- parseSsl
socket <- Options.option (parseReader parseSocketListen)
( Options.long "listen"
<> Options.short 'l'
<> Options.help "The TLS-enabled host and port to bind to"
<> Options.metavar "[HOST]:PORT|UNIX_SOCKET"
<> Options.hidden
)
priority <- parsePriority
timeout <- parseTimeout
verbosity <- parseVerbosity
return Options{..}
parserInfo :: ParserInfo Options
parserInfo =
Options.info
(Options.helper <*> (parseOptions <|> parseListen))
(Options.progDesc "Serve the current Nix store as a binary cache")
parseHost :: Parsec Void String HostPreference
parseHost = do
string <- Megaparsec.takeWhileP Nothing (/= ':')
return (fromString string)