From 3123d316b5c9c910af965c7d207789bda49d2b3d Mon Sep 17 00:00:00 2001 From: Andrew Cady Date: Wed, 20 Jan 2016 14:33:54 -0500 Subject: Report HTTP status --- acme.hs | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) diff --git a/acme.hs b/acme.hs index 49b8699..6bbda40 100644 --- a/acme.hs +++ b/acme.hs @@ -24,7 +24,7 @@ import Data.Digest.Pure.SHA (bytestringDigest, sha256) import Data.Maybe import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) -import Network.Wreq (Response, responseHeader, responseBody, defaults, checkStatus) +import Network.Wreq (Response, responseHeader, responseBody, responseStatus, statusCode, statusMessage, defaults, checkStatus) import qualified Network.Wreq.Session as WS import OpenSSL import OpenSSL.EVP.Digest @@ -123,7 +123,7 @@ data Directory = Directory { } newtype Nonce = Nonce String testRegister :: String -> IO (Response LC.ByteString) -testRegister email = readKeys "rsa.key" >>= flip (runACME directoryUrl) (register email defaultTerms) +testRegister email = readKeys "rsa.key" >>= flip (runACME directoryUrl) (register email defaultTerms) >>= statusReport getDirectory :: WS.Session -> String -> IO (Maybe (Directory, Nonce)) getDirectory sess url = do @@ -135,6 +135,14 @@ getDirectory sess url = do register :: String -> String -> ACME (Response LC.ByteString) register email terms = sendPayload _newReg (registration email terms) +statusLine :: Response body -> String +statusLine r = (r ^. responseStatus . statusCode . to show) ++ " " ++ r ^. responseStatus . statusMessage . to (T.unpack . decodeUtf8) + +statusReport :: MonadIO m => Response body -> m (Response body) +statusReport r = do + liftIO $ putStrLn $ statusLine r + return r + sendPayload :: (MonadIO m, MonadState Nonce m, MonadReader Env m) => (Directory -> String) -> ByteString -> m (Response LC.ByteString) sendPayload reqType payload = do keys <- asks getKeys -- cgit v1.2.3