LsPrefix.hs

{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

module App.Commands.LsPrefix
  ( cmdLsPrefix
  ) where

import Antiope.Core                   (Region (..))
import Antiope.Env                    (mkEnv)
import Antiope.Options.Applicative
import App.Show
import Control.Lens
import Control.Monad.Except
import Control.Monad.Trans.Resource   (runResourceT)
import Data.Generics.Product.Any
import Data.Semigroup                 ((<>))
import HaskellWorks.Data.Uri.Location
import HaskellWorks.Data.Uri.UriError (displayUriError)
import Options.Applicative            hiding (columns)

import qualified App.Aws.Logger                as AWS
import qualified App.Commands.Types            as Z
import qualified Data.Text                     as T
import qualified Data.Text.IO                  as TIO
import qualified HaskellWorks.Data.Uri.IO.Lazy as URI
import qualified System.IO                     as IO
import qualified System.IO.Unsafe              as IO

runLsPrefix :: Z.LsPrefixOptions -> IO ()
runLsPrefix opts = do
  let prefix       = opts ^. the @"prefix"
  let region      = opts ^. the @"region"
  let awsLogLevel = opts ^. the @"awsLogLevel"

  envAws <- IO.unsafeInterleaveIO $ mkEnv region (AWS.awsLogger awsLogLevel)

  result <- runResourceT . runExceptT $ do
    locations <- URI.listResourcePrefix envAws prefix
    forM_ locations $ \location -> liftIO $ TIO.putStrLn (tshow location)

    return ()

  case result of
    Right _  -> return ()
    Left msg -> TIO.hPutStrLn IO.stderr (displayUriError msg)

optsLsPrefix :: Parser Z.LsPrefixOptions
optsLsPrefix = Z.LsPrefixOptions
  <$> option (maybeReader (toLocation . T.pack))
        (   long "prefix"
        <>  short 'p'
        <>  help "Prefix location"
        <>  metavar "LOCATION"
        )
  <*> option auto
      (  long "region"
      <> metavar "AWS_REGION"
      <> showDefault <> value Oregon
      <> help "The AWS region in which to operate"
      )
  <*> optional
      ( option autoText
        (   long "aws-log-level"
        <>  help "AWS Log Level.  One of (Error, Info, Debug, Trace)"
        <>  metavar "AWS_LOG_LEVEL"
        )
      )

cmdLsPrefix :: Mod CommandFields (IO ())
cmdLsPrefix = command "ls-prefix"  $ flip info idm $ runLsPrefix <$> optsLsPrefix