From bb0a78a202a01769ebdb17d7aed854252bcd0a74 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 4 May 2024 19:49:30 +0800 Subject: [PATCH 1/2] feat: list AWS S3 buckets --- package.yaml | 1 + src/Clompse/Cli.hs | 83 +++++++++++++ src/Clompse/Programs/ListObjectBuckets.hs | 138 ++++++++++++++++++++++ src/Clompse/Providers/Aws.hs | 23 ++++ src/Clompse/Types.hs | 21 ++++ 5 files changed, 266 insertions(+) create mode 100644 src/Clompse/Programs/ListObjectBuckets.hs diff --git a/package.yaml b/package.yaml index 10a2a49..d727a71 100644 --- a/package.yaml +++ b/package.yaml @@ -23,6 +23,7 @@ library: - amazonka-core - amazonka-ec2 - amazonka-lightsail + - amazonka-s3 - async-pool - autodocodec - autodocodec-schema diff --git a/src/Clompse/Cli.hs b/src/Clompse/Cli.hs index abf1e68..8b326b2 100644 --- a/src/Clompse/Cli.hs +++ b/src/Clompse/Cli.hs @@ -9,6 +9,7 @@ module Clompse.Cli where import qualified Autodocodec.Schema as ADC.Schema import Clompse.Config (Config, readConfigFile) import qualified Clompse.Meta as Meta +import qualified Clompse.Programs.ListObjectBuckets as Programs import qualified Clompse.Programs.ListServers as Programs import qualified Clompse.Types as Types import Control.Applicative ((<**>), (<|>)) @@ -51,6 +52,7 @@ optProgram :: OA.Parser (IO ExitCode) optProgram = commandConfig <|> commandServer + <|> commandStorage <|> commandVersion @@ -241,6 +243,87 @@ formatIntegral = Fmt.Number.prettyI (Just ',') . fromIntegral +-- ** storage + + +-- | Definition for @storage@ CLI command. +commandStorage :: OA.Parser (IO ExitCode) +commandStorage = OA.hsubparser (OA.command "storage" (OA.info parser infomod) <> OA.metavar "storage") + where + infomod = OA.fullDesc <> infoModHeader <> OA.progDesc "Storage commands." <> OA.footer "This command provides various storage commands." + parser = + commandStorageObjectBucketList + + +-- *** storage object-bucket-list + + +-- | Definition for @storage object-bucket-list@ CLI command. +commandStorageObjectBucketList :: OA.Parser (IO ExitCode) +commandStorageObjectBucketList = OA.hsubparser (OA.command "object-bucket-list" (OA.info parser infomod) <> OA.metavar "object-bucket-list") + where + infomod = OA.fullDesc <> infoModHeader <> OA.progDesc "List object buckets." <> OA.footer "This command lists object buckets." + parser = + doStorageObjectBucketList + <$> OA.strOption (OA.short 'c' <> OA.long "config" <> OA.metavar "CONFIG" <> OA.help "Configuration file to use.") + <*> OA.option OA.auto (OA.short 't' <> OA.long "threads" <> OA.value 4 <> OA.showDefault <> OA.help "Number of threads to run API tasks in.") + <*> OA.option parseServerListFormat (OA.short 'f' <> OA.long "format" <> OA.value ServerListFormatConsole <> OA.showDefault <> OA.help "Output format (csv, json or console.") + + +doStorageObjectBucketList :: FilePath -> Int -> ServerListFormat -> IO ExitCode +doStorageObjectBucketList fp ts fmt = do + eCfg <- readConfigFile fp + case eCfg of + Left err -> TIO.putStrLn ("Error reading configuration: " <> err) >> pure (ExitFailure 1) + Right cfg -> do + buckets <- concatMap Programs.toObjectBucketList <$> Programs.listObjectBuckets ts cfg + case fmt of + ServerListFormatConsole -> doObjectBucketListConsole buckets + ServerListFormatCsv -> doObjectBucketListCsv buckets + ServerListFormatJson -> doObjectBucketListJson buckets + pure ExitSuccess + + +doObjectBucketListConsole :: Programs.ObjectBucketList -> IO () +doObjectBucketListConsole rs = + let cs = + [ Tab.numCol + , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark + , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark + , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark + , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark + ] + hs = + Tab.titlesH + [ "#" :: String + , "Profile" + , "Provider" + , "Name" + , "Created" + ] + mkRows i Programs.ObjectBucketListItem {..} = + Tab.rowG . fmap T.unpack $ + [ formatIntegral i + , _objectBucketListItemProfile + , Types.providerCode _objectBucketListItemProvider + , _objectBucketListItemName + , maybe "" Z.Text.tshow _objectBucketListItemCreatedAt + ] + rows = fmap (uncurry mkRows) (zip [1 :: Int ..] rs) + table = Tab.columnHeaderTableS cs Tab.unicodeS hs rows + in putStrLn $ Tab.tableString table + + +doObjectBucketListCsv :: Programs.ObjectBucketList -> IO () +doObjectBucketListCsv = + BLC.putStrLn . Cassava.encodeDefaultOrderedByName + + +doObjectBucketListJson :: Programs.ObjectBucketList -> IO () +doObjectBucketListJson = + BLC.putStrLn . Aeson.encode + + -- ** version diff --git a/src/Clompse/Programs/ListObjectBuckets.hs b/src/Clompse/Programs/ListObjectBuckets.hs new file mode 100644 index 0000000..3fda037 --- /dev/null +++ b/src/Clompse/Programs/ListObjectBuckets.hs @@ -0,0 +1,138 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Clompse.Programs.ListObjectBuckets where + +import qualified Autodocodec as ADC +import Clompse.Config (CloudConnection (..), CloudProfile (..), Config (..)) +import qualified Clompse.Providers.Aws as Providers.Aws +import qualified Clompse.Types as Types +import qualified Control.Concurrent.Async.Pool as Async +import Control.Monad.Except (runExceptT) +import Control.Monad.IO.Class (MonadIO (..)) +import qualified Data.Aeson as Aeson +import qualified Data.Csv as Cassava +import qualified Data.Text as T +import qualified Data.Text.IO as TIO +import qualified Data.Time as Time +import qualified Data.Vector as V +import GHC.Generics (Generic) +import qualified System.IO +import qualified Zamazingo.Text as Z.Text + + +data ListObjectBucketsResult = ListObjectBucketsResult + { _listObjectBucketsResultProfile :: !T.Text + , _listObjectBucketsResultBuckets :: ![Types.ObjectBucket] + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ListObjectBucketsResult) + + +instance ADC.HasCodec ListObjectBucketsResult where + codec = + _codec ADC. "List Object Buckets Result" + where + _codec = + ADC.object "ListObjectBucketsResult" $ + ListObjectBucketsResult + <$> ADC.requiredField "profile" "Name of the cloud profile." ADC..= _listObjectBucketsResultProfile + <*> ADC.requiredField "buckets" "List of object buckets." ADC..= _listObjectBucketsResultBuckets + + +listObjectBuckets + :: MonadIO m + => Int + -> Config + -> m [ListObjectBucketsResult] +listObjectBuckets ts Config {..} = + liftIO . Async.withTaskGroup ts $ \tg -> Async.mapTasks tg (fmap listObjectBucketsForCloudProfile _configCloudProfiles) + + +listObjectBucketsForCloudProfile + :: MonadIO m + => CloudProfile + -> m ListObjectBucketsResult +listObjectBucketsForCloudProfile CloudProfile {..} = + ListObjectBucketsResult _cloudProfileName . concat <$> mapM listObjectBucketsForCloudConnection _cloudProfileConnections + + +listObjectBucketsForCloudConnection + :: MonadIO m + => CloudConnection + -> m [Types.ObjectBucket] +listObjectBucketsForCloudConnection (CloudConnectionAws conn) = do + eBucketsS3 <- runExceptT (Providers.Aws.awsListAllS3Buckets conn) + case eBucketsS3 of + Left e -> _log (" ERROR (AWS S3): " <> Z.Text.tshow e) >> pure [] + Right buckets -> pure (fmap (\(n, c) -> Types.ObjectBucket n Types.ProviderAws (Just c)) buckets) +listObjectBucketsForCloudConnection (CloudConnectionDo _conn) = do + pure [] +listObjectBucketsForCloudConnection (CloudConnectionHetzner _conn) = do + pure [] + + +_log :: MonadIO m => T.Text -> m () +_log = + liftIO . TIO.hPutStrLn System.IO.stderr + + +type ObjectBucketList = [ObjectBucketListItem] + + +data ObjectBucketListItem = ObjectBucketListItem + { _objectBucketListItemProfile :: !T.Text + , _objectBucketListItemProvider :: !Types.Provider + , _objectBucketListItemName :: !T.Text + , _objectBucketListItemCreatedAt :: !(Maybe Time.UTCTime) + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ObjectBucketListItem) + + +instance ADC.HasCodec ObjectBucketListItem where + codec = + _codec ADC. "Object Bucket List Item" + where + _codec = + ADC.object "ObjectBucketListItem" $ + ObjectBucketListItem + <$> ADC.requiredField "profile" "Name of the cloud profile." ADC..= _objectBucketListItemProfile + <*> ADC.requiredField "provider" "Provider of the object bucket." ADC..= _objectBucketListItemProvider + <*> ADC.requiredField "name" "Name of the object bucket." ADC..= _objectBucketListItemName + <*> ADC.optionalField "created_at" "Creation time of the object bucket." ADC..= _objectBucketListItemCreatedAt + + +instance Cassava.ToNamedRecord ObjectBucketListItem where + toNamedRecord ObjectBucketListItem {..} = + Cassava.namedRecord + [ "profile" Cassava..= _objectBucketListItemProfile + , "provider" Cassava..= Types.providerCode _objectBucketListItemProvider + , "name" Cassava..= _objectBucketListItemName + , "created_at" Cassava..= fmap Z.Text.tshow _objectBucketListItemCreatedAt + ] + + +instance Cassava.DefaultOrdered ObjectBucketListItem where + headerOrder _ = + V.fromList + [ "profile" + , "provider" + , "name" + , "created_at" + ] + + +toObjectBucketList :: ListObjectBucketsResult -> ObjectBucketList +toObjectBucketList ListObjectBucketsResult {..} = + fmap (go _listObjectBucketsResultProfile) _listObjectBucketsResultBuckets + where + go p Types.ObjectBucket {..} = + ObjectBucketListItem + { _objectBucketListItemProfile = p + , _objectBucketListItemProvider = _objectBucketProvider + , _objectBucketListItemName = _objectBucketName + , _objectBucketListItemCreatedAt = _objectBucketCreatedAt + } diff --git a/src/Clompse/Providers/Aws.hs b/src/Clompse/Providers/Aws.hs index a467715..bc4825b 100644 --- a/src/Clompse/Providers/Aws.hs +++ b/src/Clompse/Providers/Aws.hs @@ -21,6 +21,8 @@ import qualified Amazonka.Lightsail as Aws.Lightsail import qualified Amazonka.Lightsail.Lens as Aws.Lightsail.Lens import qualified Amazonka.Lightsail.Types as Aws.Lightsail.Types import qualified Amazonka.Lightsail.Types.Disk as Aws.Lightsail.Types.Disk +import qualified Amazonka.S3 as Aws.S3 +import qualified Amazonka.S3.Lens as Aws.S3.Lens import qualified Autodocodec as ADC import qualified Clompse.Types as Types import Conduit ((.|)) @@ -38,6 +40,7 @@ import qualified Data.List as L import Data.Maybe (fromMaybe, mapMaybe, maybeToList) import qualified Data.Text as T import qualified Data.Text.Encoding as TE +import qualified Data.Time as Time import GHC.Float (double2Int) import GHC.Generics (Generic) import qualified Zamazingo.Net as Z.Net @@ -238,6 +241,26 @@ awsEc2ListAllSecurityGroupsForRegion cfg reg = do -- let sids = catMaybes $ foldMap (fmap (L.^. Aws.Ec2.Lens.groupIdentifier_groupId)) (i L.^. Aws.Ec2.Lens.instance_securityGroups) -- in concatMap (\gi -> filter (\sg -> sg L.^. Aws.Ec2.Lens.securityGroup_groupId == gi) sgs) sids +-- *** S3 Buckets + + +awsListAllS3Buckets + :: MonadIO m + => MonadError AwsError m + => AwsConnection + -> m [(T.Text, Time.UTCTime)] +awsListAllS3Buckets cfg = do + env <- _envFromConnection cfg + let prog = Aws.send env Aws.S3.newListBuckets + resIs <- liftIO . fmap (fromMaybe [] . L.view Aws.S3.Lens.listBucketsResponse_buckets) . Aws.runResourceT $ prog + pure $ fmap mkTuple resIs + where + mkTuple b = + let name = b L.^. Aws.S3.Lens.bucket_name . Aws.S3._BucketName + time = b L.^. Aws.S3.Lens.bucket_creationDate + in (name, time) + + -- ** AWS Lightsail diff --git a/src/Clompse/Types.hs b/src/Clompse/Types.hs index de009eb..94018e1 100644 --- a/src/Clompse/Types.hs +++ b/src/Clompse/Types.hs @@ -176,3 +176,24 @@ instance ADC.HasCodec ServerIpInfo where <*> ADC.requiredField "public_ipv6" "Public IPv6 addresses." ADC..= _serverIpInfoPublicIpv6 <*> ADC.requiredField "private_ipv4" "Private IPv4 addresses." ADC..= _serverIpInfoPrivateIpv4 <*> ADC.requiredField "private_ipv6" "Private IPv6 addresses." ADC..= _serverIpInfoPrivateIpv6 + + +data ObjectBucket = ObjectBucket + { _objectBucketName :: !T.Text + , _objectBucketProvider :: !Provider + , _objectBucketCreatedAt :: !(Maybe Time.UTCTime) + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ObjectBucket) + + +instance ADC.HasCodec ObjectBucket where + codec = + _codec ADC. "Object Bucket" + where + _codec = + ADC.object "ObjectBucket" $ + ObjectBucket + <$> ADC.requiredField "name" "Bucket name." ADC..= _objectBucketName + <*> ADC.requiredField "provider" "Cloud provider." ADC..= _objectBucketProvider + <*> ADC.optionalField "created_at" "Creation timestamp." ADC..= _objectBucketCreatedAt From 7b801dc2203deec011396df3ca1024171a6ba807 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sat, 4 May 2024 20:46:41 +0800 Subject: [PATCH 2/2] feat: list AWS Lightsail buckets --- src/Clompse/Cli.hs | 3 ++ src/Clompse/Programs/ListObjectBuckets.hs | 14 ++++++-- src/Clompse/Providers/Aws.hs | 41 +++++++++++++++++++++++ src/Clompse/Types.hs | 2 ++ 4 files changed, 58 insertions(+), 2 deletions(-) diff --git a/src/Clompse/Cli.hs b/src/Clompse/Cli.hs index 8b326b2..1bfe81a 100644 --- a/src/Clompse/Cli.hs +++ b/src/Clompse/Cli.hs @@ -292,12 +292,14 @@ doObjectBucketListConsole rs = , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark + , Tab.column Tab.expand Tab.left Tab.noAlign Tab.noCutMark ] hs = Tab.titlesH [ "#" :: String , "Profile" , "Provider" + , "Product" , "Name" , "Created" ] @@ -306,6 +308,7 @@ doObjectBucketListConsole rs = [ formatIntegral i , _objectBucketListItemProfile , Types.providerCode _objectBucketListItemProvider + , _objectBucketListItemProduct , _objectBucketListItemName , maybe "" Z.Text.tshow _objectBucketListItemCreatedAt ] diff --git a/src/Clompse/Programs/ListObjectBuckets.hs b/src/Clompse/Programs/ListObjectBuckets.hs index 3fda037..c880a24 100644 --- a/src/Clompse/Programs/ListObjectBuckets.hs +++ b/src/Clompse/Programs/ListObjectBuckets.hs @@ -65,9 +65,14 @@ listObjectBucketsForCloudConnection -> m [Types.ObjectBucket] listObjectBucketsForCloudConnection (CloudConnectionAws conn) = do eBucketsS3 <- runExceptT (Providers.Aws.awsListAllS3Buckets conn) - case eBucketsS3 of + bucketsS3 <- case eBucketsS3 of Left e -> _log (" ERROR (AWS S3): " <> Z.Text.tshow e) >> pure [] - Right buckets -> pure (fmap (\(n, c) -> Types.ObjectBucket n Types.ProviderAws (Just c)) buckets) + Right buckets -> pure (fmap (\(n, c) -> Types.ObjectBucket n Types.ProviderAws "S3" (Just c)) buckets) + eBucketsLightsail <- runExceptT (Providers.Aws.awsListAllLightsailBuckets conn) + bucketsLightsail <- case eBucketsLightsail of + Left e -> _log (" ERROR (AWS Lightsail): " <> Z.Text.tshow e) >> pure [] + Right buckets -> pure (fmap (\(n, c) -> Types.ObjectBucket n Types.ProviderAws "Lightsail" (Just c)) buckets) + pure $ bucketsS3 <> bucketsLightsail listObjectBucketsForCloudConnection (CloudConnectionDo _conn) = do pure [] listObjectBucketsForCloudConnection (CloudConnectionHetzner _conn) = do @@ -85,6 +90,7 @@ type ObjectBucketList = [ObjectBucketListItem] data ObjectBucketListItem = ObjectBucketListItem { _objectBucketListItemProfile :: !T.Text , _objectBucketListItemProvider :: !Types.Provider + , _objectBucketListItemProduct :: !T.Text , _objectBucketListItemName :: !T.Text , _objectBucketListItemCreatedAt :: !(Maybe Time.UTCTime) } @@ -101,6 +107,7 @@ instance ADC.HasCodec ObjectBucketListItem where ObjectBucketListItem <$> ADC.requiredField "profile" "Name of the cloud profile." ADC..= _objectBucketListItemProfile <*> ADC.requiredField "provider" "Provider of the object bucket." ADC..= _objectBucketListItemProvider + <*> ADC.requiredField "product" "Product name." ADC..= _objectBucketListItemProduct <*> ADC.requiredField "name" "Name of the object bucket." ADC..= _objectBucketListItemName <*> ADC.optionalField "created_at" "Creation time of the object bucket." ADC..= _objectBucketListItemCreatedAt @@ -110,6 +117,7 @@ instance Cassava.ToNamedRecord ObjectBucketListItem where Cassava.namedRecord [ "profile" Cassava..= _objectBucketListItemProfile , "provider" Cassava..= Types.providerCode _objectBucketListItemProvider + , "product" Cassava..= _objectBucketListItemProduct , "name" Cassava..= _objectBucketListItemName , "created_at" Cassava..= fmap Z.Text.tshow _objectBucketListItemCreatedAt ] @@ -120,6 +128,7 @@ instance Cassava.DefaultOrdered ObjectBucketListItem where V.fromList [ "profile" , "provider" + , "product" , "name" , "created_at" ] @@ -133,6 +142,7 @@ toObjectBucketList ListObjectBucketsResult {..} = ObjectBucketListItem { _objectBucketListItemProfile = p , _objectBucketListItemProvider = _objectBucketProvider + , _objectBucketListItemProduct = _objectBucketProduct , _objectBucketListItemName = _objectBucketName , _objectBucketListItemCreatedAt = _objectBucketCreatedAt } diff --git a/src/Clompse/Providers/Aws.hs b/src/Clompse/Providers/Aws.hs index bc4825b..9bed6af 100644 --- a/src/Clompse/Providers/Aws.hs +++ b/src/Clompse/Providers/Aws.hs @@ -331,6 +331,47 @@ awsLightsailListAllInstancesForRegion cfg reg = do fmap (fmap (reg,)) . liftIO . Aws.runResourceT . C.runConduit $ prog +-- *** Buckets + + +awsListAllLightsailBuckets + :: MonadIO m + => MonadError AwsError m + => AwsConnection + -> m [(T.Text, Time.UTCTime)] +awsListAllLightsailBuckets cfg = do + regions <- awsLightsailListAllRegions cfg + res <- liftIO . Async.withTaskGroup 4 $ \tg -> Async.mapTasks tg (fmap (runExceptT . awsListAllLightsailBucketsForRegion cfg) regions) + case concat <$> sequence res of + Left e -> throwError e + Right x -> pure x + + +awsListAllLightsailBucketsForRegion + :: MonadIO m + => MonadError AwsError m + => AwsConnection + -> Aws.Region + -> m [(T.Text, Time.UTCTime)] +awsListAllLightsailBucketsForRegion cfg reg = do + env <- (\x -> x {Aws.region = reg}) <$> _envFromConnection cfg + let prog = Aws.send env Aws.Lightsail.newGetBuckets + resIs <- liftIO . Aws.runResourceT $ prog + -- NOTE: Amazonka does not support pagination over Lightsail buckets. + -- let prog = + -- Aws.paginate env Aws.Lightsail.newGetBuckets + -- .| CL.concatMap (L.view $ Aws.Lightsail.Lens.getBucketsResponse_buckets . L._Just) + -- .| CL.consume + -- resIs <- liftIO . Aws.runResourceT . C.runConduit $ prog + let buckets = fromMaybe [] $ resIs L.^. Aws.Lightsail.Lens.getBucketsResponse_buckets + pure $ mapMaybe mkTuple buckets + where + mkTuple b = + let name = b L.^. Aws.Lightsail.Lens.bucket_name + time = b L.^. Aws.Lightsail.Lens.bucket_createdAt + in (,) <$> name <*> time + + -- * Helpers diff --git a/src/Clompse/Types.hs b/src/Clompse/Types.hs index 94018e1..c0fab5e 100644 --- a/src/Clompse/Types.hs +++ b/src/Clompse/Types.hs @@ -181,6 +181,7 @@ instance ADC.HasCodec ServerIpInfo where data ObjectBucket = ObjectBucket { _objectBucketName :: !T.Text , _objectBucketProvider :: !Provider + , _objectBucketProduct :: !T.Text , _objectBucketCreatedAt :: !(Maybe Time.UTCTime) } deriving (Eq, Generic, Show) @@ -196,4 +197,5 @@ instance ADC.HasCodec ObjectBucket where ObjectBucket <$> ADC.requiredField "name" "Bucket name." ADC..= _objectBucketName <*> ADC.requiredField "provider" "Cloud provider." ADC..= _objectBucketProvider + <*> ADC.requiredField "product" "Product name." ADC..= _objectBucketProduct <*> ADC.optionalField "created_at" "Creation timestamp." ADC..= _objectBucketCreatedAt