From 0cf913b31cfe50ef04c51f02be6ac3b9c2396147 Mon Sep 17 00:00:00 2001 From: Vehbi Sinan Tunalioglu Date: Sun, 5 May 2024 07:39:49 +0800 Subject: [PATCH] feat: list DigitalOcean spaces --- config_sample.yaml | 2 + config_schema.json | 8 ++ src/Clompse/Programs/ListObjectBuckets.hs | 6 +- src/Clompse/Providers/Do.hs | 103 ++++++++++++++++++++-- 4 files changed, 111 insertions(+), 8 deletions(-) diff --git a/config_sample.yaml b/config_sample.yaml index b1ce955..d97e095 100644 --- a/config_sample.yaml +++ b/config_sample.yaml @@ -20,6 +20,8 @@ cloud_profiles: - type: "do" value: token: "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef" + spaces_access_key_id: "AKIAIOSFODNN7EXAMPLE" + spaces_secret_access_key: "wJalrXUtnFEMI/K7MDENG/bPxRfiCYEXAMPLEKEY" - type: "hetzner" value: token: "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef" diff --git a/config_schema.json b/config_schema.json index 4c20daa..5c9a035 100644 --- a/config_schema.json +++ b/config_schema.json @@ -19,6 +19,14 @@ "value": { "$comment": "DigitalOcean connection details\nDigitalOcean Connection\nDigitalOceanConnection", "properties": { + "spaces_access_key_id": { + "$comment": "DigitalOcean Spaces access key identifier.", + "type": "string" + }, + "spaces_secret_access_key": { + "$comment": "DigitalOcean Spaces secret access key.", + "type": "string" + }, "token": { "$comment": "DigitalOcean API token.", "type": "string" diff --git a/src/Clompse/Programs/ListObjectBuckets.hs b/src/Clompse/Programs/ListObjectBuckets.hs index c880a24..9a870a4 100644 --- a/src/Clompse/Programs/ListObjectBuckets.hs +++ b/src/Clompse/Programs/ListObjectBuckets.hs @@ -8,6 +8,7 @@ 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.Providers.Do as Providers.Do import qualified Clompse.Types as Types import qualified Control.Concurrent.Async.Pool as Async import Control.Monad.Except (runExceptT) @@ -74,7 +75,10 @@ listObjectBucketsForCloudConnection (CloudConnectionAws conn) = do Right buckets -> pure (fmap (\(n, c) -> Types.ObjectBucket n Types.ProviderAws "Lightsail" (Just c)) buckets) pure $ bucketsS3 <> bucketsLightsail listObjectBucketsForCloudConnection (CloudConnectionDo _conn) = do - pure [] + eBucketSpaces <- runExceptT (Providers.Do.doListSpacesBuckets _conn) + case eBucketSpaces of + Left e -> _log (" ERROR (DO Spaces): " <> Z.Text.tshow e) >> pure [] + Right buckets -> pure (fmap (\(n, c) -> Types.ObjectBucket n Types.ProviderDo "Spaces" (Just c)) buckets) listObjectBucketsForCloudConnection (CloudConnectionHetzner _conn) = do pure [] diff --git a/src/Clompse/Providers/Do.hs b/src/Clompse/Providers/Do.hs index 3924dfd..0cf9d36 100644 --- a/src/Clompse/Providers/Do.hs +++ b/src/Clompse/Providers/Do.hs @@ -6,10 +6,15 @@ module Clompse.Providers.Do where +import qualified Amazonka as Aws +import qualified Amazonka.Auth as Aws.Auth +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 qualified Control.Lens as L import Control.Monad.Except (MonadError (throwError)) -import Control.Monad.IO.Class (MonadIO) +import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy as BL import Data.Int (Int16, Int32, Int64) @@ -17,6 +22,7 @@ import qualified Data.List as List import Data.Maybe (fromMaybe) import Data.Scientific (Scientific) import qualified Data.Text as T +import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TLE import qualified Data.Time as Time @@ -30,8 +36,10 @@ import qualified Zamazingo.Text as Z.Text -- * Connection -newtype DoConnection = DoConnection - { _doConnectionToken :: T.Text +data DoConnection = DoConnection + { _doConnectionToken :: !T.Text + , _doConnectionSpacesAccessKeyId :: !(Maybe T.Text) + , _doConnectionSpacesSecretAccessKey :: !(Maybe T.Text) } deriving (Eq, Generic, Show) deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec DoConnection) @@ -45,6 +53,8 @@ instance ADC.HasCodec DoConnection where ADC.object "DigitalOceanConnection" $ DoConnection <$> ADC.requiredField "token" "DigitalOcean API token." ADC..= _doConnectionToken + <*> ADC.optionalField "spaces_access_key_id" "DigitalOcean Spaces access key identifier." ADC..= _doConnectionSpacesAccessKeyId + <*> ADC.optionalField "spaces_secret_access_key" "DigitalOcean Spaces secret access key." ADC..= _doConnectionSpacesSecretAccessKey -- * Error @@ -119,8 +129,8 @@ instance ADC.HasCodec DoDroplet where data DoRegion = DoRegion { _doRegionSlug :: !T.Text , _doRegionName :: !T.Text - , _doRegionSizes :: ![T.Text] - , _doRegionAvailable :: !Bool + , _doRegionSizes :: !(Maybe [T.Text]) + , _doRegionAvailable :: !(Maybe Bool) , _doRegionFeatures :: ![T.Text] } deriving (Eq, Generic, Show) @@ -136,8 +146,8 @@ instance ADC.HasCodec DoRegion where DoRegion <$> ADC.requiredField "slug" "Region slug." ADC..= _doRegionSlug <*> ADC.requiredField "name" "Region name." ADC..= _doRegionName - <*> ADC.requiredField "sizes" "Region sizes." ADC..= _doRegionSizes - <*> ADC.requiredField "available" "Region availability." ADC..= _doRegionAvailable + <*> ADC.optionalField "sizes" "Region sizes." ADC..= _doRegionSizes + <*> ADC.optionalField "available" "Region availability." ADC..= _doRegionAvailable <*> ADC.requiredField "features" "Region features." ADC..= _doRegionFeatures @@ -403,6 +413,85 @@ doListFirewalls conn = doctl conn ["compute", "firewall", "list"] +-- ** List Regions + + +doListRegions + :: MonadIO m + => MonadError DoError m + => DoConnection + -> m [DoRegion] +doListRegions conn = + doctl conn ["compute", "region", "list"] + + +-- ** List Spaces Buckets + + +doListSpacesBuckets + :: MonadIO m + => MonadError DoError m + => DoConnection + -> m [(T.Text, Time.UTCTime)] +doListSpacesBuckets conn = do + let accessKeyId = _doConnectionSpacesAccessKeyId conn + let secretAccessKey = _doConnectionSpacesSecretAccessKey conn + case (accessKeyId, secretAccessKey) of + (Just sa, Just ss) -> do + regions <- filter isAvail <$> doListRegions conn + List.concat <$> traverse (doListSpacesBucketsForRegion conn sa ss) regions + _ -> pure [] + where + avail = ["nyc3", "ams3", "sfo2", "sfo3", "sgp1", "fra1", "blr1", "syd1"] + isAvail = (`List.elem` avail) . _doRegionSlug + + +doListSpacesBucketsForRegion + :: MonadIO m + => MonadError DoError m + => DoConnection + -> T.Text + -> T.Text + -> DoRegion + -> m [(T.Text, Time.UTCTime)] +doListSpacesBucketsForRegion _conn accessKeyId secretAccessKey region = do + env <- _envFromConnection accessKeyId secretAccessKey (_doRegionSlug region) + 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) + + +_envFromConnection + :: MonadIO m + => T.Text + -> T.Text + -> T.Text + -> m Aws.Env +_envFromConnection accessKeyId secretAccessKey region = + (\x -> x {Aws.overrides = service}) <$> Aws.newEnv (pure . Aws.Auth.fromKeys accessKeyId' secretAccessKey') + where + service = + const $ + Aws.S3.defaultService + { Aws.endpoint = + const $ + Aws.Endpoint + { host = TE.encodeUtf8 (region <> ".digitaloceanspaces.com") + , basePath = mempty + , secure = True + , port = 443 + , scope = TE.encodeUtf8 region + } + } + accessKeyId' = Aws.AccessKey (TE.encodeUtf8 accessKeyId) + secretAccessKey' = Aws.SecretKey (TE.encodeUtf8 secretAccessKey) + + -- * Helpers