aboutsummaryrefslogtreecommitdiff
path: root/src/server/Persona.hs
diff options
context:
space:
mode:
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"