diff --git a/src/Clompse/Cli.hs b/src/Clompse/Cli.hs index 1bfe81a..6e63ede 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.ListDomains as Programs import qualified Clompse.Programs.ListObjectBuckets as Programs import qualified Clompse.Programs.ListServers as Programs import qualified Clompse.Types as Types @@ -53,6 +54,7 @@ optProgram = commandConfig <|> commandServer <|> commandStorage + <|> commandDomains <|> commandVersion @@ -327,6 +329,84 @@ doObjectBucketListJson = BLC.putStrLn . Aeson.encode +-- ** domains + + +-- | Definition for @storage@ CLI command. +commandDomains :: OA.Parser (IO ExitCode) +commandDomains = OA.hsubparser (OA.command "domains" (OA.info parser infomod) <> OA.metavar "domains") + where + infomod = OA.fullDesc <> infoModHeader <> OA.progDesc "DNS commands." <> OA.footer "This command provides various DNS commands." + parser = + commandDomainsList + + +-- *** domains list + + +-- | Definition for @domains list@ CLI command. +commandDomainsList :: OA.Parser (IO ExitCode) +commandDomainsList = OA.hsubparser (OA.command "list" (OA.info parser infomod) <> OA.metavar "list") + where + infomod = OA.fullDesc <> infoModHeader <> OA.progDesc "List domains." <> OA.footer "This command lists domains." + parser = + doDomainsList + <$> 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.") + + +doDomainsList :: FilePath -> Int -> ServerListFormat -> IO ExitCode +doDomainsList fp ts fmt = do + eCfg <- readConfigFile fp + case eCfg of + Left err -> TIO.putStrLn ("Error reading configuration: " <> err) >> pure (ExitFailure 1) + Right cfg -> do + domains <- concatMap Programs.toDomainsList <$> Programs.listDomains ts cfg + case fmt of + ServerListFormatConsole -> doDomainsListConsole domains + ServerListFormatCsv -> doDomainsListCsv domains + ServerListFormatJson -> doDomainsListJson domains + pure ExitSuccess + + +doDomainsListConsole :: Programs.DomainsList -> IO () +doDomainsListConsole 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 + ] + hs = + Tab.titlesH + [ "#" :: String + , "Profile" + , "Provider" + , "Domain" + ] + mkRows i Programs.DomainsListItem {..} = + Tab.rowG . fmap T.unpack $ + [ formatIntegral i + , _domainsListItemProfile + , Types.providerCode _domainsListItemProvider + , _domainsListItemDomain + ] + rows = fmap (uncurry mkRows) (zip [1 :: Int ..] rs) + table = Tab.columnHeaderTableS cs Tab.unicodeS hs rows + in putStrLn $ Tab.tableString table + + +doDomainsListCsv :: Programs.DomainsList -> IO () +doDomainsListCsv = + BLC.putStrLn . Cassava.encodeDefaultOrderedByName + + +doDomainsListJson :: Programs.DomainsList -> IO () +doDomainsListJson = + BLC.putStrLn . Aeson.encode + + -- ** version diff --git a/src/Clompse/Programs/ListDomains.hs b/src/Clompse/Programs/ListDomains.hs new file mode 100644 index 0000000..55fc99b --- /dev/null +++ b/src/Clompse/Programs/ListDomains.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module Clompse.Programs.ListDomains where + +import qualified Autodocodec as ADC +import Clompse.Config (CloudConnection (..), CloudProfile (..), Config (..)) +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) +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.Vector as V +import GHC.Generics (Generic) +import qualified System.IO +import qualified Zamazingo.Text as Z.Text + + +data ListDomainsResult = ListDomainsResult + { _listDomainsResultProfile :: !T.Text + , _listDomainsResultDomains :: ![Types.Domain] + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec ListDomainsResult) + + +instance ADC.HasCodec ListDomainsResult where + codec = + _codec ADC. "List Domains Result Result" + where + _codec = + ADC.object "ListDomainsResult" $ + ListDomainsResult + <$> ADC.requiredField "profile" "Name of the cloud profile." ADC..= _listDomainsResultProfile + <*> ADC.requiredField "domains" "List of domains." ADC..= _listDomainsResultDomains + + +listDomains + :: MonadIO m + => Int + -> Config + -> m [ListDomainsResult] +listDomains ts Config {..} = + liftIO . Async.withTaskGroup ts $ \tg -> Async.mapTasks tg (fmap listDomainsForCloudProfile _configCloudProfiles) + + +listDomainsForCloudProfile + :: MonadIO m + => CloudProfile + -> m ListDomainsResult +listDomainsForCloudProfile CloudProfile {..} = + ListDomainsResult _cloudProfileName . concat <$> mapM listDomainsForCloudConnection _cloudProfileConnections + + +listDomainsForCloudConnection + :: MonadIO m + => CloudConnection + -> m [Types.Domain] +listDomainsForCloudConnection (CloudConnectionAws _conn) = do + pure [] +listDomainsForCloudConnection (CloudConnectionDo conn) = do + eRecords <- runExceptT (Providers.Do.listDomains conn) + case eRecords of + Left e -> _log (" ERROR (DO Domains): " <> Z.Text.tshow e) >> pure [] + Right records -> pure records +listDomainsForCloudConnection (CloudConnectionHetzner _conn) = do + pure [] + + +_log :: MonadIO m => T.Text -> m () +_log = + liftIO . TIO.hPutStrLn System.IO.stderr + + +type DomainsList = [DomainsListItem] + + +data DomainsListItem = DomainsListItem + { _domainsListItemProfile :: !T.Text + , _domainsListItemProvider :: !Types.Provider + , _domainsListItemDomain :: !T.Text + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec DomainsListItem) + + +instance ADC.HasCodec DomainsListItem where + codec = + _codec ADC. "Domains List Item" + where + _codec = + ADC.object "DomainsListItem" $ + DomainsListItem + <$> ADC.requiredField "profile" "Name of the cloud profile." ADC..= _domainsListItemProfile + <*> ADC.requiredField "provider" "Provider of the object bucket." ADC..= _domainsListItemProvider + <*> ADC.requiredField "domain" "Name of the object bucket." ADC..= _domainsListItemDomain + + +instance Cassava.ToNamedRecord DomainsListItem where + toNamedRecord DomainsListItem {..} = + Cassava.namedRecord + [ "profile" Cassava..= _domainsListItemProfile + , "provider" Cassava..= Types.providerCode _domainsListItemProvider + , "domain" Cassava..= _domainsListItemDomain + ] + + +instance Cassava.DefaultOrdered DomainsListItem where + headerOrder _ = + V.fromList + [ "profile" + , "provider" + , "domain" + ] + + +toDomainsList :: ListDomainsResult -> DomainsList +toDomainsList ListDomainsResult {..} = + fmap (go _listDomainsResultProfile) _listDomainsResultDomains + where + go p Types.Domain {..} = + DomainsListItem + { _domainsListItemProfile = p + , _domainsListItemProvider = _domainProvider + , _domainsListItemDomain = _domainName + } diff --git a/src/Clompse/Providers/Do.hs b/src/Clompse/Providers/Do.hs index a5582f6..27d6fc3 100644 --- a/src/Clompse/Providers/Do.hs +++ b/src/Clompse/Providers/Do.hs @@ -4,10 +4,11 @@ module Clompse.Providers.Do ( DoError (..), DoConnection (..), listBuckets, + listDomains, listServers, ) where -import Clompse.Providers.Do.Api (listBuckets, listServers) +import Clompse.Providers.Do.Api (listBuckets, listDomains, listServers) import Clompse.Providers.Do.Connection (DoConnection (..)) import Clompse.Providers.Do.Error (DoError (..)) diff --git a/src/Clompse/Providers/Do/Api.hs b/src/Clompse/Providers/Do/Api.hs index 68b62ea..bc01dee 100644 --- a/src/Clompse/Providers/Do/Api.hs +++ b/src/Clompse/Providers/Do/Api.hs @@ -77,6 +77,20 @@ listBuckets conn = } +-- | Lists all domains available in the DigitalOcean account +-- associated with the given connection. +listDomains + :: MonadIO m + => MonadError DoError m + => DoConnection + -> m [Types.Domain] +listDomains conn = do + vals <- doctl conn ["compute", "domain", "list"] + case ACD.parseMaybe (ACD.list (ACD.key "name" ACD.text)) vals of + Nothing -> throwError (DoErrorParsing "Failed to parse domain list." (Aeson.encode vals)) + Just xs -> pure (fmap (\x -> Types.Domain {_domainName = x, _domainProvider = Types.ProviderDo}) xs) + + -- * Data Definitions @@ -519,6 +533,9 @@ awsS3EnvFromConnection accessKeyId secretAccessKey region = secretAccessKey' = Aws.SecretKey (TE.encodeUtf8 secretAccessKey) +-- *** DNS + + -- *** API Connection diff --git a/src/Clompse/Types.hs b/src/Clompse/Types.hs index a23f674..b688f7b 100644 --- a/src/Clompse/Types.hs +++ b/src/Clompse/Types.hs @@ -270,3 +270,23 @@ instance ADC.HasCodec FirewallRulePorts where FirewallRulePorts <$> ADC.requiredField "from" "From port." ADC..= _firewallRulePortsFrom <*> ADC.requiredField "to" "To port." ADC..= _firewallRulePortsTo + + +-- | Data definition for domains. +data Domain = Domain + { _domainName :: !T.Text + , _domainProvider :: !Provider + } + deriving (Eq, Generic, Show) + deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec Domain) + + +instance ADC.HasCodec Domain where + codec = + _codec ADC. "Domain Name" + where + _codec = + ADC.object "Domain" $ + Domain + <$> ADC.requiredField "name" "Domain name." ADC..= _domainName + <*> ADC.requiredField "provider" "Cloud provider." ADC..= _domainProvider