Cli.hs

{-# LANGUAGE OverloadedRecordDot #-}

module Cloudy.Cli
  ( parseCliOpts
  , CliCmd(..)
  , ScalewayCliOpts(..)
  , AwsCliOpts(..)
  , ListCliOpts(..)
  , SshCliOpts(..)
  , CopyFileCliOpts(..)
  , DestroyCliOpts(..)
  , CopyFileDirection(..)
  , Recursive(..)
  )
  where

import Cloudy.Cli.Aws (AwsCliOpts(..), awsCliOptsParser)
import Cloudy.Cli.Scaleway (ScalewayCliOpts(..), scalewayCliOptsParser)
import Cloudy.Db (CloudyInstanceId (..), CloudyInstance (..), withCloudyDb, findAllCloudyInstances)
import Cloudy.InstanceSetup (getUserInstanceSetups)
import Cloudy.InstanceSetup.Types (InstanceSetup)
import Control.Applicative (Alternative(many), optional)
import Data.Int (Int64)
import Data.Text (Text, unpack)
import Data.Version (showVersion)
import Options.Applicative
  ( Alternative((<|>)), Parser, (<**>), command, fullDesc, header, info
  , progDesc, execParser, helper, footer, hsubparser, ParserInfo, strOption, long, short, metavar, help, option, auto, noIntersperse, forwardOptions, strArgument, footerDoc, flag', flag, completeWith, simpleVersioner )
import Options.Applicative.Help (vsep)
import Paths_cloudy (version)

data CliCmd
  = Aws AwsCliOpts
  | List ListCliOpts
  | Scaleway ScalewayCliOpts
  | Ssh SshCliOpts
  | CopyFile CopyFileCliOpts
  | Destroy DestroyCliOpts
  deriving stock Show

data ListCliOpts = ListCliOpts
  deriving stock Show

data SshCliOpts = SshCliOpts
  { id :: Maybe CloudyInstanceId
  , name :: Maybe Text
  , passthru :: [Text]
  }
  deriving stock Show

data CopyFileCliOpts = CopyFileCliOpts
  { id :: Maybe CloudyInstanceId
  , name :: Maybe Text
  , direction :: CopyFileDirection
  , recursive :: Recursive
  , filesToCopyArgs :: [Text]
  }
  deriving stock Show

data DestroyCliOpts = DestroyCliOpts
  { id :: Maybe CloudyInstanceId
  , name :: Maybe Text
  }
  deriving stock Show

-- | Which direction to copy files in the @copy-file@ command
data CopyFileDirection = FromInstanceToLocal | ToInstanceFromLocal
  deriving stock Show

-- | Whether or not to recursively copy files from directories in the
-- @copy-file@ command.
data Recursive = Recursive | NoRecursive
  deriving stock Show

parseCliOpts :: IO CliCmd
parseCliOpts = do
  userInstanceSetups <- getUserInstanceSetups
  activeCloudyInstances <- withCloudyDb findAllCloudyInstances
  execParser (cliCmdParserInfo activeCloudyInstances userInstanceSetups)

cliCmdParserInfo :: [CloudyInstance] -> [InstanceSetup] -> ParserInfo CliCmd
cliCmdParserInfo activeCloudyInstances userInstanceSetups =
  info
    ( cliCmdParser activeCloudyInstances userInstanceSetups <**>
      helper <**>
      simpleVersioner (showVersion version)
    )
    ( fullDesc <>
      -- progDesc "cloudy" <>
      header "cloudy - create, setup, and manage compute instances in various cloud environments"
    )

cliCmdParser :: [CloudyInstance] -> [InstanceSetup] -> Parser CliCmd
cliCmdParser activeCloudyInstances userInstanceSetups = hsubparser subParsers <|> list
  where
    subParsers =
      awsCommand <>
      scalewayCommand <>
      listCommand <>
      sshCommand <>
      copyFileCommand <>
      destroyCommand

    awsCommand =
      command
        "aws"
        ( info
            (fmap Aws awsCliOptsParser)
            (progDesc "Run AWS-specific commands")
        )

    scalewayCommand =
      command
        "scaleway"
        ( info
            (Scaleway <$> scalewayCliOptsParser userInstanceSetups)
            (progDesc "Run Scaleway-specific commands")
        )

    listCommand =
      command
        "list"
        ( info
            list
            (progDesc "List currently running compute instances")
        )

    sshCommand =
      command
        "ssh"
        ( info
            (Ssh <$> sshCliOptsParser activeCloudyInstances)
            ( progDesc "SSH to currently running compute instances" <>
              noIntersperse <>
              (footerDoc . Just $
                -- TODO: do this better
                vsep
                  [ "This command internally executes SSH like the following:"
                  , ""
                  , "    $ ssh root@12.34.9.9"
                  , ""
                  , "Any additional arguments specified to this function will be passed to SSH as-is. \
                    \For instance, if you run the following command:"
                  , ""
                  , "    $ cloudy ssh ls /"
                  , ""
                  , "then internally it will execute SSH like the following:"
                  , ""
                  , "    $ ssh root@12.34.9.9 ls /"
                  , ""
                  , "Note that if you want to pass an option to SSH that matches \
                    \an option understood by Cloudy, use \"--\" to separate arguments. \
                    \For instance, if you run the following command:"
                  , ""
                  , "    $ cloudy ssh -i pumpkin-dog -- -i ~/.ssh/my_id_rsa"
                  , ""
                  , "Cloudy will internally execute the following SSH command against the \
                    \instance named \"pumpkin-dog\":"
                  , ""
                  , "    $ ssh root@12.34.9.9 -i ~/.ssh/my_id_rsa"
                  , ""
                  , "SSH also understands the \"--\" argument, so you may need to \
                    \combine these depending on what you're trying to do:"
                  , ""
                  , "    $ cloudy ssh -i pumpkin-dog -- -i ~/.ssh/my_id_rsa -- ls -i /"
                  ]
              )
            )
        )

    copyFileCommand =
      command
        "copy-file"
        ( info
            (CopyFile <$> copyFileCliOptsParser activeCloudyInstances)
            ( progDesc "Copy files to/from currently running compute instances" <>
              forwardOptions <>
              (footerDoc . Just $
                -- TODO: do this better
                vsep
                  [ "Here's an example of using this command to copy files from \
                    \the cloud instance to your local machine:"
                  , ""
                  , "    $ cloudy copy-file -i pumpkin-dog --from-instance my-file-remote1 my-file-remote2 ./my-dir-local/"
                  , ""
                  , "This internally uses SCP to copy files, running a command \
                    \like the following:"
                  , ""
                  , "    $ scp root@12.34.9.9:my-file-remote1 root@12.34.9.9:my-file-remote2 ./my-dir-local/"
                  , ""
                  , "Cloudy will prepend the correct username and IP address to \
                    \all the remote files.  Note that this uses SCP's normal \
                    \rules for paths, so relative paths will be relative to \
                    \the user's HOME directory.  For instance, in the above \
                    \command, \"my-file-remote1\" and \"my-file-remote2\" are \
                    \expected to live in the root user's HOME directory (/root)."
                  , ""
                  , "Here's an example of using this command to copy files from \
                    \your local machine to the cloud instance:"
                  , ""
                  , "    $ cloudy copy-file -i pumpkin-dog --to-instance --recursive my-file-local my-dir-local/ my-dir-remote/"
                  , ""
                  , "This internally runs a command like the following:"
                  , ""
                  , "    $ scp -r my-file-local my-dir-local/ root@12.34.9.9:my-dir-remote/"
                  ]
              )
            )
        )

    destroyCommand =
      command
        "destroy"
        ( info
            (Destroy <$> destroyCliOptsParser activeCloudyInstances)
            ( progDesc "Destroy currently running compute instance" <>
              footer
                "If neither a CLOUDY_INSTANCE_ID nor a CLOUDY_INSTANCE_NAME is \
                \specified, AND there is only a single active Cloudy Instance, \
                \it will be used.  Otherwise, you must specify either \
                \CLOUDY_INSTANCE_ID  or CLOUDY_INSTANCE_NAME, but not both. \
                \Use `cloudy list` to get a list of all active instances ids \
                \and names."
            )
        )

    list = fmap List listCliOptsParser

listCliOptsParser :: Parser ListCliOpts
listCliOptsParser = pure ListCliOpts

sshCliOptsParser :: [CloudyInstance] -> Parser SshCliOpts
sshCliOptsParser activeCloudyInstances =
  SshCliOpts
    <$> cloudyInstanceIdParser activeCloudyInstances
    <*> cloudyInstanceNameParser activeCloudyInstances
    <*> passthruArgs

copyFileCliOptsParser :: [CloudyInstance] -> Parser CopyFileCliOpts
copyFileCliOptsParser activeCloudyInstances =
  CopyFileCliOpts
    <$> cloudyInstanceIdParser activeCloudyInstances
    <*> cloudyInstanceNameParser activeCloudyInstances
    <*> directionParser
    <*> recursiveParser
    <*> copyFilesParser

destroyCliOptsParser :: [CloudyInstance] -> Parser DestroyCliOpts
destroyCliOptsParser activeCloudyInstances =
  DestroyCliOpts
    <$> cloudyInstanceIdParser activeCloudyInstances
    <*> cloudyInstanceNameParser activeCloudyInstances

cloudyInstanceIdParser :: [CloudyInstance] -> Parser (Maybe CloudyInstanceId)
cloudyInstanceIdParser activeCloudyInstances = fmap CloudyInstanceId <$> innerParser
  where
    innerParser :: Parser (Maybe Int64)
    innerParser =
      optional $
        option
          auto
          ( long "id" <>
            short 'i' <>
            metavar "CLOUDY_INSTANCE_ID" <>
            help "Cloudy instance ID to operate on." <>
            completeWith (fmap (\inst -> show $ unCloudyInstanceId inst.id) activeCloudyInstances)
          )

cloudyInstanceNameParser :: [CloudyInstance] -> Parser (Maybe Text)
cloudyInstanceNameParser activeCloudyInstances =
  optional $
    strOption
      ( long "name" <>
        short 'n' <>
        metavar "CLOUDY_INSTANCE_NAME" <>
        help "Cloudy instance name to operate on." <>
        completeWith (fmap (\inst -> unpack inst.name) activeCloudyInstances)
      )

-- | Parser for arguments that are not really parsed, just passed through.
--
-- Used to pass through arguments to SSH.
passthruArgs :: Parser [Text]
passthruArgs =
  many $
    strArgument
      ( metavar "SSH_ARG..." <>
        help "Arguments to passthru to SSH"
      )

-- | Parser for file names for the copy-files command.
copyFilesParser :: Parser [Text]
copyFilesParser =
  many $
    strArgument
      ( metavar "FILE..." <>
        help "File names to copy to/from"
      )

directionParser :: Parser CopyFileDirection
directionParser =
  let fromInstanceFlag =
        flag'
          FromInstanceToLocal
          ( long "from-instance" <>
            short 'f' <>
            help "Copy files FROM CLOUD INSTANCE to your local machine"
          )
      toInstanceFlag =
        flag'
          ToInstanceFromLocal
          ( long "to-instance" <>
            short 't' <>
            help "Copy files from your local machine TO CLOUD INSTANCE"
          )
  in fromInstanceFlag <|> toInstanceFlag

recursiveParser :: Parser Recursive
recursiveParser =
  flag
    NoRecursive
    Recursive
    ( long "recursive" <>
      short 'r' <>
      help "Recursively copy entire directories"
    )