1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
|
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
--------------------------------------------------------------------------------
-- | Get a certificate from Let's Encrypt using the ACME protocol.
--
-- https://github.com/ietf-wg-acme/acme/blob/master/draft-ietf-acme-acme.md
module Main where
import BasePrelude
import qualified Data.ByteString.Lazy.Char8 as LC
import Network.ACME (canProvision, certify, fileProvisioner, ensureWritableDir, (</>), genReq)
import Network.ACME.Encoding (Keys (..), readKeys)
import Network.URI
import OpenSSL
import OpenSSL.X509 (X509)
import OpenSSL.DH
import OpenSSL.PEM
import OpenSSL.RSA
import Options.Applicative hiding (header)
import qualified Options.Applicative as Opt
import System.Directory
import Text.Domain.Validate hiding (validate)
import Text.Email.Validate
import System.IO
stagingDirectoryUrl, liveDirectoryUrl :: URI
Just liveDirectoryUrl = parseAbsoluteURI "https://acme-v01.api.letsencrypt.org/directory"
Just stagingDirectoryUrl = parseAbsoluteURI "https://acme-staging.api.letsencrypt.org/directory"
main :: IO ()
main = execParser opts >>= go
where
opts = info (helper <*> cmdopts) (fullDesc <> progDesc detailedDescription <> Opt.header "Let's Encrypt! ACME client")
detailedDescription = unwords
[ "This program will generate a signed TLS certificate"
, "using the ACME protocol and the free Let's Encrypt! CA."
]
data CmdOpts = CmdOpts {
optKeyFile :: String,
optDomains :: [String],
optChallengeDir :: String,
optDomainDir :: Maybe String,
optEmail :: Maybe String,
optTerms :: Maybe String,
optStaging :: Bool
}
defaultTerms :: URI
Just defaultTerms = parseAbsoluteURI "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf"
cmdopts :: Parser CmdOpts
cmdopts = CmdOpts <$> strOption (long "key" <> metavar "FILE" <>
help "filename of your private RSA key")
<*> some
(strOption
(long "domain" <>
metavar "DOMAIN" <>
help
(unwords
[ "the domain name(s) to certify;"
, "specify more than once for a multi-domain certificate"
])))
<*> strOption (long "challenge-dir" <> metavar "DIR" <>
help "output directory for ACME challenges")
<*> optional
(strOption
(long "domain-dir" <>
metavar "DIR" <>
help
(unwords
[ "directory in which to domain certificates and keys are stored;"
, "the default is to use the (first) domain name as a directory name"
])))
<*> optional
(strOption (long "email" <> metavar "ADDRESS" <>
help "an email address with which to register an account"))
<*> optional (strOption (long "terms" <> metavar "URL" <>
help "the terms param of the registration request"))
<*> switch
(long "staging" <> help
(unwords
[ "use staging servers instead of live servers"
, "(generated certificates will not be trusted!)"
]))
genKey :: FilePath -> IO String
genKey privKeyFile = withOpenSSL $ do
kp <- generateRSAKey' 4096 65537
pem <- writePKCS8PrivateKey kp Nothing
writeFile privKeyFile pem
return pem
getOrCreateKeys :: FilePath -> IO (Maybe Keys)
getOrCreateKeys file = do
exists <- doesFileExist file
readKeys =<< if exists then readFile file else genKey file
go :: CmdOpts -> IO ()
go CmdOpts { .. } = do
let terms = fromMaybe defaultTerms (join $ parseAbsoluteURI <$> optTerms)
directoryUrl = if optStaging then stagingDirectoryUrl else liveDirectoryUrl
domainKeyFile = domainDir </> "rsa.key"
domainCertFile = domainDir </> "cert.der"
domainDir = fromMaybe (head optDomains) optDomainDir
privKeyFile = optKeyFile
requestDomains = fromMaybe (error "invalid domain name") $ sequence $ domainName . fromString <$> optDomains
doesDirectoryExist domainDir `otherwiseM` createDirectory domainDir
Just domainKeys <- getOrCreateKeys domainKeyFile
Just keys <- getOrCreateKeys privKeyFile
challengeDir <- ensureWritableDir optChallengeDir "challenge directory"
void $ ensureWritableDir domainDir "domain directory"
let skipProvisionCheck = True
unless skipProvisionCheck $
forM_ requestDomains $ canProvision challengeDir >=>
(`unless` error "Error: cannot provision files to web server via challenge directory")
certReq <- genReq domainKeys requestDomains
let email = either (error . ("Error: invalid email address: " ++)) id . validate . fromString <$> optEmail
let issuerCertFile = "lets-encrypt-x1-cross-signed.pem"
issuerCert <- readFile issuerCertFile >>= readX509
hSetBuffering stdout NoBuffering
putStr "Generating DH Params..."
dh <- genDHParams DHGen2 2048
putStrLn " Done."
certificate <- certify directoryUrl keys ((,) terms <$> email) (fileProvisioner challengeDir) certReq
either (error . ("Error: " ++))
(combinedCert issuerCert (Just dh) domainKeys >=> writeFile domainCertFile)
certificate
combinedCert :: X509 -> Maybe DHP -> Keys -> X509 -> IO String
combinedCert issuerCert dh (Keys privKey _) cert = do
dhStr <- mapM writeDHParams dh
certStr <- writeX509 cert
privKeyStr <- writePKCS8PrivateKey privKey Nothing
issuerCertStr <- writeX509 issuerCert
return $ concat [certStr, issuerCertStr, privKeyStr, fromMaybe "" dhStr]
otherwiseM :: Monad m => m Bool -> m () -> m ()
a `otherwiseM` b = a >>= flip unless b
infixl 0 `otherwiseM`
|