Merge pull request #56 from vst/48-list-dns-records-on-aws-lightsail

feat: list DNS records managed on AWS Lightsail

src/Clompse/Programs/ListDomainRecords.hs

@@ -8,6 +8,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.Aws.ApiLightsail as Providers.Aws
 import qualified Clompse.Providers.Do as Providers.Do
 import Clompse.Types (DnsRecord (_dnsRecordProvider))
 import qualified Clompse.Types as Types
@@ -66,10 +67,15 @@ listDomainRecordsForCloudConnection
   => CloudConnection
   -> m [Types.DnsRecord]
 listDomainRecordsForCloudConnection (CloudConnectionAws conn) = do
-  eRecords <- runExceptT (Providers.Aws.listDnsRecordsRoute53 conn)
-  case eRecords of
+  eRecordsRoute53 <- runExceptT (Providers.Aws.listDnsRecordsRoute53 conn)
+  recordsRoute53 <- case eRecordsRoute53 of
     Left e -> _log ("    ERROR (Route53 Domain Records): " <> Z.Text.tshow e) >> pure []
     Right records -> pure records
+  eRecordsLightsail <- runExceptT (Providers.Aws.listDnsRecordsLightsail conn)
+  recordsLightsail <- case eRecordsLightsail of
+    Left e -> _log ("    ERROR (Lightsail Domain Records): " <> Z.Text.tshow e) >> pure []
+    Right records -> pure records
+  pure (recordsRoute53 <> recordsLightsail)
 listDomainRecordsForCloudConnection (CloudConnectionDo conn) = do
   eRecords <- runExceptT (Providers.Do.listDomainRecords conn)
   case eRecords of

src/Clompse/Providers/Aws.hs

@@ -5,6 +5,7 @@ module Clompse.Providers.Aws (
   AwsConnection (..),
   listBucketsLightsail,
   listBucketsS3,
+  listDnsRecordsLightsail,
   listDnsRecordsRoute53,
   listDomainsLightsail,
   listDomainsRoute53,
@@ -13,7 +14,7 @@ module Clompse.Providers.Aws (
 ) where
 
 import Clompse.Providers.Aws.ApiAws (listBucketsS3, listDnsRecordsRoute53, listDomainsRoute53, listServersEc2)
-import Clompse.Providers.Aws.ApiLightsail (listBucketsLightsail, listDomainsLightsail, listServersLightsail)
+import Clompse.Providers.Aws.ApiLightsail (listBucketsLightsail, listDnsRecordsLightsail, listDomainsLightsail, listServersLightsail)
 import Clompse.Providers.Aws.Connection (AwsConnection (..))
 import Clompse.Providers.Aws.Error (AwsError (..))
 

src/Clompse/Providers/Aws/ApiLightsail.hs

@@ -69,6 +69,53 @@ listDomainsLightsail cfg = do
             }
 
 
+listDnsRecordsLightsail
+  :: MonadIO m
+  => MonadError AwsError m
+  => AwsConnection
+  -> m [Types.DnsRecord]
+listDnsRecordsLightsail cfg = do
+  env <- _envFromConnection cfg
+  let prog = Aws.send env Aws.Lightsail.newGetDomains
+  resIs <- liftIO . fmap (fromMaybe [] . L.view Aws.Lightsail.Lens.getDomainsResponse_domains) . Aws.runResourceT $ prog
+  pure $ concatMap mkEntries resIs
+  where
+    mkEntries b =
+      let name = fromMaybe "<unknown>" (b L.^. Aws.Lightsail.Lens.domain_name)
+          entries = fromMaybe [] (b L.^. Aws.Lightsail.Lens.domain_domainEntries)
+       in fmap (mkEntry name) entries
+    mkEntry name e =
+      let _dnsRecordId = e L.^. Aws.Lightsail.Lens.domainEntry_id
+          _dnsRecordName = fromMaybe "<unknown" (e L.^. Aws.Lightsail.Lens.domainEntry_name)
+          _dnsRecordType = fromMaybe "<unknown" (e L.^. Aws.Lightsail.Lens.domainEntry_type)
+          _dnsRecordTtl = 60 -- Lightsail does not provide TTL management.
+          _dnsRecordValue = fromMaybe "" (e L.^. Aws.Lightsail.Lens.domainEntry_target)
+          _dnsRecordPriority = Nothing
+          _dnsRecordPort = Nothing
+          _dnsRecordWeight = Nothing
+          _dnsRecordFlags = Nothing
+       in Types.DnsRecord
+            { _dnsRecordProvider = Types.ProviderAws
+            , _dnsRecordDomain = name
+            , ..
+            }
+
+
+-- 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
+--       , ..
+--       }
+
 -- * Data Definitions