Initial commit.

4 files changed, 469 insertions, 0 deletions

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..c101c43
--- /dev/null
+++ b/README.md
@@ -0,0 +1,173 @@
+# Let's Encrypt ACME protocol
+
+This is a simple Haskell script to obtain a certificate from [Let's
+Encrypt](https://letsencrypt.org/) using their ACME protocol.
+
+
+- The main source of information to write this was
+  https://github.com/diafygi/letsencrypt-nosudo
+
+- The ACME spec: https://letsencrypt.github.io/acme-spec/
+
+Most values are still hard-coded for my initial attempt (i.e. my email address
+and a domain of mine).
+
+
+## Discover the URL for letsencrypt ACME endpoints
+
+API endpoints are listed at https://acme-v01.api.letsencrypt.org/directory and
+are currently hard-coded in the script.
+
+```
+> curl -s https://acme-v01.api.letsencrypt.org/directory | json_pp 
+{
+   "new-cert" : "https://acme-v01.api.letsencrypt.org/acme/new-cert",
+   "new-authz" : "https://acme-v01.api.letsencrypt.org/acme/new-authz",
+   "revoke-cert" : "https://acme-v01.api.letsencrypt.org/acme/revoke-cert",
+   "new-reg" : "https://acme-v01.api.letsencrypt.org/acme/new-reg"
+}
+```
+
+
+## Generate user account keys
+
+You need an account with Let's Encrypt to ask and receive certificates for your
+domains. The account is controlled by a public/private key pair:
+
+```
+openssl genrsa 4096 > user.key
+openssl rsa -in user.key -pubout > user.pub
+```
+
+
+## Generate nonces
+
+
+Each request to the API have a nonce to prevent replays. The nonce is currently
+hard-coded in the script. New nonces can be obtained from letsencrypt with
+
+```
+> generate-nonce.sh
+```
+
+
+## Create user account
+
+Generate `registration.body` by using the `acme.hs` script then POST it to
+letsencrypt (note it assumes you agree to their subscriber agreement):
+
+```
+> curl -s -X POST --data-binary "@registration.body" \
+  https://acme-v01.api.letsencrypt.org/acme/new-reg | json_pp
+{
+   "agreement" : "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf",
+   "contact" : [
+      "mailto:noteed@gmail.com"
+   ],
+   "key" : {
+      "e" : "...",
+      "kty" : "RSA",
+      "n" : "..."
+   },
+   "id" : 36009,
+   "createdAt" : "2015-12-04T14:22:08.321951547Z",
+   "initialIp" : "80.236.245.73"
+}
+```
+
+
+## Request a challenge
+
+
+Let's Encrypt needs a proof that you control the claimed domain. You can
+request a challenge with `challenge-request.body`.
+
+```
+> curl -s -X POST --data-binary "@challenge-request.body" \
+  https://acme-v01.api.letsencrypt.org/acme/new-authz | json_pp
+{
+   "expires" : "2015-12-21T18:44:52.331487674Z",
+   "challenges" : [
+      {
+         "status" : "pending",
+         "uri" : "https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844047",
+         "type" : "tls-sni-01",
+         "token" : "oielAbB7MdyCl29mqjzlqGdrCQSB8SyJaxHbAgQBA7Q"
+      },
+      {
+         "uri" : "https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844048",
+         "status" : "pending",
+         "type" : "http-01",
+         "token" : "DjyJpI3HVWAmsAwMT5ZFpW8dj19cel6ml6qaBUeGpCg"
+      }
+   ],
+   "identifier" : {
+      "type" : "dns",
+      "value" : "aaa.reesd.com"
+   },
+   "combinations" : [
+      [
+         0
+      ],
+      [
+         1
+      ]
+   ],
+   "status" : "pending"
+}
+```
+
+The script assumes you'll answer the challenge by hosting a file at a location
+chosen by Let's Encrypt. Extract the token for the `http-01` challenge and run
+the script again. Now you have to host the file at the location reported by the
+script.
+
+Once this is done, you can ask Let's Encrypt to check the file.
+
+```
+> curl -s -X POST --data-binary "@challenge-response.body" \
+  https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844048 | json_pp
+{
+   "token" : "DjyJpI3HVWAmsAwMT5ZFpW8dj19cel6ml6qaBUeGpCg",
+   "keyAuthorization" : "DjyJpI3HVWAmsAwMT5ZFpW8dj19cel6ml6qaBUeGpCg.EJe0KReqzCUq6leNOerMC9naZSHxP9TJzGxCcsGkNrw",
+   "type" : "http-01",
+   "uri" : "https://acme-v01.api.letsencrypt.org/acme/challenge/vXZ1UnZ-y1q7sntnf6NdOfbPAwetJFBqOtvp7FHCjaU/1844048",
+   "status" : "pending"
+}
+```
+
+The same URL can then be polled until the status becomes valid.
+
+
+## Send CSR / Receive certificate
+
+The CSR is created with:
+
+```
+> openssl genrsa 4096 > domain.key
+> openssl req -new -sha256 -key domain.key -subj "/CN=aaa.reesd.com" > aaa.reesd.com.csr
+> openssl req -in aaa.reesd.com.csr -outform DER > aaa.reesd.com.csr.der
+```
+
+And the signed certificate can be obtained from Let's Encrypt:
+
+```
+> curl -s -X POST --data-binary "@csr-request.body" \
+  https://acme-v01.api.letsencrypt.org/acme/new-cert > aaa.reesd.com.cert.der
+```
+
+
+## Create a certificate for HAProxy
+
+Including explicit DH key exchange parameters to prevent Logjam attack
+(https://weakdh.org/).
+
+```
+> openssl x509 -inform der -in aaa.reesd.com.cert.der \
+    -out aaa.reesd.com.cert.pem
+> openssl dhparam -out aaa.reesd.com-dhparams.pem 2048
+> cat aaa.reesd.com.cert.pem \
+    lets-encrypt-x1-cross-signed.pem \
+    aaa.reesd.com.key \
+    aaa.reesd.com-dhparams.pem > aaa.reesd.com-combined.pem
+```
diff --git a/acme.hs b/acme.hs
new file mode 100644
index 0000000..c1419a3
--- /dev/null
+++ b/acme.hs
@@ -0,0 +1,265 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+--------------------------------------------------------------------------------
+-- | Get a certificate from Let's Encrypt using the ACME protocol.
+
+module Main where
+
+import Crypto.Number.Serialize (i2osp)
+import Data.Aeson (encode, object, ToJSON(..), (.=))
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Lazy.Char8 as LC
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Base64.URL as Base64
+import Data.Digest.Pure.SHA (bytestringDigest, sha256)
+import Data.Text.Encoding (decodeUtf8)
+import OpenSSL.EVP.PKey
+import OpenSSL.PEM (readPublicKey)
+import OpenSSL.RSA
+import System.Process (readProcess)
+
+
+--------------------------------------------------------------------------------
+email :: String
+email = "noteed@gmail.com"
+
+domain :: String
+domain = "aaa.reesd.com"
+
+nonce_ :: String
+nonce_ = "ckYlMQ7BflfUb7HmxipdSpnkFle83-8lUkn50U-X97Q"
+
+terms :: String
+terms = "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf"
+
+--------------------------------------------------------------------------------
+main :: IO ()
+main = do
+  userKey_ <- readFile "user.pub" >>= readPublicKey
+  case toPublicKey userKey_ of
+    Nothing -> error "Not a public RSA key."
+    Just (userKey :: RSAPubKey) -> do
+      let protected = b64 (header userKey nonce_)
+
+--------------------------------------------------------------------------------
+      -- Create user account
+
+      let reg = registration email
+          payload = b64 reg
+
+      -- Registration payload to sign with user key.
+      LB.writeFile "registration.txt"
+        (LB.fromChunks [protected, ".", payload])
+
+      -- Sign with user key.
+      sign "registration.txt" "registration.sig"
+      sig_ <- B.readFile "registration.sig"
+      let sig = b64 sig_
+
+      -- Registration POST body.
+      LB.writeFile "registration.body"
+        (encode (Request (header' userKey) protected payload sig))
+
+--------------------------------------------------------------------------------
+      -- Obtain a challenge
+
+      let auth = authz domain
+          payload = b64 auth
+
+      -- Challenge request payload to sign with user key.
+      LB.writeFile "challenge-request.txt"
+        (LB.fromChunks [protected, ".", payload])
+
+      -- Sign with user key.
+      sign "challenge-request.txt" "challenge-request.sig"
+      sig_ <- B.readFile "challenge-request.sig"
+      let sig = b64 sig_
+
+      -- Challenge request POST body.
+      LB.writeFile "challenge-request.body"
+        (encode (Request (header' userKey) protected payload sig))
+
+--------------------------------------------------------------------------------
+      -- Notify Let's Encrypt we answsered the challenge
+
+      let thumb = thumbprint (JWK (rsaE userKey) "RSA" (rsaN userKey))
+          -- Extracted from POST response above.
+          token = "DjyJpI3HVWAmsAwMT5ZFpW8dj19cel6ml6qaBUeGpCg"
+          thumbtoken = toStrict (LB.fromChunks [token, ".", thumb])
+
+      putStrLn ("Serve http://" ++ domain ++ "/.well-known/acme-challenge/" ++
+        BC.unpack token)
+      putStrLn ("With content:\n" ++ BC.unpack thumbtoken)
+
+      let chall = challenge thumbtoken
+          payload = b64 chall
+
+      -- Challenge response payload to sign with user key.
+      LB.writeFile "challenge-response.txt"
+        (LB.fromChunks [protected, ".", payload])
+
+      -- Sign with user key.
+      sign "challenge-response.txt" "challenge-response.sig"
+      sig_ <- B.readFile "challenge-response.sig"
+      let sig = b64 sig_
+
+      -- Challenge response POST body. (Means the server can query our server.)
+      LB.writeFile "challenge-response.body"
+        (encode (Request (header' userKey) protected payload sig))
+
+--------------------------------------------------------------------------------
+      -- Wait for challenge validation
+
+--------------------------------------------------------------------------------
+      -- Send a CSR and get a certificate
+
+      csr_ <- B.readFile (domain ++ ".csr.der")
+
+      let csr = (toStrict . encode . CSR) (b64 csr_)
+          payload = b64 csr
+
+      -- CSR request payload to sign with user key.
+      LB.writeFile "csr-request.txt"
+        (LB.fromChunks [protected, ".", payload])
+
+      -- Sign with user key.
+      sign "csr-request.txt" "csr-request.sig"
+      sig_ <- B.readFile "csr-request.sig"
+      let sig = b64 sig_
+
+      -- CSR request POST body.
+      LB.writeFile "csr-request.body"
+        (encode (Request (header' userKey) protected payload sig))
+
+
+--------------------------------------------------------------------------------
+-- | Base64URL encoding of Integer with padding '=' removed.
+b64i = b64 . i2osp
+
+b64 = B.takeWhile (/= 61) . Base64.encode
+
+toStrict = B.concat . LB.toChunks
+
+header' key = Header "RS256" (JWK (rsaE key) "RSA" (rsaN key)) Nothing
+
+header key nonce = (toStrict . encode)
+  (Header "RS256" (JWK (rsaE key) "RSA" (rsaN key)) (Just nonce))
+
+registration email = (toStrict . encode) (Reg email terms)
+
+authz = toStrict . encode . Authz
+
+challenge = toStrict . encode . Challenge . BC.unpack
+
+sign inp out = do
+  _ <- readProcess "openssl"
+    [ "dgst", "-sha256"
+    , "-sign", "user.key"
+    , "-out", out
+    , inp
+    ]
+    ""
+  return ()
+
+thumbprint = b64 . toStrict .bytestringDigest . sha256 . encodeOrdered
+
+-- | There is an `encodePretty'` in `aeson-pretty`, but do it by hand here.
+encodeOrdered JWK{..} = LC.pack $
+  "{\"e\":\"" ++ hE' ++ "\",\"kty\":\"" ++ hKty ++ "\",\"n\":\"" ++ hN' ++ "\"}"
+  where
+  hE' = BC.unpack (b64i hE)
+  hN' = BC.unpack (b64i hN)
+
+
+--------------------------------------------------------------------------------
+data Header = Header
+  { hAlg :: String
+  , hJwk :: JWK
+  , hNonce :: Maybe String
+  }
+  deriving Show
+
+data JWK = JWK
+  { hE :: Integer
+  , hKty :: String
+  , hN :: Integer
+  }
+  deriving Show
+
+instance ToJSON Header where
+  toJSON Header{..} = object $
+    [ "alg" .= hAlg
+    , "jwk" .= toJSON hJwk
+    ] ++ maybe [] ((:[]) . ("nonce" .=)) hNonce
+
+instance ToJSON JWK where
+  toJSON JWK{..} = object
+    [ "e" .= decodeUtf8 (b64i hE)
+    , "kty" .= hKty
+    , "n" .= decodeUtf8 (b64i hN)
+    ]
+
+data Reg = Reg
+  { rMail :: String
+  , rAgreement :: String
+  }
+  deriving Show
+
+instance ToJSON Reg where
+  toJSON Reg{..} = object
+    [ "resource" .= ("new-reg" :: String)
+    , "contact" .= ["mailto:" ++ rMail]
+    , "agreement" .= rAgreement
+    ]
+
+data Request = Request
+  { rHeader :: Header
+  , rProtected :: ByteString
+  , rPayload :: ByteString
+  , rSignature :: ByteString
+  }
+  deriving Show
+
+instance ToJSON Request where
+  toJSON Request{..} = object
+    [ "header" .= toJSON rHeader
+    , "protected" .= decodeUtf8 rProtected
+    , "payload" .= decodeUtf8 rPayload
+    , "signature" .= decodeUtf8 rSignature
+    ]
+
+data Authz = Authz
+  { aDomain :: String
+  }
+
+instance ToJSON Authz where
+  toJSON Authz{..} = object
+    [ "resource" .= ("new-authz" :: String)
+    , "identifier" .= object
+      [ "type" .= ("dns" :: String)
+      , "value" .= aDomain
+      ]
+    ]
+
+data Challenge = Challenge
+  { cKeyAuth :: String
+  }
+
+instance ToJSON Challenge where
+  toJSON Challenge{..} = object
+    [ "resource" .= ("challenge" :: String)
+    , "keyAuthorization" .= cKeyAuth
+    ]
+
+data CSR = CSR ByteString
+  deriving Show
+
+instance ToJSON CSR where
+  toJSON (CSR s) = object
+    [ "resource" .= ("new-cert" :: String)
+    , "csr" .= decodeUtf8 s
+    ]
diff --git a/generate-nonce.sh b/generate-nonce.sh
new file mode 100755
index 0000000..ad72d5c
--- /dev/null
+++ b/generate-nonce.sh
@@ -0,0 +1,4 @@
+#! /bin/bash
+curl -s -i https://acme-v01.api.letsencrypt.org/directory \
+  | grep Replay-Nonce \
+  | cut -d ' ' -f 2
diff --git a/lets-encrypt-x1-cross-signed.pem b/lets-encrypt-x1-cross-signed.pem
new file mode 100644
index 0000000..8a92a0b
--- /dev/null
+++ b/lets-encrypt-x1-cross-signed.pem
@@ -0,0 +1,27 @@
+-----BEGIN CERTIFICATE-----
+MIIEqDCCA5CgAwIBAgIRAJgT9HUT5XULQ+dDHpceRL0wDQYJKoZIhvcNAQELBQAw
+PzEkMCIGA1UEChMbRGlnaXRhbCBTaWduYXR1cmUgVHJ1c3QgQ28uMRcwFQYDVQQD
+Ew5EU1QgUm9vdCBDQSBYMzAeFw0xNTEwMTkyMjMzMzZaFw0yMDEwMTkyMjMzMzZa
+MEoxCzAJBgNVBAYTAlVTMRYwFAYDVQQKEw1MZXQncyBFbmNyeXB0MSMwIQYDVQQD
+ExpMZXQncyBFbmNyeXB0IEF1dGhvcml0eSBYMTCCASIwDQYJKoZIhvcNAQEBBQAD
+ggEPADCCAQoCggEBAJzTDPBa5S5Ht3JdN4OzaGMw6tc1Jhkl4b2+NfFwki+3uEtB
+BaupnjUIWOyxKsRohwuj43Xk5vOnYnG6eYFgH9eRmp/z0HhncchpDpWRz/7mmelg
+PEjMfspNdxIknUcbWuu57B43ABycrHunBerOSuu9QeU2mLnL/W08lmjfIypCkAyG
+dGfIf6WauFJhFBM/ZemCh8vb+g5W9oaJ84U/l4avsNwa72sNlRZ9xCugZbKZBDZ1
+gGusSvMbkEl4L6KWTyogJSkExnTA0DHNjzE4lRa6qDO4Q/GxH8Mwf6J5MRM9LTb4
+4/zyM2q5OTHFr8SNDR1kFjOq+oQpttQLwNh9w5MCAwEAAaOCAZIwggGOMBIGA1Ud
+EwEB/wQIMAYBAf8CAQAwDgYDVR0PAQH/BAQDAgGGMH8GCCsGAQUFBwEBBHMwcTAy
+BggrBgEFBQcwAYYmaHR0cDovL2lzcmcudHJ1c3RpZC5vY3NwLmlkZW50cnVzdC5j
+b20wOwYIKwYBBQUHMAKGL2h0dHA6Ly9hcHBzLmlkZW50cnVzdC5jb20vcm9vdHMv
+ZHN0cm9vdGNheDMucDdjMB8GA1UdIwQYMBaAFMSnsaR7LHH62+FLkHX/xBVghYkQ
+MFQGA1UdIARNMEswCAYGZ4EMAQIBMD8GCysGAQQBgt8TAQEBMDAwLgYIKwYBBQUH
+AgEWImh0dHA6Ly9jcHMucm9vdC14MS5sZXRzZW5jcnlwdC5vcmcwPAYDVR0fBDUw
+MzAxoC+gLYYraHR0cDovL2NybC5pZGVudHJ1c3QuY29tL0RTVFJPT1RDQVgzQ1JM
+LmNybDATBgNVHR4EDDAKoQgwBoIELm1pbDAdBgNVHQ4EFgQUqEpqYwR93brm0Tm3
+pkVl7/Oo7KEwDQYJKoZIhvcNAQELBQADggEBANHIIkus7+MJiZZQsY14cCoBG1hd
+v0J20/FyWo5ppnfjL78S2k4s2GLRJ7iD9ZDKErndvbNFGcsW+9kKK/TnY21hp4Dd
+ITv8S9ZYQ7oaoqs7HwhEMY9sibED4aXw09xrJZTC9zK1uIfW6t5dHQjuOWv+HHoW
+ZnupyxpsEUlEaFb+/SCI4KCSBdAsYxAcsHYI5xxEI4LutHp6s3OT2FuO90WfdsIk
+6q78OMSdn875bNjdBYAqxUp2/LEIHfDBkLoQz0hFJmwAbYahqKaLn73PAAm1X2kj
+f1w8DdnkabOLGeOVcj9LQ+s67vBykx4anTjURkbqZslUEUsn2k5xeua2zUk=
+-----END CERTIFICATE-----