diff options
author | Andrew Cady <d@jerkface.net> | 2016-04-08 22:56:26 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2016-04-08 22:56:26 -0400 |
commit | 4a56b2af54b27dc7ae366fc14207eb100d8784a5 (patch) | |
tree | 12d5a9b1a8e01ccc72bf7f2dadc4fad9e6f1b9ed | |
parent | a5da398526bc5c3bb2f4dade1235e458f3dab31c (diff) |
More refactoring
-rw-r--r-- | acme-certify.hs | 54 |
1 files changed, 38 insertions, 16 deletions
diff --git a/acme-certify.hs b/acme-certify.hs index 4fa16a0..951d290 100644 --- a/acme-certify.hs +++ b/acme-certify.hs | |||
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE FlexibleContexts #-} | 1 | {-# LANGUAGE FlexibleContexts #-} |
2 | {-# LANGUAGE NamedFieldPuns #-} | ||
2 | {-# LANGUAGE NoImplicitPrelude #-} | 3 | {-# LANGUAGE NoImplicitPrelude #-} |
3 | {-# LANGUAGE OverloadedStrings #-} | 4 | {-# LANGUAGE OverloadedStrings #-} |
4 | {-# LANGUAGE RecordWildCards #-} | 5 | {-# LANGUAGE RecordWildCards #-} |
@@ -12,9 +13,9 @@ | |||
12 | module Main where | 13 | module Main where |
13 | 14 | ||
14 | import BasePrelude | 15 | import BasePrelude |
15 | import Network.ACME (Keys (..), canProvision, certify, | 16 | import Network.ACME (Keys (..), WritableDir, canProvision, |
16 | ensureWritableDir, fileProvisioner, | 17 | certify, ensureWritableDir, |
17 | genReq, readKeys, (</>)) | 18 | fileProvisioner, genReq, readKeys, (</>)) |
18 | import Network.ACME.Issuer (letsEncryptX1CrossSigned) | 19 | import Network.ACME.Issuer (letsEncryptX1CrossSigned) |
19 | import Network.URI | 20 | import Network.URI |
20 | import OpenSSL | 21 | import OpenSSL |
@@ -55,6 +56,15 @@ data CmdOpts = CmdOpts { | |||
55 | optSkipProvisionCheck :: Bool | 56 | optSkipProvisionCheck :: Bool |
56 | } | 57 | } |
57 | 58 | ||
59 | data Provisioner = ProvisionDir WritableDir | ||
60 | |||
61 | data AcmeCertRequest = AcmeCertRequest { | ||
62 | acrDomains :: [(DomainName, Provisioner)], | ||
63 | acrSkipDH :: Bool, | ||
64 | acrCertificateDir :: FilePath, | ||
65 | acrUserKeys :: Keys | ||
66 | } | ||
67 | |||
58 | cmdopts :: Parser CmdOpts | 68 | cmdopts :: Parser CmdOpts |
59 | cmdopts = CmdOpts <$> strOption (long "key" <> metavar "FILE" <> | 69 | cmdopts = CmdOpts <$> strOption (long "key" <> metavar "FILE" <> |
60 | help "Filename of your private RSA key") | 70 | help "Filename of your private RSA key") |
@@ -102,10 +112,6 @@ go :: CmdOpts -> IO (Either String ()) | |||
102 | go CmdOpts { .. } = do | 112 | go CmdOpts { .. } = do |
103 | let terms = fromMaybe defaultTerms (join $ parseAbsoluteURI <$> optTerms) | 113 | let terms = fromMaybe defaultTerms (join $ parseAbsoluteURI <$> optTerms) |
104 | directoryUrl = if optStaging then stagingDirectoryUrl else liveDirectoryUrl | 114 | directoryUrl = if optStaging then stagingDirectoryUrl else liveDirectoryUrl |
105 | domainKeyFile = domainDir </> "rsa.key" | ||
106 | domainCombinedFile = domainDir </> "cert.combined.pem" | ||
107 | domainCertFile = domainDir </> "cert.pem" | ||
108 | domainDhFile = domainDir </> "dhparams.pem" | ||
109 | domainDir = fromMaybe (head optDomains) optDomainDir | 115 | domainDir = fromMaybe (head optDomains) optDomainDir |
110 | privKeyFile = optKeyFile | 116 | privKeyFile = optKeyFile |
111 | requestDomains = map domainName' optDomains | 117 | requestDomains = map domainName' optDomains |
@@ -118,29 +124,45 @@ go CmdOpts { .. } = do | |||
118 | challengeDir <- ensureWritableDir optChallengeDir "challenge directory" | 124 | challengeDir <- ensureWritableDir optChallengeDir "challenge directory" |
119 | void $ ensureWritableDir domainDir "domain directory" | 125 | void $ ensureWritableDir domainDir "domain directory" |
120 | 126 | ||
121 | Just domainKeys <- getOrCreateKeys domainKeyFile | ||
122 | Just keys <- getOrCreateKeys privKeyFile | 127 | Just keys <- getOrCreateKeys privKeyFile |
123 | 128 | ||
124 | unless optSkipProvisionCheck $ | 129 | unless optSkipProvisionCheck $ |
125 | forM_ requestDomains $ canProvision (const $ Just challengeDir) >=> | 130 | forM_ requestDomains $ canProvision (const $ Just challengeDir) >=> |
126 | (`unless` error "Error: cannot provision files to web server via challenge directory") | 131 | (`unless` error "Error: cannot provision files to web server via challenge directory") |
127 | 132 | ||
128 | certReq <- genReq domainKeys requestDomains | 133 | let req = AcmeCertRequest {..} |
134 | acrDomains = map (flip (,) (ProvisionDir challengeDir)) requestDomains | ||
135 | acrSkipDH = optSkipDH | ||
136 | acrUserKeys = keys | ||
137 | acrCertificateDir = domainDir | ||
138 | go' directoryUrl terms email issuerCert req | ||
139 | |||
140 | go' :: URI -> URI -> Maybe EmailAddress -> X509 -> AcmeCertRequest -> IO (Either String ()) | ||
141 | go' directoryUrl terms email issuerCert acr@AcmeCertRequest{..} = do | ||
142 | let domainKeyFile = acrCertificateDir </> "rsa.key" | ||
143 | let provision = fileProvisioner (fmap un . flip lookup acrDomains) | ||
144 | un (ProvisionDir w) = w | ||
129 | 145 | ||
130 | dh <- if optSkipDH then return Nothing else Just <$> getOrCreateDH domainDhFile | 146 | Just domainKeys <- getOrCreateKeys domainKeyFile |
147 | dh <- saveDhParams acr | ||
131 | 148 | ||
132 | let provision = fileProvisioner (const $ Just challengeDir) | 149 | certReq <- genReq domainKeys $ map fst acrDomains |
133 | certificate <- certify directoryUrl keys ((,) terms <$> email) provision certReq | 150 | certificate <- certify directoryUrl acrUserKeys ((,) terms <$> email) provision certReq |
151 | forM certificate $ saveCertificate issuerCert dh domainKeys acr | ||
134 | 152 | ||
135 | let save = saveCertificate issuerCert dh domainKeys domainCombinedFile domainCertFile | 153 | saveDhParams :: AcmeCertRequest -> IO (Maybe DHP) |
136 | mapM save certificate | 154 | saveDhParams AcmeCertRequest{acrSkipDH, acrCertificateDir} = do |
155 | let domainDhFile = acrCertificateDir </> "dhparams.pem" | ||
156 | if acrSkipDH then return Nothing else Just <$> getOrCreateDH domainDhFile | ||
137 | 157 | ||
138 | saveCertificate :: X509 -> Maybe DHP -> Keys -> FilePath -> FilePath -> X509 -> IO () | 158 | saveCertificate :: X509 -> Maybe DHP -> Keys -> AcmeCertRequest -> X509 -> IO () |
139 | saveCertificate issuerCert dh domainKeys domainCombinedFile domainCertFile = saveBoth | 159 | saveCertificate issuerCert dh domainKeys AcmeCertRequest{acrCertificateDir} = saveBoth |
140 | where | 160 | where |
141 | saveCombined = combinedCert issuerCert dh domainKeys >=> writeFile domainCombinedFile | 161 | saveCombined = combinedCert issuerCert dh domainKeys >=> writeFile domainCombinedFile |
142 | savePEM = writeX509 >=> writeFile domainCertFile | 162 | savePEM = writeX509 >=> writeFile domainCertFile |
143 | saveBoth x509 = savePEM x509 >> saveCombined x509 | 163 | saveBoth x509 = savePEM x509 >> saveCombined x509 |
164 | domainCombinedFile = acrCertificateDir </> "cert.combined.pem" | ||
165 | domainCertFile = acrCertificateDir </> "cert.pem" | ||
144 | 166 | ||
145 | genKey :: IO String | 167 | genKey :: IO String |
146 | genKey = withOpenSSL $ do | 168 | genKey = withOpenSSL $ do |