aws.hs

-- stack --resolver lts-10.3 --install-ghc runghc --package fmt --package base-prelude --package optparse-applicative --package text

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ApplicativeDo #-}

-- | A small program replicating a part of @aws-cli@ (only the interface,
-- not the functionality).
module Main where

import BasePrelude
import Data.Text (Text)
import Options.Applicative
import Fmt

main = do
    fmt . build =<< execParser (describe "Control AWS (not really)" parseCli)

-- | Some options (we support only two) and a command.
data Cli = Cli
    { debug       :: Bool
    , endpointUrl :: Maybe Text
    , cmd         :: Command
    }
    deriving Generic

instance Buildable Cli where
  build = genericF

-- | A command is either "s3" or "ec2" (for controlling the S3 and EC2
-- services respectively). They have subcommands, which are handled in the
-- same data type even though in a real app they would be put into separate
-- types.
data Command
    = S3_ls
          { uri       :: Maybe Text
          , recursive :: Bool
          , pageSize  :: Maybe Int
          }
    | S3_mv
          { from      :: Text
          , to        :: Text
          }
    | EC2_copyImage
          { name      :: Text
          , imageId   :: Text
          , region    :: Text
          }
    deriving Generic

instance Buildable Command where
  build = genericF

-- | A parser for the CLI.
parseCli :: Parser Cli
parseCli = do
    debug <- switch $
        long    "debug" <>
        help    "Turn on debug logging"
    endpointUrl <- optional $ strOption $
        long    "endpoint-url" <>
        metavar "URL" <>
        help    "Override command's default URL with the given URL"
    cmd <- parseCommand
    pure Cli{..}

-- | A parser for commands.
parseCommand :: Parser Command
parseCommand = subparser $ mconcat
    [ command "s3" $ describe "Simple Storage Service" $ subparser $
          command "ls" (describe "List S3 objects" s3_ls) <>
          command "mv" (describe "Move an S3 object" s3_mv)
    , command "ec2" $ describe "Elastic Compute Cloud" $ subparser $
          command "copy-image" (describe "Copy an AMI" ec2_copyImage)
    ]
  where
    -- S3 commands
    s3_ls = do
        uri <- optional $ strArgument $
            metavar "S3 URI"
        recursive <- switch $
            long "recursive" <>
            help "Command is performed on all files or objects"
        pageSize <- optional $ option auto $
            long "page-size" <>
            help "The number of results to return in each response"
        pure S3_ls{..}
    s3_mv = do
        from <- strArgument (metavar "PATH")
        to   <- strArgument (metavar "PATH")
        pure S3_mv{..}
    -- EC2 commands
    ec2_copyImage = do
        name <- strOption $
            long "name" <>
            help "The name of the new AMI"
        imageId <- strOption $
            long "source-image-id" <>
            help "The ID of the AMI to copy"
        region <- strOption $
            long "source-region" <>
            help "The region that contains the copied AMI"
        pure EC2_copyImage{..}

-- | An utility for adding descriptions to commands (stolen from
-- lambdaPass and flipped).
describe :: String -> Parser a -> ParserInfo a
describe desc opts = info (helper <*> opts) $ progDesc desc