diff options
author | Joris | 2016-03-11 23:21:06 +0100 |
---|---|---|
committer | Joris | 2016-03-11 23:21:06 +0100 |
commit | 9d57e149fcb124a28813c56f83cf254eb92baa42 (patch) | |
tree | b796c4fdc738006c07e65e01f4845adafe064d2a /src/server/Persona.hs | |
parent | 709d1cf587e92508ef73bca8e847cfa510c03069 (diff) |
Don't use persona anymore, use email token to sign in
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" |