Generate RSA keys and CSRs using HsOpenSSL

Unfortunately, an external process is still needed to convert x509 CSRs
from PEM to DER.

2 files changed, 25 insertions, 10 deletions

diff --git a/acme-encrypt.cabal b/acme-encrypt.cabal
index 4d3aa44..66b80ec 100644
--- a/acme-encrypt.cabal
+++ b/acme-encrypt.cabal
@@ -24,7 +24,7 @@ executable acme-encrypt-exe
   build-depends:       base,
                        cryptonite, aeson, bytestring, base64-bytestring, SHA,
                        text, HsOpenSSL, process, wreq, lens, lens-aeson,
-                       optparse-applicative, directory, mtl
+                       optparse-applicative, directory, mtl, process-extras
                      -- , acme-encrypt
   default-language:    Haskell2010
 
diff --git a/acme.hs b/acme.hs
index 230bc27..a4751c2 100644
--- a/acme.hs
+++ b/acme.hs
@@ -41,10 +41,11 @@ import           OpenSSL.EVP.PKey
 import           OpenSSL.EVP.Sign
 import           OpenSSL.PEM
 import           OpenSSL.RSA
+import           OpenSSL.X509.Request
 import           Options.Applicative        hiding (header)
 import qualified Options.Applicative        as Opt
 import           System.Directory
-import           System.Process             (readProcess)
+import           System.Process.ByteString
 
 stagingDirectoryUrl, liveDirectoryUrl :: String
 liveDirectoryUrl = "https://acme-v01.api.letsencrypt.org/directory"
@@ -77,12 +78,24 @@ cmdopts = CmdOpts <$> strOption (long "key" <> metavar "FILE" <> help "filename
                   <*> switch (long "staging" <> help "use staging servers instead of live servers (certificates will not be real!)")
 
 genKey :: String -> IO ()
-genKey privKeyFile = void $ readProcess "openssl" (words "genrsa -out" ++ [privKeyFile, "4096"]) ""
-
-genReq :: String -> String -> String -> IO ()
-genReq privKeyFile domain out = void $ readProcess "openssl" (args privKeyFile domain out) ""
-  where
-    args k d o = words "req -new -sha256 -outform DER -key" ++ [k, "-subj", "/CN=" ++ d, "-out", o]
+genKey privKeyFile = withOpenSSL $ do
+    kp <- generateRSAKey' 4096 65537
+    pem <- writePKCS8PrivateKey kp Nothing
+    writeFile privKeyFile pem
+
+genReq :: FilePath -> String -> IO ByteString
+genReq domainKeyFile domain = withOpenSSL $ do
+  (Keys priv pub) <- readKeys domainKeyFile
+  Just dig <- getDigestByName "SHA256"
+  req <- newX509Req
+  setSubjectName req [("CN", domain)]
+  setVersion req 0
+  setPublicKey req pub
+  signX509Req req priv (Just dig)
+  pem <- writeX509Req req ReqNewFormat
+  -- Sigh.  No DER support for X509 reqs in HsOpenSSL.
+  (_, o, _) <- readProcessWithExitCode "openssl" (words "req -outform der") (encodeUtf8 $ T.pack pem)
+  return o
 
 data Keys = Keys SomeKeyPair RSAPubKey
 readKeys :: String -> IO Keys
@@ -108,11 +121,13 @@ go (CmdOpts privKeyFile domain challengeDir email termOverride staging) = do
 
   doesDirectoryExist domain >>= flip unless (createDirectory domain)
   doesFileExist domainKeyFile >>= flip unless (genKey domainKeyFile)
-  doesFileExist domainCSRFile >>= flip unless (genReq domainKeyFile domain domainCSRFile)
 
-  csrData <- B.readFile domainCSRFile
   keys <- readKeys privKeyFile
 
+  doesFileExist domainCSRFile >>= flip unless (genReq domainKeyFile domain >>= B.writeFile domainCSRFile)
+
+  csrData <- B.readFile domainCSRFile
+
   -- TODO: verify that challengeDir is writable before continuing.
 
   runACME directoryUrl keys $ do