diff options
| -rw-r--r-- | src/server/Persona.hs | 7 |
1 files changed, 5 insertions, 2 deletions
diff --git a/src/server/Persona.hs b/src/server/Persona.hs index 8055e8b..267ee3b 100644 --- a/src/server/Persona.hs +++ b/src/server/Persona.hs @@ -7,6 +7,7 @@ module Persona import Control.Monad (guard) import Network.HTTP.Conduit +import Network.HTTP.Types.Status (ok200) import Data.Text (Text) import qualified Data.Text as T @@ -23,7 +24,7 @@ verifyEmail config assertion = do initReq <- parseUrl "https://verifier.login.persona.org/verify" let request = - (flip urlEncodedBody) initReq $ + (flip urlEncodedBody) (initReq { checkStatus = \_ _ _ -> Nothing }) $ [ ("assertion", encodeUtf8 $ assertion) , ("audience", encodeUtf8 $ hostname config) ] @@ -31,7 +32,9 @@ verifyEmail config assertion = do manager <- newManager tlsManagerSettings response <- httpLbs request manager - return . parseEmail . decodeUtf8 . toStrict . responseBody $ response + if responseStatus response == ok200 + then return . parseEmail . decodeUtf8 . toStrict . responseBody $ response + else return Nothing parseEmail :: Text -> Maybe Text parseEmail payload = do |