Merge pull request #55 from vst/47-list-dns-records-on-aws-route53

feat: list DNS records managed on AWS Route53
vst · May 16, 2024 · 68ae360 · 68ae360
2 parents 9431310 + 118c00e
commit 68ae360
Show file tree

Hide file tree

Showing 3 changed files with 81 additions and 13 deletions.
diff --git a/src/Clompse/Programs/ListDomainRecords.hs b/src/Clompse/Programs/ListDomainRecords.hs
@@ -7,6 +7,7 @@ module Clompse.Programs.ListDomainRecords where
 
 import qualified Autodocodec as ADC
 import Clompse.Config (CloudConnection (..), CloudProfile (..), Config (..))
+import qualified Clompse.Providers.Aws.ApiAws as Providers.Aws
 import qualified Clompse.Providers.Do as Providers.Do
 import Clompse.Types (DnsRecord (_dnsRecordProvider))
 import qualified Clompse.Types as Types
@@ -64,8 +65,11 @@ listDomainRecordsForCloudConnection
   :: MonadIO m
   => CloudConnection
   -> m [Types.DnsRecord]
-listDomainRecordsForCloudConnection (CloudConnectionAws _conn) = do
-  pure []
+listDomainRecordsForCloudConnection (CloudConnectionAws conn) = do
+  eRecords <- runExceptT (Providers.Aws.listDnsRecordsRoute53 conn)
+  case eRecords of
+    Left e -> _log ("    ERROR (Route53 Domain Records): " <> Z.Text.tshow e) >> pure []
+    Right records -> pure records
 listDomainRecordsForCloudConnection (CloudConnectionDo conn) = do
   eRecords <- runExceptT (Providers.Do.listDomainRecords conn)
   case eRecords of

diff --git a/src/Clompse/Providers/Aws.hs b/src/Clompse/Providers/Aws.hs
@@ -5,13 +5,14 @@ module Clompse.Providers.Aws (
   AwsConnection (..),
   listBucketsLightsail,
   listBucketsS3,
+  listDnsRecordsRoute53,
   listDomainsLightsail,
   listDomainsRoute53,
   listServersEc2,
   listServersLightsail,
 ) where
 
-import Clompse.Providers.Aws.ApiAws (listBucketsS3, listDomainsRoute53, listServersEc2)
+import Clompse.Providers.Aws.ApiAws (listBucketsS3, listDnsRecordsRoute53, listDomainsRoute53, listServersEc2)
 import Clompse.Providers.Aws.ApiLightsail (listBucketsLightsail, listDomainsLightsail, listServersLightsail)
 import Clompse.Providers.Aws.Connection (AwsConnection (..))
 import Clompse.Providers.Aws.Error (AwsError (..))

diff --git a/src/Clompse/Providers/Aws/ApiAws.hs b/src/Clompse/Providers/Aws/ApiAws.hs
@@ -30,6 +30,7 @@ import qualified Data.Conduit as C
 import qualified Data.Conduit.List as CL
 import qualified Data.HashMap.Strict as HM
 import qualified Data.List as List
+import qualified Data.List.NonEmpty as NE
 import Data.Maybe (catMaybes, fromMaybe, mapMaybe, maybeToList)
 import qualified Data.Text as T
 import qualified Data.Time as Time
@@ -64,17 +65,24 @@ listDomainsRoute53
   => AwsConnection
   -> m [Types.Domain]
 listDomainsRoute53 cfg = do
-  env <- _envFromConnection cfg
-  let prog = Aws.send env Aws.Route53.newListHostedZones
-  resIs <- liftIO . fmap (L.view Aws.Route53.Lens.listHostedZonesResponse_hostedZones) . Aws.runResourceT $ prog
-  pure $ fmap mkTuple resIs
+  recs <- route53ListDomains cfg
+  pure $ fmap mkTuple recs
   where
-    mkTuple b =
-      let name = b L.^. Aws.Route53.Lens.hostedZone_name
-       in Types.Domain
-            { Types._domainName = name
-            , Types._domainProvider = Types.ProviderAws
-            }
+    mkTuple (_, name) =
+      Types.Domain
+        { Types._domainName = name
+        , Types._domainProvider = Types.ProviderAws
+        }
+
+
+listDnsRecordsRoute53
+  :: MonadIO m
+  => MonadError AwsError m
+  => AwsConnection
+  -> m [Types.DnsRecord]
+listDnsRecordsRoute53 cfg = do
+  doms <- route53ListDomains cfg
+  concat <$> mapM (route53ListDnsRecords cfg) doms
 
 
 -- * Data Definitions
@@ -258,6 +266,61 @@ awsListAllS3Buckets cfg = do
        in (name, time)
 
 
+route53ListDomains
+  :: MonadIO m
+  => MonadError AwsError m
+  => AwsConnection
+  -> m [(Aws.Route53.ResourceId, T.Text)]
+route53ListDomains cfg = do
+  env <- _envFromConnection cfg
+  let prog = Aws.send env Aws.Route53.newListHostedZones
+  resIs <- liftIO . fmap (L.view Aws.Route53.Lens.listHostedZonesResponse_hostedZones) . Aws.runResourceT $ prog
+  pure $ fmap mkTuple resIs
+  where
+    mkTuple b =
+      let resId = b L.^. Aws.Route53.Lens.hostedZone_id
+          name = b L.^. Aws.Route53.Lens.hostedZone_name
+       in (resId, name)
+
+
+route53ListDnsRecords
+  :: MonadIO m
+  => MonadError AwsError m
+  => AwsConnection
+  -> (Aws.Route53.ResourceId, T.Text)
+  -> m [Types.DnsRecord]
+route53ListDnsRecords cfg (resId, dmn) = do
+  env <- _envFromConnection cfg
+  let prog =
+        Aws.paginate env (Aws.Route53.newListResourceRecordSets resId)
+          .| CL.concatMap (L.view Aws.Route53.Lens.listResourceRecordSetsResponse_resourceRecordSets)
+          .| CL.consume
+  resIs <- liftIO . Aws.runResourceT . C.runConduit $ prog
+  pure $ fmap mkTuple resIs
+  where
+    mkTuple b =
+      let _dnsRecordId = b L.^. Aws.Route53.Lens.resourceRecordSet_setIdentifier
+          _dnsRecordName = b L.^. Aws.Route53.Lens.resourceRecordSet_name
+          _dnsRecordType = Aws.Route53.fromRRType (b L.^. Aws.Route53.Lens.resourceRecordSet_type)
+          _dnsRecordTtl = maybe 0 fromIntegral $ b L.^. Aws.Route53.Lens.resourceRecordSet_ttl
+          _dnsRecordValue = foldMap (T.intercalate " # " . fmap (L.view Aws.Route53.Lens.resourceRecord_value) . NE.toList) $ b L.^. Aws.Route53.Lens.resourceRecordSet_resourceRecords
+          _dnsRecordPriority = Nothing
+          _dnsRecordPort = Nothing
+          _dnsRecordWeight = fromIntegral <$> b L.^. Aws.Route53.Lens.resourceRecordSet_weight
+          _dnsRecordFlags = Nothing
+       in Types.DnsRecord
+            { _dnsRecordProvider = Types.ProviderAws
+            , _dnsRecordDomain = dmn
+            , ..
+            }
+
+
+-- { Types._dnsRecordName = name
+-- , Types._dnsRecordType = type_
+-- , Types._dnsRecordTtl = ttl
+-- , Types._dnsRecordValues = fmap (L.^. Aws.Route53.Lens.resourceRecord_value) values
+-- }
+
 -- ** Converters