stub parsing of yaml config file

2 files changed, 37 insertions, 14 deletions

diff --git a/acme-certify.cabal b/acme-certify.cabal
index 2cd61e9..22dcd20 100644
--- a/acme-certify.cabal
+++ b/acme-certify.cabal
@@ -28,7 +28,8 @@ executable acme
   build-depends:       base, base-prelude, acme-certify,
                        cryptonite, aeson, bytestring, base64-bytestring, SHA,
                        text, HsOpenSSL, optparse-applicative, time,
-                       email-validate, network-uri, directory, yaml-config
+                       email-validate, network-uri, directory, yaml-config,
+                       yaml, unordered-containers, lens, lens-aeson
   default-language:    Haskell2010
 
 -- test-suite acme-certify-test
diff --git a/acme-certify.hs b/acme-certify.hs
index fc44d77..48901c9 100644
--- a/acme-certify.hs
+++ b/acme-certify.hs
@@ -13,26 +13,31 @@
 module Main where
 
 import           BasePrelude
-import           Network.ACME         (HttpProvisioner, Keys (..),
-                                       canProvision, certify,
-                                       ensureWritableDir, provisionViaFile,
-                                       readKeys, (</>))
-import           Network.ACME.Issuer  (letsEncryptX1CrossSigned)
+import           Control.Lens              hiding ((&))
+import           Data.Aeson.Lens
+import qualified Data.HashMap.Strict       as HashMap
+import           Data.Text                 (unpack)
+import           Data.Yaml                 (Object)
+import qualified Data.Yaml.Config          as Config
+import           Data.Yaml.Config.Internal (Config (..))
+import           Network.ACME              (HttpProvisioner, Keys (..),
+                                            canProvision, certify,
+                                            ensureWritableDir, provisionViaFile,
+                                            readKeys, (</>))
+import           Network.ACME.Issuer       (letsEncryptX1CrossSigned)
 import           Network.URI
 import           OpenSSL
 import           OpenSSL.DH
 import           OpenSSL.PEM
 import           OpenSSL.RSA
-import           OpenSSL.X509         (X509)
-import           Options.Applicative  hiding (header)
-import qualified Options.Applicative  as Opt
+import           OpenSSL.X509              (X509)
+import           Options.Applicative       hiding (header)
+import qualified Options.Applicative       as Opt
 import           System.Directory
 import           System.IO
-import           Text.Domain.Validate hiding (validate)
+import           Text.Domain.Validate      hiding (validate)
 import           Text.Email.Validate
 
-import qualified Data.Yaml.Config     as Yaml
-
 stagingDirectoryUrl, liveDirectoryUrl, defaultTerms :: URI
 Just liveDirectoryUrl    = parseAbsoluteURI "https://acme-v01.api.letsencrypt.org/directory"
 Just stagingDirectoryUrl = parseAbsoluteURI "https://acme-staging.api.letsencrypt.org/directory"
@@ -135,9 +140,23 @@ certifyOpts = fmap Certify $
                                                          , "making ACME requests"
                                                          ]))
 
+-- lookup' :: (Monad m, FromJSON a) => Config.Key -> Config -> m a
+
+extractObject :: Config -> Object
+extractObject (Config _ o) = o
+
 runUpdate :: UpdateOpts -> IO ()
-runUpdate UpdateOpts{..} = do
-  error "test"
+runUpdate UpdateOpts { .. } = do
+  config <- Config.load "config.yaml"
+  hosts <- Config.subconfig "hosts" config
+  forM_ (Config.keys hosts) $ \host -> do
+    domains <- extractObject <$> (Config.subconfig host hosts >>= Config.subconfig "domains")
+    putStrLn $ unpack host ++ ": "
+    forM_ (HashMap.keys domains) $ \domain -> do
+      let subdomains = map (<..> unpack domain) $ sort $ concat $ HashMap.lookup domain domains & toListOf (_Just . _String . to (words . unpack))
+      putStrLn $ "  " ++ unwords subdomains
+      putStrLn ""
+  error "Error: unimplemented"
 
 runCertify :: CertifyOpts -> IO (Either String ())
 runCertify CertifyOpts{..} = do
@@ -232,3 +251,6 @@ otherwiseM :: Monad m => m Bool -> m () -> m ()
 a `otherwiseM` b = a >>= flip unless b
 infixl 0 `otherwiseM`
 
+(<..>) :: String -> String -> String
+"." <..> dom = dom
+sub <..> dom = sub ++ "." ++ dom