diff options
author | Andrew Cady <d@jerkface.net> | 2016-01-20 08:41:10 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2016-01-20 08:41:10 -0500 |
commit | 685a14d8ab5e92b57fce1e997978bd6607c2aac1 (patch) | |
tree | d685551e884243390fad9665923eca0b5f8a324f | |
parent | c703ebce4814d71ab7ebfc074d19b8d2c4c4bbdf (diff) |
Fetch directory urls along with nonce
-rw-r--r-- | acme-encrypt.cabal | 2 | ||||
-rw-r--r-- | acme.hs | 24 |
2 files changed, 24 insertions, 2 deletions
diff --git a/acme-encrypt.cabal b/acme-encrypt.cabal index 824b09d..45cb9de 100644 --- a/acme-encrypt.cabal +++ b/acme-encrypt.cabal | |||
@@ -23,7 +23,7 @@ executable acme-encrypt-exe | |||
23 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall | 23 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall |
24 | build-depends: base, | 24 | build-depends: base, |
25 | cryptonite, aeson, bytestring, base64-bytestring, SHA, | 25 | cryptonite, aeson, bytestring, base64-bytestring, SHA, |
26 | text, HsOpenSSL, process, wreq, lens | 26 | text, HsOpenSSL, process, wreq, lens, lens-aeson |
27 | -- , acme-encrypt | 27 | -- , acme-encrypt |
28 | default-language: Haskell2010 | 28 | default-language: Haskell2010 |
29 | 29 | ||
@@ -24,7 +24,11 @@ import OpenSSL.RSA | |||
24 | import System.Process (readProcess) | 24 | import System.Process (readProcess) |
25 | import Network.Wreq hiding (header) | 25 | import Network.Wreq hiding (header) |
26 | import Control.Lens hiding ((.=)) | 26 | import Control.Lens hiding ((.=)) |
27 | import Data.Aeson.Lens hiding (key) | ||
28 | import qualified Data.Aeson.Lens as JSON | ||
27 | 29 | ||
30 | directoryUrl :: String | ||
31 | directoryUrl = "https://acme-v01.api.letsencrypt.org/directory" | ||
28 | 32 | ||
29 | main :: IO () | 33 | main :: IO () |
30 | main = do | 34 | main = do |
@@ -33,7 +37,7 @@ main = do | |||
33 | Nothing -> error "Not a public RSA key." | 37 | Nothing -> error "Not a public RSA key." |
34 | Just (userKey :: RSAPubKey) -> do | 38 | Just (userKey :: RSAPubKey) -> do |
35 | 39 | ||
36 | nonce_ <- view (responseHeader "Replay-Nonce" . to (T.unpack . decodeUtf8)) <$> get "https://acme-v01.api.letsencrypt.org/directory" | 40 | Just nonce_ <- getNonce |
37 | 41 | ||
38 | let protected = b64 (header userKey nonce_) | 42 | let protected = b64 (header userKey nonce_) |
39 | 43 | ||
@@ -72,6 +76,24 @@ main = do | |||
72 | terms :: String | 76 | terms :: String |
73 | terms = "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf" | 77 | terms = "https://letsencrypt.org/documents/LE-SA-v1.0.1-July-27-2015.pdf" |
74 | 78 | ||
79 | data Directory = Directory { | ||
80 | _newCert :: String, | ||
81 | _newAuthz :: String, | ||
82 | _revokeCert :: String, | ||
83 | _newReg :: String, | ||
84 | _nonce :: String | ||
85 | } | ||
86 | |||
87 | getDirectory :: String -> IO (Maybe Directory) | ||
88 | getDirectory url = do | ||
89 | r <- get url | ||
90 | let nonce = r ^? responseHeader "Replay-Nonce" . to (T.unpack . decodeUtf8) | ||
91 | k x = r ^? responseBody . JSON.key x . _String . to T.unpack | ||
92 | return $ Directory <$> k "new-cert" <*> k "new-authz" <*> k "revoke-cert" <*> k "new-reg" <*> nonce | ||
93 | |||
94 | getNonce :: IO (Maybe String) | ||
95 | getNonce = fmap _nonce <$> getDirectory directoryUrl | ||
96 | |||
75 | -------------------------------------------------------------------------------- | 97 | -------------------------------------------------------------------------------- |
76 | -- | Sign and write a payload to a file with a nonce-protected header. | 98 | -- | Sign and write a payload to a file with a nonce-protected header. |
77 | signPayload :: RSAKey k => String -> k -> ByteString -> ByteString -> IO () | 99 | signPayload :: RSAKey k => String -> k -> ByteString -> ByteString -> IO () |