aboutsummaryrefslogtreecommitdiff
path: root/src/server/Persona.hs
diff options
context:
space:
mode:
authorJoris2016-03-11 23:21:06 +0100
committerJoris2016-03-11 23:21:06 +0100
commit9d57e149fcb124a28813c56f83cf254eb92baa42 (patch)
treeb796c4fdc738006c07e65e01f4845adafe064d2a /src/server/Persona.hs
parent709d1cf587e92508ef73bca8e847cfa510c03069 (diff)
downloadbudget-9d57e149fcb124a28813c56f83cf254eb92baa42.tar.gz
budget-9d57e149fcb124a28813c56f83cf254eb92baa42.tar.bz2
budget-9d57e149fcb124a28813c56f83cf254eb92baa42.zip
Don't use persona anymore, use email token to sign in
Diffstat (limited to 'src/server/Persona.hs')
-rw-r--r--src/server/Persona.hs45
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"