Move generation of CSR into `certify` function

2 files changed, 10 insertions, 8 deletions

diff --git a/acme-certify.hs b/acme-certify.hs
index c0116ea..0ac7a7b 100644
--- a/acme-certify.hs
+++ b/acme-certify.hs
@@ -140,13 +140,11 @@ go CmdOpts { .. } = do
 go' :: URI -> URI -> Maybe EmailAddress -> X509 -> AcmeCertRequest -> IO (Either String ())
 go' directoryUrl terms email issuerCert acr@AcmeCertRequest{..} = do
   let domainKeyFile = acrCertificateDir </> "rsa.key"
-  let provision     = dispatchProvisioner acrDomains
 
   Just domainKeys <- getOrCreateKeys domainKeyFile
   dh <- saveDhParams acr
 
-  certReq <- genReq domainKeys $ map fst acrDomains
-  certificate <- certify directoryUrl acrUserKeys ((,) terms <$> email) provision certReq
+  certificate <- certify directoryUrl acrUserKeys ((,) terms <$> email) domainKeys acrDomains
   forM certificate $ saveCertificate issuerCert dh domainKeys acr
 
 saveDhParams :: AcmeCertRequest -> IO (Maybe DHP)
diff --git a/src/Network/ACME.hs b/src/Network/ACME.hs
index 120248c..97e6e10 100644
--- a/src/Network/ACME.hs
+++ b/src/Network/ACME.hs
@@ -52,8 +52,12 @@ import           Text.Email.Validate
 
 -- The `certify` function
 
-certify :: URI -> Keys -> Maybe (URI, EmailAddress) -> DispatchHttpProvisioner -> CSR -> IO (Either String X509)
-certify directoryUrl keys reg provision certReq =
+certify :: URI -> Keys -> Maybe (URI, EmailAddress) -> Keys -> [(DomainName, HttpProvisioner)] -> IO (Either String X509)
+certify directoryUrl keys reg domainKeys domains = do
+
+  certReq <- genReq domainKeys $ map fst domains
+  let provision = dispatchProvisioner domains
+
   (mapM readDerX509 =<<) $ runACME directoryUrl keys $ do
     forM_ reg $ uncurry register >=> statusReport
 
@@ -64,7 +68,7 @@ certify directoryUrl keys reg provision certReq =
         cr dom = challengeRequest dom >>= statusReport >>= extractCR >>= performChallenge dom
 
     runResourceT $ do
-      challengeResultLinks <- forM (csrDomains certReq) cr
+      challengeResultLinks <- forM (map fst domains) cr
       lift . runExceptT $ do
         ExceptT $ pollResults challengeResultLinks <&> left ("certificate receipt was not attempted because a challenge failed: " ++)
         ExceptT $ retrieveCert certReq >>= statusReport <&> checkCertResponse
@@ -242,7 +246,7 @@ statusReport r = do
 
 -- OpenSSL operations
 
-data CSR = CSR { csrDomains :: [DomainName], csrData :: ByteString }
+data CSR = CSR { csrData :: ByteString }
 genReq :: Keys -> [DomainName] -> IO CSR
 genReq _ [] = error "genReq called with zero domains"
 genReq (Keys priv pub) domains@(domain:_) = withOpenSSL $ do
@@ -253,7 +257,7 @@ genReq (Keys priv pub) domains@(domain:_) = withOpenSSL $ do
   setPublicKey req pub
   void $ addExtensions req [(nidSubjectAltName, intercalate ", " (map (("DNS:" ++) . domainToString) domains))]
   signX509Req req priv (Just dig)
-  CSR domains . toStrict <$> writeX509ReqDER req
+  CSR . toStrict <$> writeX509ReqDER req
   where
     nidSubjectAltName = 85