diff options
author | Andrew Cady <d@jerkface.net> | 2016-01-20 14:33:54 -0500 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2016-01-20 14:33:54 -0500 |
commit | 3123d316b5c9c910af965c7d207789bda49d2b3d (patch) | |
tree | b39a94e75a76826daaa707d8891e6dda4deea7b7 /acme.hs | |
parent | c1dc81d18cc381d0b09147d0dbb778bbfd86f4da (diff) |
Report HTTP status
Diffstat (limited to 'acme.hs')
-rw-r--r-- | acme.hs | 12 |
1 files changed, 10 insertions, 2 deletions
@@ -24,7 +24,7 @@ import Data.Digest.Pure.SHA (bytestringDigest, sha256) | |||
24 | import Data.Maybe | 24 | import Data.Maybe |
25 | import qualified Data.Text as T | 25 | import qualified Data.Text as T |
26 | import Data.Text.Encoding (decodeUtf8) | 26 | import Data.Text.Encoding (decodeUtf8) |
27 | import Network.Wreq (Response, responseHeader, responseBody, defaults, checkStatus) | 27 | import Network.Wreq (Response, responseHeader, responseBody, responseStatus, statusCode, statusMessage, defaults, checkStatus) |
28 | import qualified Network.Wreq.Session as WS | 28 | import qualified Network.Wreq.Session as WS |
29 | import OpenSSL | 29 | import OpenSSL |
30 | import OpenSSL.EVP.Digest | 30 | import OpenSSL.EVP.Digest |
@@ -123,7 +123,7 @@ data Directory = Directory { | |||
123 | } | 123 | } |
124 | newtype Nonce = Nonce String | 124 | newtype Nonce = Nonce String |
125 | testRegister :: String -> IO (Response LC.ByteString) | 125 | testRegister :: String -> IO (Response LC.ByteString) |
126 | testRegister email = readKeys "rsa.key" >>= flip (runACME directoryUrl) (register email defaultTerms) | 126 | testRegister email = readKeys "rsa.key" >>= flip (runACME directoryUrl) (register email defaultTerms) >>= statusReport |
127 | 127 | ||
128 | getDirectory :: WS.Session -> String -> IO (Maybe (Directory, Nonce)) | 128 | getDirectory :: WS.Session -> String -> IO (Maybe (Directory, Nonce)) |
129 | getDirectory sess url = do | 129 | getDirectory sess url = do |
@@ -135,6 +135,14 @@ getDirectory sess url = do | |||
135 | register :: String -> String -> ACME (Response LC.ByteString) | 135 | register :: String -> String -> ACME (Response LC.ByteString) |
136 | register email terms = sendPayload _newReg (registration email terms) | 136 | register email terms = sendPayload _newReg (registration email terms) |
137 | 137 | ||
138 | statusLine :: Response body -> String | ||
139 | statusLine r = (r ^. responseStatus . statusCode . to show) ++ " " ++ r ^. responseStatus . statusMessage . to (T.unpack . decodeUtf8) | ||
140 | |||
141 | statusReport :: MonadIO m => Response body -> m (Response body) | ||
142 | statusReport r = do | ||
143 | liftIO $ putStrLn $ statusLine r | ||
144 | return r | ||
145 | |||
138 | sendPayload :: (MonadIO m, MonadState Nonce m, MonadReader Env m) => (Directory -> String) -> ByteString -> m (Response LC.ByteString) | 146 | sendPayload :: (MonadIO m, MonadState Nonce m, MonadReader Env m) => (Directory -> String) -> ByteString -> m (Response LC.ByteString) |
139 | sendPayload reqType payload = do | 147 | sendPayload reqType payload = do |
140 | keys <- asks getKeys | 148 | keys <- asks getKeys |