debug-me-1.20181208: CmdLine.hs

{- Copyright 2017 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

module CmdLine where

import Types
import ServerList

import Options.Applicative
import Network.URI
import Network.Wai.Handler.Warp (Port)
import qualified Data.Text as T

data CmdLine = CmdLine
	{ mode :: Mode
	}

data Mode
	= UserMode UserOpts
	| DeveloperMode DeveloperOpts
	| DownloadMode DownloadOpts
	| WatchMode WatchOpts
	| GraphvizMode GraphvizOpts
	| ReplayMode ReplayOpts
	| VerifyMode VerifyOpts
	| ServerMode ServerOpts
	| ControlMode ControlOpts

data UserOpts = UserOpts
	{ cmdToRun :: Maybe String
	, useServer :: URI
	}

data DeveloperOpts = DeveloperOpts
	{ debugUrl :: URI
	}

data DownloadOpts = DownloadOpts
	{ downloadUrl :: URI
	}

data WatchOpts = WatchOpts
	{ watchUrl :: URI
	}

data GraphvizOpts = GraphvizOpts
	{ graphvizLogFile :: FilePath
	, graphvizShowHashes :: Bool
	}

data ReplayOpts = ReplayOpts
	{ replayLogFile :: FilePath
	}

data VerifyOpts = VerifyOpts
	{ verifyLogFile :: FilePath
	}

data ServerOpts = ServerOpts
	{ serverDirectory :: FilePath
	, serverPort :: Port
	, serverEmail :: Maybe EmailAddress
	, serverDeleteOldLogs :: Bool
	}

data ControlOpts = ControlOpts
	{ controlWindowEnabled :: Bool
	}

parseCmdLine :: Parser CmdLine
parseCmdLine = CmdLine <$> parseMode

parseMode :: Parser Mode
parseMode = (UserMode <$> parseuser)
	<|> (DeveloperMode <$> parsedeveloper)
	<|> (ReplayMode <$> parsereplay)
	<|> (VerifyMode <$> parseverify)
	<|> (DownloadMode <$> parsedownload)
	<|> (WatchMode <$> parsewatch)
	<|> (GraphvizMode <$> parsegraphviz)
	<|> (ServerMode <$> parseserver)
	<|> (ControlMode <$> parsecontrol)
  where
	parseuser = UserOpts
		<$> optional (strOption
			( long "run"
			<> metavar "command"
			<> help "program to run (default: login shell)"
			))
		<*> option readurl
			( long "use-server"
			<> metavar "url"
			<> value defaultServerUrl
			<> showDefault
			<> help "url of debug-me server to use"
			)
	parsedeveloper = DeveloperOpts
		<$> argument readurl
			( metavar "url"
			<> help "debug a user on the given url"
			)
	parsegraphviz = GraphvizOpts
		<$> option str
			( long "graphviz"
			<> metavar "logfile"
			<> help "visualize log file with graphviz"
			)
		<*> switch
			( long "show-hashes"
			<> help "display hashes in graphviz"
			)
	parsereplay = ReplayOpts
		<$> option str
			( long "replay"
			<> metavar "logfile"
			<> help "replay log file"
			)
	parseverify = VerifyOpts
		<$> option str
			( long "verify"
			<> metavar "logfile"
			<> help "verify log file"
			)
	parsedownload = DownloadOpts
		<$> option readurl
			( long "download"
			<> metavar "url"
			<> help "download log file from server"
			)
	parsewatch = WatchOpts
		<$> option readurl
			( long "watch"
			<> metavar "url"
			<> help "display a debug-me session non-interactively"
			)
	parseserver = ServerOpts
		<$> strOption
			( long "server"
			<> metavar "logdir"
			<> help "run server, storing logs in the specified directory"
			)
		<*> option auto
			( long "port"
			<> metavar "N"
			<> value 8081
			<> showDefault
			<> help "port for server to listen on"
			)
		<*> optional (T.pack <$> strOption
			( long "from-email"
			<> metavar "address"
			<> help "email session logs using this from address"
			))
		<*> switch
			( long "delete-old-logs"
			<> help "delete session logs after session is done"
			)
	parsecontrol = ControlOpts
		<$> switch
			( long "control"
			<> help "control running debug-me session"
			)

getCmdLine :: IO CmdLine
getCmdLine = execParser opts
  where
	opts = info (helper <*> parseCmdLine)
		( fullDesc
		<> header "debug-me - provable remote debugging sessions"
		)

readurl :: ReadM URI
readurl = eitherReader $ maybe (Left "url parse error") Right . parseURI