use Control.Error

2 files changed, 19 insertions, 16 deletions

diff --git a/acme-certify.cabal b/acme-certify.cabal
index 60bf41a..b9e9818 100644
--- a/acme-certify.cabal
+++ b/acme-certify.cabal
@@ -17,7 +17,7 @@ library
   build-depends:       base >= 4.7 && < 5,
                        cryptonite, aeson, bytestring, base64-bytestring, SHA,
                        mtl, text, HsOpenSSL, wreq, lens, lens-aeson, time,
-                       email-validate, pipes, directory, network-uri
+                       email-validate, pipes, directory, network-uri, errors
   default-language:    Haskell2010
 
 executable acme-certify
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