From 7373a3ede2216048d2766f8f27e77d014b82dc43 Mon Sep 17 00:00:00 2001
From: Andrew Cady <d@jerkface.net>
Date: Tue, 26 Jan 2016 03:17:47 -0500
Subject: use Control.Error

---
 src/Network/ACME.hs | 33 ++++++++++++++++++---------------
 1 file changed, 18 insertions(+), 15 deletions(-)

(limited to 'src')

diff --git a/src/Network/ACME.hs b/src/Network/ACME.hs
index b05b823..e08d5b9 100644
--- a/src/Network/ACME.hs
+++ b/src/Network/ACME.hs
@@ -41,6 +41,8 @@ import           OpenSSL.RSA
 import           OpenSSL.X509.Request
 import           OpenSSL.X509 (readDerX509, X509)
 import Data.List
+import Control.Error
+import Control.Arrow
 
 type HttpProvisioner = URI -> ByteString -> IO ()
 
@@ -73,23 +75,24 @@ acmeChallengeURI dom tok = URI
                              ""
 
 certify :: URI -> Keys -> Maybe (URI, EmailAddress) -> HttpProvisioner -> CSR -> IO (Either String X509)
-certify directoryUrl keys reg provision certReq = run >>= traverse readDerX509
+certify directoryUrl keys reg provision certReq =
 
-  where
-    run =
-      runACME directoryUrl keys $ do
-        forM_ reg $ uncurry register >=> statusReport
+  (mapM readDerX509 =<<) $ runACME directoryUrl keys $ do
+
+    forM_ reg $ uncurry register >=> statusReport
 
-        let performChallenge domain (ChallengeRequest nextUri token thumbtoken) = do
-              liftIO $ provision (acmeChallengeURI domain token) thumbtoken
-              notifyChallenge nextUri thumbtoken >>= statusReport >>= ncErrorReport
+    let performChallenge domain (ChallengeRequest nextUri token thumbtoken) = do
+          liftIO $ provision (acmeChallengeURI domain token) thumbtoken
+          notifyChallenge nextUri thumbtoken >>= statusReport >>= ncErrorReport
 
-        challengeResultLinks <- forM (csrDomains certReq) $ \dom ->
-          challengeRequest dom >>= statusReport >>= extractCR >>= performChallenge dom
+    challengeResultLinks <- forM (csrDomains certReq) $ \dom -> challengeRequest dom >>=
+                                                                statusReport >>=
+                                                                extractCR >>=
+                                                                performChallenge dom
 
-        pollResults challengeResultLinks >>=
-          either (return . Left . ("certificate receipt was not attempted because a challenge failed: " ++))
-                 (const (retrieveCert certReq >>= statusReport <&> checkCertResponse))
+    runExceptT $ do
+      ExceptT $ pollResults challengeResultLinks <&> left ("certificate receipt was not attempted because a challenge failed: " ++)
+      ExceptT $ retrieveCert certReq >>= statusReport <&> checkCertResponse
 
 pollResults :: [Response LC.ByteString] -> ACME (Either String ())
 pollResults [] = return $ Right ()
@@ -111,9 +114,9 @@ data CSR = CSR { csrDomains :: [DomainName], csrData :: ByteString }
 newtype WritableDir = WritableDir String
 ensureWritableDir :: FilePath -> String -> IO WritableDir
 ensureWritableDir file name = do
-  (writable <$> getPermissions file) >>= flip unless (err name)
+  (writable <$> getPermissions file) >>= flip unless (e name)
   return $ WritableDir file
-  where err n = error $ "Error: " ++ n ++ " is not writable"
+  where e n = error $ "Error: " ++ n ++ " is not writable"
 
 (</>) :: String -> String -> String
 a </> b = a ++ "/" ++ b
-- 
cgit v1.2.3