Merge pull request #54 from vst/46-list-domains-managed-on-hetzner

feat: list domains managed on Hetzner
vst · May 15, 2024 · 9431310 · 9431310
2 parents b1d9632 + 202f034
commit 9431310
Show file tree

Hide file tree

Showing 6 changed files with 64 additions and 10 deletions.
diff --git a/config_sample.yaml b/config_sample.yaml
@@ -25,3 +25,7 @@ cloud_profiles:
       - type: "hetzner"
         value:
           token: "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"
+      - type: "hetzner"
+        value:
+          token: "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"
+          token_dns: "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"
diff --git a/config_schema.json b/config_schema.json
@@ -50,6 +50,17 @@
                         "token": {
                           "$comment": "Hetzner API token.",
                           "type": "string"
+                        },
+                        "token_dns": {
+                          "$comment": "Hetzner DNS API token.",
+                          "anyOf": [
+                            {
+                              "type": "null"
+                            },
+                            {
+                              "type": "string"
+                            }
+                          ]
                         }
                       },
                       "required": ["token"],

diff --git a/src/Clompse/Programs/ListDomains.hs b/src/Clompse/Programs/ListDomains.hs
@@ -9,6 +9,7 @@ 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.Providers.Hetzner as Providers.Hetzner
 import qualified Clompse.Types as Types
 import qualified Control.Concurrent.Async.Pool as Async
 import Control.Monad.Except (runExceptT)
@@ -78,8 +79,11 @@ listDomainsForCloudConnection (CloudConnectionDo conn) = do
   case eRecords of
     Left e -> _log ("    ERROR (DO Domains): " <> Z.Text.tshow e) >> pure []
     Right records -> pure records
-listDomainsForCloudConnection (CloudConnectionHetzner _conn) = do
-  pure []
+listDomainsForCloudConnection (CloudConnectionHetzner conn) = do
+  eRecords <- runExceptT (Providers.Hetzner.listDomains conn)
+  case eRecords of
+    Left e -> _log ("    ERROR (Hetzner Domains): " <> Z.Text.tshow e) >> pure []
+    Right records -> pure records
 
 
 _log :: MonadIO m => T.Text -> m ()

diff --git a/src/Clompse/Providers/Hetzner.hs b/src/Clompse/Providers/Hetzner.hs
@@ -3,10 +3,11 @@
 module Clompse.Providers.Hetzner (
   HetznerError (..),
   HetznerConnection (..),
+  listDomains,
   listServers,
 ) where
 
-import Clompse.Providers.Hetzner.Api (listServers)
+import Clompse.Providers.Hetzner.Api (listDomains, listServers)
 import Clompse.Providers.Hetzner.Connection (HetznerConnection (..))
 import Clompse.Providers.Hetzner.Error (HetznerError (..))
 
diff --git a/src/Clompse/Providers/Hetzner/Api.hs b/src/Clompse/Providers/Hetzner/Api.hs
@@ -6,7 +6,7 @@
 -- convert responses to Clompse types.
 module Clompse.Providers.Hetzner.Api where
 
-import Clompse.Providers.Hetzner.Connection (HetznerConnection (..), hetznerConnectionToken)
+import Clompse.Providers.Hetzner.Connection (HetznerConnection (..), hetznerConnectionToken, hetznerConnectionTokenDns)
 import Clompse.Providers.Hetzner.Error (HetznerError)
 import qualified Clompse.Types as Types
 import Control.Monad.Except (MonadError)
@@ -18,6 +18,7 @@ import Data.Maybe (mapMaybe, maybeToList)
 import qualified Data.Text as T
 import qualified Data.Time as Time
 import qualified Hetzner.Cloud as Hetzner
+import qualified Hetzner.DNS as Hetzner
 import qualified Net.IPv4
 import qualified Net.IPv6
 import qualified Zamazingo.Net as Z.Net
@@ -38,6 +39,24 @@ listServers = do
   fmap (fmap toServer) . apiListServersFirewalls
 
 
+-- | Lists all domains managed in the Hetzner account associated with
+-- the given connection.
+listDomains
+  :: MonadIO m
+  => MonadError HetznerError m
+  => HetznerConnection
+  -> m [Types.Domain]
+listDomains conn = do
+  zones <- maybe (pure []) (Hetzner.streamToList . Hetzner.streamPages . Hetzner.getZones) (hetznerConnectionTokenDns conn)
+  pure $ fmap toDomain zones
+  where
+    toDomain Hetzner.Zone {..} =
+      Types.Domain
+        { _domainName = zoneName
+        , _domainProvider = Types.ProviderHetzner
+        }
+
+
 -- * Helpers
 
 

diff --git a/src/Clompse/Providers/Hetzner/Connection.hs b/src/Clompse/Providers/Hetzner/Connection.hs
@@ -12,16 +12,18 @@ import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import GHC.Generics (Generic)
 import qualified Hetzner.Cloud as Hetzner
+import qualified Hetzner.DNS as Hetzner.Dns
 
 
 -- | Data definition for Hetzner API connection configuration.
 --
--- >>> Aeson.encode $ HetznerConnection "my-token"
--- "{\"token\":\"my-token\"}"
+-- >>> Aeson.encode $ HetznerConnection "my-token" Nothing
+-- "{\"token\":\"my-token\",\"token_dns\":null}"
 -- >>> Aeson.decode "{\"token\":\"my-token\"}" :: Maybe HetznerConnection
--- Just (HetznerConnection {_hetznerConnectionToken = "my-token"})
-newtype HetznerConnection = HetznerConnection
-  { _hetznerConnectionToken :: T.Text
+-- Just (HetznerConnection {_hetznerConnectionToken = "my-token", _hetznerConnectionTokenDns = Nothing})
+data HetznerConnection = HetznerConnection
+  { _hetznerConnectionToken :: !T.Text
+  , _hetznerConnectionTokenDns :: !(Maybe T.Text)
   }
   deriving (Eq, Generic, Show)
   deriving (Aeson.FromJSON, Aeson.ToJSON) via (ADC.Autodocodec HetznerConnection)
@@ -35,13 +37,26 @@ instance ADC.HasCodec HetznerConnection where
         ADC.object "HetznerConnection" $
           HetznerConnection
             <$> ADC.requiredField "token" "Hetzner API token." ADC..= _hetznerConnectionToken
+            <*> ADC.optionalFieldWithDefault "token_dns" Nothing "Hetzner DNS API token." ADC..= _hetznerConnectionTokenDns
 
 
 -- | Extracts the Hetzner API token from a connection configuration
 -- and builds a 'Hetzner.Token' value.
 --
--- >>> hetznerConnectionToken (HetznerConnection "my-token")
+-- >>> hetznerConnectionToken (HetznerConnection "my-token" Nothing)
 -- Token "my-token"
 hetznerConnectionToken :: HetznerConnection -> Hetzner.Token
 hetznerConnectionToken =
   Hetzner.Token . TE.encodeUtf8 . _hetznerConnectionToken
+
+
+-- | Extracts the Hetzner API token from a connection configuration
+-- and builds a 'Hetzner.Token' value (for DNS API).
+--
+-- >>> hetznerConnectionTokenDns (HetznerConnection "my-token" Nothing)
+-- Nothing
+-- >>> hetznerConnectionTokenDns (HetznerConnection "my-token" (Just "my-dns-token"))
+-- Just (Token "my-dns-token")
+hetznerConnectionTokenDns :: HetznerConnection -> Maybe Hetzner.Dns.Token
+hetznerConnectionTokenDns =
+  fmap (Hetzner.Dns.Token . TE.encodeUtf8) . _hetznerConnectionTokenDns