diff options
Diffstat (limited to 'src/server/Persona.hs')
-rw-r--r-- | src/server/Persona.hs | 45 |
1 files changed, 0 insertions, 45 deletions
diff --git a/src/server/Persona.hs b/src/server/Persona.hs deleted file mode 100644 index 267ee3b..0000000 --- a/src/server/Persona.hs +++ /dev/null @@ -1,45 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -module Persona - ( verifyEmail - ) where - -import Control.Monad (guard) - -import Network.HTTP.Conduit -import Network.HTTP.Types.Status (ok200) - -import Data.Text (Text) -import qualified Data.Text as T -import Data.ByteString.Lazy (fromStrict, toStrict) -import Data.Text.Encoding (encodeUtf8, decodeUtf8) -import Data.Aeson -import Data.Aeson.Types (parseMaybe) - -import Config - -verifyEmail :: Config -> Text -> IO (Maybe Text) -verifyEmail config assertion = do - - initReq <- parseUrl "https://verifier.login.persona.org/verify" - - let request = - (flip urlEncodedBody) (initReq { checkStatus = \_ _ _ -> Nothing }) $ - [ ("assertion", encodeUtf8 $ assertion) - , ("audience", encodeUtf8 $ hostname config) - ] - - manager <- newManager tlsManagerSettings - response <- httpLbs request manager - - if responseStatus response == ok200 - then return . parseEmail . decodeUtf8 . toStrict . responseBody $ response - else return Nothing - -parseEmail :: Text -> Maybe Text -parseEmail payload = do - result <- decode . fromStrict . encodeUtf8 $ payload - flip parseMaybe result $ \obj -> do - status <- T.pack <$> obj .: "status" - guard (status == "okay") - obj .: "email" |