├── .gitignore
├── LICENSE
├── README.md
├── acme.hs
├── build.sh
├── generate-csr.sh
├── generate-haproxy-cert.sh
├── ghci.conf
├── ghcid.sh
├── lets-encrypt-x1-cross-signed.pem
└── lets-encrypt-x3-cross-signed.pem


/.gitignore:
--------------------------------------------------------------------------------
1 | acme
2 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright Hypered SPRL, 2016-2017.
 2 | 
 3 | All rights reserved.
 4 | 
 5 | Redistribution and use in source and binary forms, with or without
 6 | modification, are permitted provided that the following conditions
 7 | are met:
 8 | 
 9 | 1. Redistributions of source code must retain the above copyright
10 |    notice, this list of conditions and the following disclaimer.
11 | 
12 | 2. Redistributions in binary form must reproduce the above copyright
13 |    notice, this list of conditions and the following disclaimer in the
14 |    documentation and/or other materials provided with the distribution.
15 | 
16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
17 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
18 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
19 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
20 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
21 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
22 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
23 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
24 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
25 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
26 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # Let's Encrypt ACME protocol
  2 | 
  3 | This is a simple Haskell script to obtain a certificate from [Let's
  4 | Encrypt](https://letsencrypt.org/) using their ACME protocol.
  5 | 
  6 | 
  7 | - The main source of information to write this was
  8 |   https://github.com/diafygi/letsencrypt-nosudo
  9 | 
 10 | - The ACME spec: https://letsencrypt.github.io/acme-spec/
 11 | 
 12 | There is a more featureful fork of thisrepository at
 13 | [afcady/acme](https://github.com/afcady/acme).
 14 | 
 15 | 
 16 | ## Discover the URL for letsencrypt ACME endpoints
 17 | 
 18 | API endpoints are listed at https://acme-v01.api.letsencrypt.org/directory and
 19 | are currently hard-coded in the script.
 20 | 
 21 | ```
 22 | > curl -s https://acme-v01.api.letsencrypt.org/directory | json_pp
 23 | {
 24 |    "new-cert" : "https://acme-v01.api.letsencrypt.org/acme/new-cert",
 25 |    "new-authz" : "https://acme-v01.api.letsencrypt.org/acme/new-authz",
 26 |    "revoke-cert" : "https://acme-v01.api.letsencrypt.org/acme/revoke-cert",
 27 |    "new-reg" : "https://acme-v01.api.letsencrypt.org/acme/new-reg"
 28 | }
 29 | ```
 30 | 
 31 | 
 32 | ## Generate user account keys
 33 | 
 34 | You need an account with Let's Encrypt to ask and receive certificates for your
 35 | domains. The account is controlled by a public/private key pair:
 36 | 
 37 | ```
 38 | openssl genrsa 4096 > user.key
 39 | openssl rsa -in user.key -pubout > user.pub
 40 | ```
 41 | 
 42 | 
 43 | ## Create user account
 44 | 
 45 | Generate `registration.body` by using the `acme.hs` script then POST it to
 46 | letsencrypt (note it assumes you agree to their subscriber agreement):
 47 | 
 48 | ```
 49 | > curl -s -X POST --data-binary "@<domain>/registration.body" \
 50 |   https://acme-v01.api.letsencrypt.org/acme/new-reg | json_pp
 51 | {
 52 |    "agreement" : "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf",
 53 |    "contact" : [
 54 |       "mailto:noteed@gmail.com"
 55 |    ],
 56 |    "key" : {
 57 |       "e" : "...",
 58 |       "kty" : "RSA",
 59 |       "n" : "..."
 60 |    },
 61 |    "id" : 36009,
 62 |    "createdAt" : "2015-12-04T14:22:08.321951547Z",
 63 |    "initialIp" : "80.236.245.73"
 64 | }
 65 | ```
 66 | 
 67 | 
 68 | ## Request a challenge
 69 | 
 70 | 
 71 | Let's Encrypt needs a proof that you control the claimed domain. You can
 72 | request a challenge with `challenge-request.body`.
 73 | 
 74 | ```
 75 | > curl -s -X POST --data-binary "@<domain>/challenge-request.body" \
 76 |   https://acme-v01.api.letsencrypt.org/acme/new-authz | json_pp
 77 | {
 78 |    "expires" : "2015-12-21T18:44:52.331487674Z",
 79 |    "challenges" : [
 80 |       {
 81 |          "status" : "pending",
 82 |          "uri" : "https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844047",
 83 |          "type" : "tls-sni-01",
 84 |          "token" : "oielAbB7MdyCl29mqjzlqGdrCQSB8SyJaxHbAgQBA7Q"
 85 |       },
 86 |       {
 87 |          "uri" : "https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844048",
 88 |          "status" : "pending",
 89 |          "type" : "http-01",
 90 |          "token" : "DjyJpI3HVWAmsAwMT5ZFpW8dj19cel6ml6qaBUeGpCg"
 91 |       }
 92 |    ],
 93 |    "identifier" : {
 94 |       "type" : "dns",
 95 |       "value" : "aaa.reesd.com"
 96 |    },
 97 |    "combinations" : [
 98 |       [
 99 |          0
100 |       ],
101 |       [
102 |          1
103 |       ]
104 |    ],
105 |    "status" : "pending"
106 | }
107 | ```
108 | 
109 | The script assumes you'll answer the challenge by hosting a file at a location
110 | chosen by Let's Encrypt. Extract the token for the `http-01` challenge and run
111 | the script again. Now you have to host the file at the location reported by the
112 | script.
113 | 
114 | Once this is done, you can ask Let's Encrypt to check the file.
115 | 
116 | ```
117 | > curl -s -X POST --data-binary "@<domain>/challenge-response.body" \
118 |   https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844048 | json_pp
119 | {
120 |    "token" : "DjyJpI3HVWAmsAwMT5ZFpW8dj19cel6ml6qaBUeGpCg",
121 |    "keyAuthorization" : "DjyJpI3HVWAmsAwMT5ZFpW8dj19cel6ml6qaBUeGpCg.EJe0KReqzCUq6leNOerMC9naZSHxP9TJzGxCcsGkNrw",
122 |    "type" : "http-01",
123 |    "uri" : "https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844048",
124 |    "status" : "pending"
125 | }
126 | ```
127 | 
128 | The same URL can then be polled until the status becomes valid.
129 | 
130 | 
131 | ## Send CSR / Receive certificate
132 | 
133 | The CSR is created with:
134 | 
135 | ```
136 | > ./generate-csr.sh example.com
137 | ```
138 | 
139 | And the signed certificate can be obtained from Let's Encrypt:
140 | 
141 | ```
142 | > curl -s -X POST --data-binary "@<domain>/csr-request.body" \
143 |   https://acme-v01.api.letsencrypt.org/acme/new-cert > <domain>/cert.der
144 | ```
145 | 
146 | 
147 | ## Create a certificate for HAProxy
148 | 
149 | Including explicit DH key exchange parameters to prevent Logjam attack
150 | (https://weakdh.org/). See the script below.
151 | 
152 | ```
153 | > openssl x509 -inform der -in aaa.reesd.com.cert.der \
154 |     -out aaa.reesd.com.cert.pem
155 | > openssl dhparam -out aaa.reesd.com-dhparams.pem 2048
156 | > cat aaa.reesd.com.cert.pem \
157 |     lets-encrypt-x1-cross-signed.pem \
158 |     aaa.reesd.com.key \
159 |     aaa.reesd.com-dhparams.pem > aaa.reesd.com-combined.pem
160 | ```
161 | 
162 | 
163 | ## Using the script `acme.hs`
164 | 
165 | The example assumes you want to get a certificate for aaa.example.com.
166 | 
167 | The first step is to ensure you can serve files at
168 | `http://aaa.example.com/.well-known/acme-challenge/`. To do so create a local
169 | directory called `aaa.example.com` containing a script called `serve.sh`. The
170 | script content is up to you and will be called by `acme.hs` to upload files to
171 | be server at the abore URL. A possible content could be:
172 | 
173 | ```
174 | > cat aaa.exampe.com/serve.sh
175 | #! /bin/bash
176 | 
177 | scp $1 aaa.example.com:acme/static/.well-known/acme-challenge/$2
178 | ```
179 | 
180 | Second step is to generate a server private key and a CSR:
181 | 
182 | ```
183 | > ./generate-csr.sh aaa.example.com
184 | ```
185 | 
186 | Third step to is to actually using `acme.hs`:
187 | 
188 | ```
189 | > ./acme aaa.example.com
190 | ```
191 | 
192 | Fourth step is to use the certificate. For HAproxy, a script is given to help
193 | generate the appropriate file:
194 | 
195 | ```
196 | > ./generate-haproxy-cert.sh aaa.example.com
197 | ```
198 | 


--------------------------------------------------------------------------------
/acme.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE OverloadedStrings #-}
  2 | {-# LANGUAGE RecordWildCards #-}
  3 | {-# LANGUAGE ScopedTypeVariables #-}
  4 | 
  5 | --------------------------------------------------------------------------------
  6 | -- | Get a certificate from Let's Encrypt using the ACME protocol.
  7 | 
  8 | module Main where
  9 | 
 10 | import Control.Concurrent (threadDelay)
 11 | import Control.Monad (mzero)
 12 | import Crypto.Number.Serialize (i2osp)
 13 | import Data.ByteString.Builder (byteString)
 14 | import Data.Aeson (encode, object, FromJSON(..), ToJSON(..), Value(Object), (.=), (.:), (.:?))
 15 | import Data.ByteString (ByteString)
 16 | import qualified Data.ByteString as B
 17 | import qualified Data.ByteString.Char8 as BC
 18 | import qualified Data.ByteString.Lazy.Char8 as LC
 19 | import qualified Data.ByteString.Lazy as LB
 20 | import qualified Data.ByteString.Base64.URL as Base64
 21 | import Data.Digest.Pure.SHA (bytestringDigest, sha256)
 22 | import Data.Text.Encoding (decodeUtf8)
 23 | import Network.Http.Client
 24 |   ( baselineContextSSL, buildRequest, concatHandler, get, getHeader, http
 25 |   , jsonHandler, openConnectionSSL, receiveResponse, sendRequest
 26 |   , setContentLength, setContentType, Method(POST))
 27 | import OpenSSL.EVP.PKey
 28 | import OpenSSL.PEM (readPublicKey)
 29 | import OpenSSL.RSA
 30 | import System.Environment (getArgs)
 31 | import System.IO.Streams (connect)
 32 | import qualified System.IO.Streams as Streams
 33 | import System.IO.Streams.Builder (builderStream)
 34 | import System.IO.Streams.File (withFileAsInput)
 35 | import System.Process (readProcess)
 36 | 
 37 | 
 38 | --------------------------------------------------------------------------------
 39 | email :: String
 40 | email = "noteed@gmail.com"
 41 | 
 42 | terms :: String
 43 | terms = "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf"
 44 | 
 45 | server :: ByteString
 46 | -- server = "acme-staging.api.letsencrypt.org"
 47 | server = "acme-v01.api.letsencrypt.org"
 48 | 
 49 | --------------------------------------------------------------------------------
 50 | main :: IO ()
 51 | main = do
 52 |   [domain] <- getArgs
 53 |   userKey_ <- readFile "user.pub" >>= readPublicKey
 54 |   case toPublicKey userKey_ of
 55 |     Nothing -> error "Not a public RSA key."
 56 |     Just (userKey :: RSAPubKey) -> do
 57 | 
 58 |       -- Create user account
 59 |       putStrLn "Creating user account..."
 60 |       signPayload (domain ++ "/registration") userKey (registration email)
 61 |       r <- postBody domain "registration" "/acme/new-reg"
 62 |       case sStatus r of
 63 |         409 ->
 64 |           -- Ignored, as this means "Registration key is already in use".
 65 |           return ()
 66 |         _ ->
 67 |           -- TODO See later what onther values can be returned.
 68 |           print r
 69 | 
 70 |       -- Obtain a challenge
 71 |       putStrLn "Obtaining challenge values..."
 72 |       signPayload (domain ++ "/challenge-request") userKey (authz domain)
 73 |       cr <- postBody domain "challenge-request" "/acme/new-authz"
 74 | 
 75 |       -- Answser the challenge
 76 |       let thumb = thumbprint (JWK (rsaE userKey) "RSA" (rsaN userKey))
 77 |           http01_ = http01 cr
 78 |           token = (BC.pack . rToken) http01_
 79 |           thumbtoken = LB.fromChunks [token, ".", thumb]
 80 | 
 81 |       LB.writeFile (domain ++ "/content.txt") thumbtoken
 82 |       putStrLn ("Exposing challenge values using " ++ domain ++ "/serve.sh...")
 83 |       serveThumbprint domain token
 84 | 
 85 |       -- Notify Let's Encrypt we answsered the challenge
 86 |       signPayload (domain ++ "/challenge-response") userKey
 87 |         (challenge thumbtoken)
 88 |       (_ :: Value) <- postBody domain "challenge-response"
 89 |         (BC.pack (rUri http01_))
 90 | 
 91 |       -- Wait for challenge validation
 92 |       putStrLn "Waiting for validation..."
 93 |       let loop = do
 94 |             threadDelay (1 * 1000 * 1000)
 95 |             x <- get (BC.pack (rUri http01_)) jsonHandler
 96 |             if rStatus x == "valid" then return () else loop
 97 |       loop
 98 | 
 99 |       -- Send a CSR and get a certificate
100 |       putStrLn "Requesting certificate..."
101 |       csr_ <- B.readFile (domain ++ "/domain.der")
102 |       signPayload (domain ++ "/csr-request") userKey (csr csr_)
103 |       -- TODO Handle
104 |       --   "type": "urn:acme:error:rateLimited",
105 |       --   "detail": "Error creating new cert :: Too many certificates
106 |       --              already issued for exact set of domains: xxxxxx",
107 |       --   "status": 429
108 |       content <- postBody' domain "csr-request" "/acme/new-cert"
109 |       B.writeFile (domain ++ "/domain.cert.der") content
110 |       putStrLn ("Certificate written to " ++ domain ++ "/domain.cert.der")
111 | 
112 | 
113 | --------------------------------------------------------------------------------
114 | -- | Sign and write a payload to a file with a nonce-protected header.
115 | signPayload name key payload = do
116 |   nonce_ <- nonce
117 |   let protected = b64 (header key nonce_)
118 |   writePayload name protected payload
119 |   sig <- sign name
120 |   writeBody name key protected payload sig
121 | 
122 | -- | Write a payload to file with a nonce-protected header.
123 | writePayload name protected payload =
124 |   LB.writeFile (name ++ ".txt") (LB.fromChunks [protected, ".", payload])
125 | 
126 | -- | Sign a payload file using the user key.
127 | sign name = do
128 |   sign_ (name ++ ".txt") (name ++ ".sig")
129 |   sig_ <- B.readFile (name ++ ".sig")
130 |   return (b64 sig_)
131 | 
132 | sign_ inp out = do
133 |   _ <- readProcess "openssl"
134 |     [ "dgst", "-sha256"
135 |     , "-sign", "user.key"
136 |     , "-out", out
137 |     , inp
138 |     ]
139 |     ""
140 |   return ()
141 | 
142 | -- | Write a signed payload to a file. It can be used as the body of a POST
143 | -- request.
144 | writeBody name key protected payload sig = LB.writeFile (name ++ ".body")
145 |   (encode (Request (header' key) protected payload sig))
146 | 
147 | serveThumbprint domain token = do
148 |   _ <- readProcess (domain ++ "/serve.sh")
149 |     [ domain ++ "/content.txt"
150 |     , BC.unpack token
151 |     ]
152 |     ""
153 |   return ()
154 | 
155 | postBody domain name url = do
156 |   c <- postBody_ domain name url
157 |   x <- receiveResponse c jsonHandler
158 |   print x
159 |   return x
160 | 
161 | postBody' domain name url = do
162 |   c <- postBody_ domain name url
163 |   x <- receiveResponse c concatHandler
164 |   print x
165 |   return x
166 | 
167 | postBody_ domain name url = do
168 |   content <- B.readFile (domain ++ "/" ++ name ++ ".body")
169 |   ctx <- baselineContextSSL
170 |   c <- openConnectionSSL ctx server 443
171 |   q <- buildRequest $ do
172 |     http POST url
173 |     setContentType "application/json"
174 |     setContentLength (fromIntegral (B.length content))
175 |   sendRequest c q
176 |     (\o -> Streams.write (Just (byteString content)) o
177 |     >> Streams.write Nothing o)
178 |   return c
179 | 
180 | --------------------------------------------------------------------------------
181 | -- | Base64URL encoding of Integer with padding '=' removed.
182 | b64i = b64 . i2osp
183 | 
184 | b64 = B.takeWhile (/= 61) . Base64.encode
185 | 
186 | toStrict = B.concat . LB.toChunks
187 | 
188 | header' key = Header "RS256" (JWK (rsaE key) "RSA" (rsaN key)) Nothing
189 | 
190 | header key nonce = (toStrict . encode)
191 |   (Header "RS256" (JWK (rsaE key) "RSA" (rsaN key)) (Just nonce))
192 | 
193 | -- | Registration payload to sign with user key.
194 | registration email = (b64 . toStrict . encode) (Reg email terms)
195 | 
196 | -- | Challenge request payload to sign with user key.
197 | authz = b64. toStrict . encode . Authz
198 | 
199 | -- | Challenge response payload to sign with user key.
200 | challenge = b64 . toStrict . encode . Challenge . toStrict
201 | 
202 | -- | CSR request payload to sign with user key.
203 | csr = b64 . toStrict . encode . CSR . b64
204 | 
205 | thumbprint = b64 . toStrict .bytestringDigest . sha256 . encodeOrdered
206 | 
207 | -- | There is an `encodePretty'` in `aeson-pretty`, but do it by hand here.
208 | encodeOrdered JWK{..} = LC.pack $
209 |   "{\"e\":\"" ++ hE' ++ "\",\"kty\":\"" ++ hKty ++ "\",\"n\":\"" ++ hN' ++ "\"}"
210 |   where
211 |   hE' = BC.unpack (b64i hE)
212 |   hN' = BC.unpack (b64i hN)
213 | 
214 | 
215 | --------------------------------------------------------------------------------
216 | nonce = do
217 |   mnonce <- get (BC.concat ["https://", server, "/directory"])
218 |     (\r _ -> return (getHeader r "Replay-Nonce"))
219 |   case mnonce of
220 |     Nothing -> error "Can't get Nonce."
221 |     Just x -> return x
222 | 
223 | --------------------------------------------------------------------------------
224 | data Header = Header
225 |   { hAlg :: String
226 |   , hJwk :: JWK
227 |   , hNonce :: Maybe ByteString
228 |   }
229 |   deriving Show
230 | 
231 | data JWK = JWK
232 |   { hE :: Integer
233 |   , hKty :: String
234 |   , hN :: Integer
235 |   }
236 |   deriving Show
237 | 
238 | instance ToJSON Header where
239 |   toJSON Header{..} = object $
240 |     [ "alg" .= hAlg
241 |     , "jwk" .= toJSON hJwk
242 |     ] ++ maybe [] ((:[]) . ("nonce" .=) . decodeUtf8) hNonce
243 | 
244 | instance ToJSON JWK where
245 |   toJSON JWK{..} = object
246 |     [ "e" .= decodeUtf8 (b64i hE)
247 |     , "kty" .= hKty
248 |     , "n" .= decodeUtf8 (b64i hN)
249 |     ]
250 | 
251 | data Reg = Reg
252 |   { rMail :: String
253 |   , rAgreement :: String
254 |   }
255 |   deriving Show
256 | 
257 | instance ToJSON Reg where
258 |   toJSON Reg{..} = object
259 |     [ "resource" .= ("new-reg" :: String)
260 |     , "contact" .= ["mailto:" ++ rMail]
261 |     , "agreement" .= rAgreement
262 |     ]
263 | 
264 | data Request = Request
265 |   { rHeader :: Header
266 |   , rProtected :: ByteString
267 |   , rPayload :: ByteString
268 |   , rSignature :: ByteString
269 |   }
270 |   deriving Show
271 | 
272 | instance ToJSON Request where
273 |   toJSON Request{..} = object
274 |     [ "header" .= toJSON rHeader
275 |     , "protected" .= decodeUtf8 rProtected
276 |     , "payload" .= decodeUtf8 rPayload
277 |     , "signature" .= decodeUtf8 rSignature
278 |     ]
279 | 
280 | data Authz = Authz
281 |   { aDomain :: String
282 |   }
283 | 
284 | instance ToJSON Authz where
285 |   toJSON Authz{..} = object
286 |     [ "resource" .= ("new-authz" :: String)
287 |     , "identifier" .= object
288 |       [ "type" .= ("dns" :: String)
289 |       , "value" .= aDomain
290 |       ]
291 |     ]
292 | 
293 | data Challenge = Challenge
294 |   { cKeyAuth :: ByteString
295 |   }
296 | 
297 | instance ToJSON Challenge where
298 |   toJSON Challenge{..} = object
299 |     [ "resource" .= ("challenge" :: String)
300 |     , "keyAuthorization" .= decodeUtf8 cKeyAuth
301 |     ]
302 | 
303 | data CSR = CSR ByteString
304 |   deriving Show
305 | 
306 | instance ToJSON CSR where
307 |   toJSON (CSR s) = object
308 |     [ "resource" .= ("new-cert" :: String)
309 |     , "csr" .= decodeUtf8 s
310 |     ]
311 | 
312 | --------------------------------------------------------------------------------
313 | data ChallengeResponse = ChallengeResponse
314 |   { rStatus :: String
315 |   , rChallenges :: [RegChallenge]
316 |   }
317 |   deriving Show
318 | 
319 | instance FromJSON ChallengeResponse where
320 |   parseJSON (Object v) = do
321 |     status <- v .: "status"
322 |     challenges <- v .:? "challenges"
323 |     return ChallengeResponse
324 |       { rStatus = status
325 |       , rChallenges = maybe [] id challenges
326 |       }
327 |   parseJSON _ = mzero
328 | 
329 | data RegChallenge = RegChallenge
330 |   { rToken :: String
331 |   , rUri :: String
332 |   , rType :: String
333 |   }
334 |   deriving Show
335 | 
336 | instance FromJSON RegChallenge where
337 |   parseJSON (Object v) = do
338 |     token <- v .: "token"
339 |     uri <- v .: "uri"
340 |     typ <- v .: "type"
341 |     return RegChallenge
342 |       { rToken = token
343 |       , rUri = uri
344 |       , rType = typ
345 |       }
346 |   parseJSON _ = mzero
347 | 
348 | http01 ChallengeResponse{..} = case filter f rChallenges of
349 |   [x] -> x
350 |   _ -> error "No http-01 chanllenge."
351 |   where f RegChallenge{..} = rType == "http-01"
352 | 
353 | --------------------------------------------------------------------------------
354 | -- | Useful to recover only the status part of a response.
355 | data StatusResponse = StatusResponse
356 |   { sStatus :: Int
357 |   }
358 |   deriving Show
359 | 
360 | instance FromJSON StatusResponse where
361 |   parseJSON (Object v) = do
362 |     status <- v .: "status"
363 |     return StatusResponse
364 |       { sStatus = status
365 |       }
366 |   parseJSON _ = mzero
367 | 


--------------------------------------------------------------------------------
/build.sh:
--------------------------------------------------------------------------------
 1 | #! /bin/bash
 2 | 
 3 | docker run \
 4 |   -it \
 5 |   -v $(pwd):/source \
 6 |   images.reesd.com/reesd/stack:7.8.4 \
 7 |   sh -c 'cd /source ; ghc --make -threaded -hide-package=crypto-numbers-0.2.7 acme.hs'
 8 | 
 9 | rm acme.hi acme.o
10 | 


--------------------------------------------------------------------------------
/generate-csr.sh:
--------------------------------------------------------------------------------
 1 | #! /bin/bash
 2 | 
 3 | DOMAIN=$1
 4 | 
 5 | mkdir -p ${DOMAIN}
 6 | openssl genrsa 4096 > ${DOMAIN}/domain.key
 7 | openssl req -new -sha256 -key ${DOMAIN}/domain.key -subj "/CN=${DOMAIN}" \
 8 |   > ${DOMAIN}/domain.csr
 9 | openssl req -in ${DOMAIN}/domain.csr -outform DER > ${DOMAIN}/domain.der
10 | 


--------------------------------------------------------------------------------
/generate-haproxy-cert.sh:
--------------------------------------------------------------------------------
 1 | #! /bin/bash
 2 | 
 3 | DOMAIN=$1
 4 | 
 5 | openssl x509 -inform der -in ${DOMAIN}/domain.cert.der \
 6 |   -out ${DOMAIN}/domain.cert.pem
 7 | 
 8 | AUTHORITY_X=$(openssl x509 -in ${DOMAIN}/domain.cert.pem -text -noout | grep 'Authority X' | awk '{ print $NF }')
 9 | AUTHORITY_X_lower="$(echo ${AUTHORITY_X} | awk '{ print tolower($NF) }')"
10 | echo Generating dhparam for HAPRoxy certificate...
11 | openssl dhparam -out ${DOMAIN}/dhparams.pem 2048 > /dev/null 2>&1
12 | echo Creating HAPRoxy certificate using Authority ${AUTHORITY_X}...
13 | 
14 | case ${AUTHORITY_X_lower} in
15 |   x1)
16 |   # Fine.
17 |   ;;
18 |   x2)
19 |   echo TODO Add an Authority X2 certificate
20 |   exit 1
21 |   ;;
22 |   x3)
23 |   # Fine.
24 |   ;;
25 |   *)
26 |   echo Unkown Authority ${AUTHORITY_X}.
27 |   exit 1
28 |   ;;
29 | esac
30 | 
31 | cat ${DOMAIN}/domain.cert.pem \
32 |   lets-encrypt-${AUTHORITY_X_lower}-cross-signed.pem \
33 |   ${DOMAIN}/domain.key \
34 |   ${DOMAIN}/dhparams.pem > ${DOMAIN}/${DOMAIN}.combined.pem
35 | 


--------------------------------------------------------------------------------
/ghci.conf:
--------------------------------------------------------------------------------
1 | :set -fwarn-unused-binds
2 | :set -fwarn-unused-imports
3 | :set -hide-package crypto-numbers-0.2.7
4 | :set -i/source
5 | :load /source/acme.hs
6 | 


--------------------------------------------------------------------------------
/ghcid.sh:
--------------------------------------------------------------------------------
 1 | #! /usr/bin/env bash
 2 | 
 3 | docker kill ghcid
 4 | docker rm ghcid
 5 | docker run \
 6 |   --name ghcid \
 7 |   -v $(pwd):/source \
 8 |   -v $(pwd)/ghci.conf:/home/gusdev/.ghci \
 9 |   -t images.reesd.com/reesd/stack:7.8.4 \
10 |   /home/gusdev/.cabal/bin/ghcid --height 30
11 | 


--------------------------------------------------------------------------------
/lets-encrypt-x1-cross-signed.pem:
--------------------------------------------------------------------------------
 1 | -----BEGIN CERTIFICATE-----
 2 | MIIEqDCCA5CgAwIBAgIRAJgT9HUT5XULQ+dDHpceRL0wDQYJKoZIhvcNAQELBQAw
 3 | PzEkMCIGA1UEChMbRGlnaXRhbCBTaWduYXR1cmUgVHJ1c3QgQ28uMRcwFQYDVQQD
 4 | Ew5EU1QgUm9vdCBDQSBYMzAeFw0xNTEwMTkyMjMzMzZaFw0yMDEwMTkyMjMzMzZa
 5 | MEoxCzAJBgNVBAYTAlVTMRYwFAYDVQQKEw1MZXQncyBFbmNyeXB0MSMwIQYDVQQD
 6 | ExpMZXQncyBFbmNyeXB0IEF1dGhvcml0eSBYMTCCASIwDQYJKoZIhvcNAQEBBQAD
 7 | ggEPADCCAQoCggEBAJzTDPBa5S5Ht3JdN4OzaGMw6tc1Jhkl4b2+NfFwki+3uEtB
 8 | BaupnjUIWOyxKsRohwuj43Xk5vOnYnG6eYFgH9eRmp/z0HhncchpDpWRz/7mmelg
 9 | PEjMfspNdxIknUcbWuu57B43ABycrHunBerOSuu9QeU2mLnL/W08lmjfIypCkAyG
10 | dGfIf6WauFJhFBM/ZemCh8vb+g5W9oaJ84U/l4avsNwa72sNlRZ9xCugZbKZBDZ1
11 | gGusSvMbkEl4L6KWTyogJSkExnTA0DHNjzE4lRa6qDO4Q/GxH8Mwf6J5MRM9LTb4
12 | 4/zyM2q5OTHFr8SNDR1kFjOq+oQpttQLwNh9w5MCAwEAAaOCAZIwggGOMBIGA1Ud
13 | EwEB/wQIMAYBAf8CAQAwDgYDVR0PAQH/BAQDAgGGMH8GCCsGAQUFBwEBBHMwcTAy
14 | BggrBgEFBQcwAYYmaHR0cDovL2lzcmcudHJ1c3RpZC5vY3NwLmlkZW50cnVzdC5j
15 | b20wOwYIKwYBBQUHMAKGL2h0dHA6Ly9hcHBzLmlkZW50cnVzdC5jb20vcm9vdHMv
16 | ZHN0cm9vdGNheDMucDdjMB8GA1UdIwQYMBaAFMSnsaR7LHH62+FLkHX/xBVghYkQ
17 | MFQGA1UdIARNMEswCAYGZ4EMAQIBMD8GCysGAQQBgt8TAQEBMDAwLgYIKwYBBQUH
18 | AgEWImh0dHA6Ly9jcHMucm9vdC14MS5sZXRzZW5jcnlwdC5vcmcwPAYDVR0fBDUw
19 | MzAxoC+gLYYraHR0cDovL2NybC5pZGVudHJ1c3QuY29tL0RTVFJPT1RDQVgzQ1JM
20 | LmNybDATBgNVHR4EDDAKoQgwBoIELm1pbDAdBgNVHQ4EFgQUqEpqYwR93brm0Tm3
21 | pkVl7/Oo7KEwDQYJKoZIhvcNAQELBQADggEBANHIIkus7+MJiZZQsY14cCoBG1hd
22 | v0J20/FyWo5ppnfjL78S2k4s2GLRJ7iD9ZDKErndvbNFGcsW+9kKK/TnY21hp4Dd
23 | ITv8S9ZYQ7oaoqs7HwhEMY9sibED4aXw09xrJZTC9zK1uIfW6t5dHQjuOWv+HHoW
24 | ZnupyxpsEUlEaFb+/SCI4KCSBdAsYxAcsHYI5xxEI4LutHp6s3OT2FuO90WfdsIk
25 | 6q78OMSdn875bNjdBYAqxUp2/LEIHfDBkLoQz0hFJmwAbYahqKaLn73PAAm1X2kj
26 | f1w8DdnkabOLGeOVcj9LQ+s67vBykx4anTjURkbqZslUEUsn2k5xeua2zUk=
27 | -----END CERTIFICATE-----
28 | 


--------------------------------------------------------------------------------
/lets-encrypt-x3-cross-signed.pem:
--------------------------------------------------------------------------------
 1 | -----BEGIN CERTIFICATE-----
 2 | MIIEkjCCA3qgAwIBAgIQCgFBQgAAAVOFc2oLheynCDANBgkqhkiG9w0BAQsFADA/
 3 | MSQwIgYDVQQKExtEaWdpdGFsIFNpZ25hdHVyZSBUcnVzdCBDby4xFzAVBgNVBAMT
 4 | DkRTVCBSb290IENBIFgzMB4XDTE2MDMxNzE2NDA0NloXDTIxMDMxNzE2NDA0Nlow
 5 | SjELMAkGA1UEBhMCVVMxFjAUBgNVBAoTDUxldCdzIEVuY3J5cHQxIzAhBgNVBAMT
 6 | GkxldCdzIEVuY3J5cHQgQXV0aG9yaXR5IFgzMIIBIjANBgkqhkiG9w0BAQEFAAOC
 7 | AQ8AMIIBCgKCAQEAnNMM8FrlLke3cl03g7NoYzDq1zUmGSXhvb418XCSL7e4S0EF
 8 | q6meNQhY7LEqxGiHC6PjdeTm86dicbp5gWAf15Gan/PQeGdxyGkOlZHP/uaZ6WA8
 9 | SMx+yk13EiSdRxta67nsHjcAHJyse6cF6s5K671B5TaYucv9bTyWaN8jKkKQDIZ0
10 | Z8h/pZq4UmEUEz9l6YKHy9v6Dlb2honzhT+Xhq+w3Brvaw2VFn3EK6BlspkENnWA
11 | a6xK8xuQSXgvopZPKiAlKQTGdMDQMc2PMTiVFrqoM7hD8bEfwzB/onkxEz0tNvjj
12 | /PIzark5McWvxI0NHWQWM6r6hCm21AvA2H3DkwIDAQABo4IBfTCCAXkwEgYDVR0T
13 | AQH/BAgwBgEB/wIBADAOBgNVHQ8BAf8EBAMCAYYwfwYIKwYBBQUHAQEEczBxMDIG
14 | CCsGAQUFBzABhiZodHRwOi8vaXNyZy50cnVzdGlkLm9jc3AuaWRlbnRydXN0LmNv
15 | bTA7BggrBgEFBQcwAoYvaHR0cDovL2FwcHMuaWRlbnRydXN0LmNvbS9yb290cy9k
16 | c3Ryb290Y2F4My5wN2MwHwYDVR0jBBgwFoAUxKexpHsscfrb4UuQdf/EFWCFiRAw
17 | VAYDVR0gBE0wSzAIBgZngQwBAgEwPwYLKwYBBAGC3xMBAQEwMDAuBggrBgEFBQcC
18 | ARYiaHR0cDovL2Nwcy5yb290LXgxLmxldHNlbmNyeXB0Lm9yZzA8BgNVHR8ENTAz
19 | MDGgL6AthitodHRwOi8vY3JsLmlkZW50cnVzdC5jb20vRFNUUk9PVENBWDNDUkwu
20 | Y3JsMB0GA1UdDgQWBBSoSmpjBH3duubRObemRWXv86jsoTANBgkqhkiG9w0BAQsF
21 | AAOCAQEA3TPXEfNjWDjdGBX7CVW+dla5cEilaUcne8IkCJLxWh9KEik3JHRRHGJo
22 | uM2VcGfl96S8TihRzZvoroed6ti6WqEBmtzw3Wodatg+VyOeph4EYpr/1wXKtx8/
23 | wApIvJSwtmVi4MFU5aMqrSDE6ea73Mj2tcMyo5jMd6jmeWUHK8so/joWUoHOUgwu
24 | X4Po1QYz+3dszkDqMp4fklxBwXRsW10KXzPMTZ+sOPAveyxindmjkW8lGy+QsRlG
25 | PfZ+G6Z6h7mjem0Y+iWlkYcV4PIWL1iwBi8saCbGS5jN2p8M+X+Q7UNKEkROb3N6
26 | KOqkqm57TH2H3eDJAkSnh6/DNFu0Qg==
27 | -----END CERTIFICATE-----
28 | 


--------------------------------------------------------------------------------