From 9d57e149fcb124a28813c56f83cf254eb92baa42 Mon Sep 17 00:00:00 2001 From: Joris Date: Fri, 11 Mar 2016 23:21:06 +0100 Subject: Don't use persona anymore, use email token to sign in --- src/server/Persona.hs | 45 --------------------------------------------- 1 file changed, 45 deletions(-) delete mode 100644 src/server/Persona.hs (limited to 'src/server/Persona.hs') 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" -- cgit v1.2.3