From 9239890abd0dd99df8a7ecf05daa8c8b69cb0905 Mon Sep 17 00:00:00 2001
From: Vehbi Sinan Tunalioglu <vst@vsthost.com>
Date: Sat, 18 May 2024 09:21:10 +0800
Subject: [PATCH] feat: list DNS records managed on Hetzner

---
 src/Clompse/Programs/ListDomainRecords.hs |  8 ++++--
 src/Clompse/Providers/Hetzner.hs          |  3 ++-
 src/Clompse/Providers/Hetzner/Api.hs      | 31 ++++++++++++++++++++++-
 3 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/src/Clompse/Programs/ListDomainRecords.hs b/src/Clompse/Programs/ListDomainRecords.hs
index 7634c52..ef661f5 100644
--- a/src/Clompse/Programs/ListDomainRecords.hs
+++ b/src/Clompse/Programs/ListDomainRecords.hs
@@ -10,6 +10,7 @@ import Clompse.Config (CloudConnection (..), CloudProfile (..), Config (..))
 import qualified Clompse.Providers.Aws.ApiAws as Providers.Aws
 import qualified Clompse.Providers.Aws.ApiLightsail as Providers.Aws
 import qualified Clompse.Providers.Do as Providers.Do
+import qualified Clompse.Providers.Hetzner as Providers.Hetzner
 import Clompse.Types (DnsRecord (_dnsRecordProvider))
 import qualified Clompse.Types as Types
 import qualified Control.Concurrent.Async.Pool as Async
@@ -81,8 +82,11 @@ listDomainRecordsForCloudConnection (CloudConnectionDo conn) = do
   case eRecords of
     Left e -> _log ("    ERROR (DO Domain Records): " <> Z.Text.tshow e) >> pure []
     Right records -> pure records
-listDomainRecordsForCloudConnection (CloudConnectionHetzner _conn) = do
-  pure []
+listDomainRecordsForCloudConnection (CloudConnectionHetzner conn) = do
+  eRecords <- runExceptT (Providers.Hetzner.listDnsRecords conn)
+  case eRecords of
+    Left e -> _log ("    ERROR (Hetzner Domain Records): " <> 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
index c6bccbc..371f7c8 100644
--- a/src/Clompse/Providers/Hetzner.hs
+++ b/src/Clompse/Providers/Hetzner.hs
@@ -3,11 +3,12 @@
 module Clompse.Providers.Hetzner (
   HetznerError (..),
   HetznerConnection (..),
+  listDnsRecords,
   listDomains,
   listServers,
 ) where
 
-import Clompse.Providers.Hetzner.Api (listDomains, listServers)
+import Clompse.Providers.Hetzner.Api (listDnsRecords, 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
index 1d57307..69c0a72 100644
--- a/src/Clompse/Providers/Hetzner/Api.hs
+++ b/src/Clompse/Providers/Hetzner/Api.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
 
 -- | This module provides functions to query remote Hetzner API and
 -- convert responses to Clompse types.
@@ -10,7 +11,7 @@ import Clompse.Providers.Hetzner.Connection (HetznerConnection (..), hetznerConn
 import Clompse.Providers.Hetzner.Error (HetznerError)
 import qualified Clompse.Types as Types
 import Control.Monad.Except (MonadError)
-import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.Int
 import qualified Data.List as List
 import qualified Data.List.NonEmpty as NE
@@ -57,6 +58,34 @@ listDomains conn = do
         }
 
 
+listDnsRecords
+  :: MonadIO m
+  => MonadError HetznerError m
+  => HetznerConnection
+  -> m [Types.DnsRecord]
+listDnsRecords conn = do
+  zones <- maybe (pure []) (Hetzner.streamToList . Hetzner.streamPages . Hetzner.getZones) (hetznerConnectionTokenDns conn)
+  records <- concat <$> traverse (\Hetzner.Zone {..} -> liftIO $ fmap (zoneName,) <$> maybe (pure []) (`Hetzner.getRecords` Just zoneID) (hetznerConnectionTokenDns conn)) zones
+  pure $ fmap toDnsRecord records
+  where
+    toDnsRecord (zoneName, Hetzner.Record {..}) =
+      let (Hetzner.RecordID _dnsRecordId) = recordID
+          _dnsRecordType = Z.Text.tshow recordType
+          _dnsRecordName = recordName
+          _dnsRecordValue = recordValue
+          _dnsRecordPriority = Nothing
+          _dnsRecordPort = Nothing
+          _dnsRecordWeight = Nothing
+          _dnsRecordFlags = Nothing
+          _dnsRecordTtl = fromIntegral recordTTL
+       in Types.DnsRecord
+            { _dnsRecordProvider = Types.ProviderHetzner
+            , _dnsRecordDomain = zoneName
+            , _dnsRecordId = Just _dnsRecordId
+            , ..
+            }
+
+
 -- * Helpers