{-# 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"