From 685a14d8ab5e92b57fce1e997978bd6607c2aac1 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Wed, 20 Jan 2016 08:41:10 -0500
Subject: Fetch directory urls along with nonce

---
 acme-encrypt.cabal |  2 +-
 acme.hs            | 24 +++++++++++++++++++++++-
 2 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/acme-encrypt.cabal b/acme-encrypt.cabal
index 824b09d..45cb9de 100644
--- a/acme-encrypt.cabal
+++ b/acme-encrypt.cabal
@@ -23,7 +23,7 @@ executable acme-encrypt-exe
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall
   build-depends:       base,
                        cryptonite, aeson, bytestring, base64-bytestring, SHA,
-                       text, HsOpenSSL, process, wreq, lens
+                       text, HsOpenSSL, process, wreq, lens, lens-aeson
                      -- , acme-encrypt
   default-language:    Haskell2010
 
diff --git a/acme.hs b/acme.hs
index f8e92e3..b755f19 100644
--- a/acme.hs
+++ b/acme.hs
@@ -24,7 +24,11 @@ import OpenSSL.RSA
 import System.Process (readProcess)
 import Network.Wreq hiding (header)
 import Control.Lens hiding ((.=))
+import Data.Aeson.Lens hiding (key)
+import qualified Data.Aeson.Lens as JSON
 
+directoryUrl :: String
+directoryUrl =  "https://acme-v01.api.letsencrypt.org/directory"
 
 main :: IO ()
 main = do
@@ -33,7 +37,7 @@ main = do
     Nothing -> error "Not a public RSA key."
     Just (userKey :: RSAPubKey) -> do
 
-      nonce_ <- view (responseHeader "Replay-Nonce" . to (T.unpack . decodeUtf8)) <$> get "https://acme-v01.api.letsencrypt.org/directory"
+      Just nonce_ <- getNonce
 
       let protected = b64 (header userKey nonce_)
 
@@ -72,6 +76,24 @@ main = do
     terms :: String
     terms = "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf"
 
+data Directory = Directory {
+  _newCert :: String,
+  _newAuthz :: String,
+  _revokeCert :: String,
+  _newReg :: String,
+  _nonce :: String
+}
+
+getDirectory :: String -> IO (Maybe Directory)
+getDirectory url = do
+  r <- get url
+  let nonce = r ^? responseHeader "Replay-Nonce" . to (T.unpack . decodeUtf8)
+      k x   = r ^? responseBody . JSON.key x . _String . to T.unpack
+  return $ Directory <$> k "new-cert" <*> k "new-authz" <*> k "revoke-cert" <*> k "new-reg" <*> nonce
+
+getNonce :: IO (Maybe String)
+getNonce = fmap _nonce <$> getDirectory directoryUrl
+
 --------------------------------------------------------------------------------
 -- | Sign and write a payload to a file with a nonce-protected header.
 signPayload :: RSAKey k => String -> k -> ByteString -> ByteString -> IO ()
-- 
cgit v1.2.3