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