From b8493e549fe472021a545b665e49fff779fb4241 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Fri, 8 Apr 2016 23:50:58 -0400
Subject: More renames/cleanup related to HttpProvisioner

---
 acme-certify.hs     | 12 ++++++------
 src/Network/ACME.hs | 36 +++++++++++++++++++-----------------
 2 files changed, 25 insertions(+), 23 deletions(-)

diff --git a/acme-certify.hs b/acme-certify.hs
index 84b7f85..c0116ea 100644
--- a/acme-certify.hs
+++ b/acme-certify.hs
@@ -13,9 +13,9 @@
 module Main where
 
 import           BasePrelude
-import           Network.ACME         (HttpProvisioner', Keys (..),
-                                       canProvision, certify,
-                                       dispatchProvisioner', ensureWritableDir,
+import           Network.ACME         (HttpProvisioner, Keys (..),
+                                       canProvisionDir, certify,
+                                       dispatchProvisioner, ensureWritableDir,
                                        genReq, provisionViaFile, readKeys,
                                        (</>))
 import           Network.ACME.Issuer  (letsEncryptX1CrossSigned)
@@ -59,7 +59,7 @@ data CmdOpts = CmdOpts {
 }
 
 data AcmeCertRequest = AcmeCertRequest {
-      acrDomains        :: [(DomainName, HttpProvisioner')],
+      acrDomains        :: [(DomainName, HttpProvisioner)],
       acrSkipDH         :: Bool,
       acrCertificateDir :: FilePath,
       acrUserKeys       :: Keys
@@ -127,7 +127,7 @@ go CmdOpts { .. } = do
   Just keys <- getOrCreateKeys privKeyFile
 
   unless optSkipProvisionCheck $
-    forM_ requestDomains $ canProvision (const $ Just challengeDir) >=>
+    forM_ requestDomains $ canProvisionDir challengeDir >=>
       (`unless` error "Error: cannot provision files to web server via challenge directory")
 
   let req = AcmeCertRequest {..}
@@ -140,7 +140,7 @@ 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
+  let provision     = dispatchProvisioner acrDomains
 
   Just domainKeys <- getOrCreateKeys domainKeyFile
   dh <- saveDhParams acr
diff --git a/src/Network/ACME.hs b/src/Network/ACME.hs
index c7e1535..120248c 100644
--- a/src/Network/ACME.hs
+++ b/src/Network/ACME.hs
@@ -52,7 +52,7 @@ import           Text.Email.Validate
 
 -- The `certify` function
 
-certify :: URI -> Keys -> Maybe (URI, EmailAddress) -> HttpProvisioner -> CSR -> IO (Either String X509)
+certify :: URI -> Keys -> Maybe (URI, EmailAddress) -> DispatchHttpProvisioner -> CSR -> IO (Either String X509)
 certify directoryUrl keys reg provision certReq =
   (mapM readDerX509 =<<) $ runACME directoryUrl keys $ do
     forM_ reg $ uncurry register >=> statusReport
@@ -84,21 +84,21 @@ pollResults (link:links) = do
 
 -- Provisioner callback
 
-type HttpProvisioner = DomainName -> ByteString -> ByteString -> ResIO ()
-fileProvisioner :: (DomainName -> Maybe WritableDir) -> HttpProvisioner
-fileProvisioner challengeDir (challengeDir -> Just dir) tok thumbtoken = provisionViaFile dir tok thumbtoken
-fileProvisioner _ dom _ _ = liftIO $ fail $ "fileProvisioner: no writable directory for domain: " ++ show dom
+type DispatchHttpProvisioner = DomainName -> ByteString -> ByteString -> ResIO ()
+fileProvisioner :: WritableDir -> DispatchHttpProvisioner
+fileProvisioner challengeDir _ = provisionViaFile challengeDir
 
-type HttpProvisioner' = ByteString -> ByteString -> ResIO ()
-dispatchProvisioner :: (DomainName -> Maybe HttpProvisioner') -> HttpProvisioner
-dispatchProvisioner dispatch (dispatch -> Just provision) = provision
-dispatchProvisioner _ dom = const . const . liftIO $ fail errmsg
-  where errmsg = "No means specified to provision files over HTTP for domain: " ++ show dom
+type HttpProvisioner = ByteString -> ByteString -> ResIO ()
 
-dispatchProvisioner' :: [(DomainName, HttpProvisioner')] -> HttpProvisioner
-dispatchProvisioner' xs = dispatchProvisioner (`lookup` xs)
+dispatchProvisioner :: [(DomainName, HttpProvisioner)] -> DispatchHttpProvisioner
+dispatchProvisioner xs = dispatch (`lookup` xs)
+  where
+    dispatch :: (DomainName -> Maybe HttpProvisioner) -> DispatchHttpProvisioner
+    dispatch dispatchFunc (dispatchFunc -> Just provision) = provision
+    dispatch _ dom = const . const . liftIO $ fail errmsg
+      where errmsg = "No means specified to provision files over HTTP for domain: " ++ show dom
 
-provisionViaFile :: WritableDir -> HttpProvisioner'
+provisionViaFile :: WritableDir -> HttpProvisioner
 provisionViaFile dir tok thumbtoken = do
   void $ allocate (return f) removeFile
   liftIO $ BC.writeFile f thumbtoken
@@ -113,15 +113,17 @@ ensureWritableDir file name = do
   return $ WritableDir file
   where e n = error $ "Error: " ++ n ++ " is not writable"
 
-canProvision :: (DomainName -> Maybe WritableDir) -> DomainName -> IO Bool
-canProvision challengeDir domain = do
+canProvision :: DomainName -> HttpProvisioner -> IO Bool
+canProvision domain provision = do
   token <- (".test." ++) . show <$> getPOSIXTime
-
   r <- runResourceT $ do
-         fileProvisioner challengeDir domain (fromString token) (fromString token)
+         provision (fromString token) (fromString token)
          liftIO $ W.get $ show $ acmeChallengeURI domain (fromString token)
   return $ r ^. responseBody == fromString token
 
+canProvisionDir :: WritableDir -> DomainName -> IO Bool
+canProvisionDir challengeDir domain = canProvision domain (provisionViaFile challengeDir)
+
 -- The ACME monad
 
 data Directory = Directory {
-- 
cgit v1.2.3