module Network.Wai.Middleware.Auth.Provider
( AuthProvider(..)
, Provider(..)
, ProviderUrl(..)
, ProviderInfo(..)
, Providers
, ProviderParser
, mkProviderParser
, parseProviders
, AuthUser(..)
, UserIdentity
, mkRouteRender
, providersTemplate
) where
import Blaze.ByteString.Builder (toByteString)
import Control.Arrow (second)
import Data.Aeson (FromJSON (..), Object,
Result (..), Value)
import Data.Aeson.Types (parseEither)
import Data.Aeson.TH (defaultOptions, deriveJSON,
fieldLabelModifier)
import Data.Aeson.Types (Parser)
import Data.Binary (Binary)
import qualified Data.ByteString as S
import qualified Data.ByteString.Builder as B
import qualified Data.HashMap.Strict as HM
import Data.Int
import Data.Maybe (fromMaybe)
import Data.Monoid ((<>))
import Data.Proxy (Proxy)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import GHC.Generics (Generic)
import Network.HTTP.Types (Status, renderQueryText)
import Network.Wai (Request, Response)
import Network.Wai.Auth.Tools (toLowerUnderscore)
import Text.Blaze.Html.Renderer.Utf8 (renderHtmlBuilder)
import Text.Hamlet (Render, hamlet)
class AuthProvider ap where
getProviderName :: ap -> T.Text
getProviderInfo :: ap -> ProviderInfo
handleLogin
:: ap
-> Request
-> [T.Text]
-> Render ProviderUrl
-> (UserIdentity -> IO Response)
-> (Status -> S.ByteString -> IO Response)
-> IO Response
data Provider where
Provider :: AuthProvider p => p -> Provider
instance AuthProvider Provider where
getProviderName (Provider p) = getProviderName p
getProviderInfo (Provider p) = getProviderInfo p
handleLogin (Provider p) = handleLogin p
type Providers = HM.HashMap T.Text Provider
type ProviderParser = (T.Text, Value -> Parser Provider)
data ProviderUrl = ProviderUrl [T.Text]
data ProviderInfo = ProviderInfo
{ providerTitle :: T.Text
, providerLogoUrl :: T.Text
, providerDescr :: T.Text
} deriving (Show)
type UserIdentity = S.ByteString
data AuthUser = AuthUser
{ authUserIdentity :: !UserIdentity
, authProviderName :: !S.ByteString
, authLoginTime :: !Int64
} deriving (Generic, Show)
instance Binary AuthUser
mkProviderParser :: forall ap . (FromJSON ap, AuthProvider ap) => Proxy ap -> ProviderParser
mkProviderParser _ =
( getProviderName nameProxyError
, fmap Provider <$> (parseJSON :: Value -> Parser ap))
where
nameProxyError :: ap
nameProxyError = error "AuthProvider.getProviderName should not evaluate it's argument."
parseProviders :: Object -> [ProviderParser] -> Result Providers
parseProviders unparsedProvidersHM providerParsers =
if HM.null unrecognized
then sequence $ HM.intersectionWith parseProvider unparsedProvidersHM parsersHM
else Error $
"Provider name(s) are not recognized: " ++
T.unpack (T.intercalate ", " $ HM.keys unrecognized)
where
parsersHM = HM.fromList providerParsers
unrecognized = HM.difference unparsedProvidersHM parsersHM
parseProvider v p = either Error Success $ parseEither p v
mkRouteRender :: Maybe T.Text -> T.Text -> [T.Text] -> Render Provider
mkRouteRender appRoot authPrefix authSuffix (Provider p) params =
(T.intercalate "/" $ [root, authPrefix, getProviderName p] ++ authSuffix) <>
decodeUtf8With
lenientDecode
(toByteString $ renderQueryText True (map (second Just) params))
where
root = fromMaybe "" appRoot
$(deriveJSON defaultOptions { fieldLabelModifier = toLowerUnderscore . drop 8} ''ProviderInfo)
providersTemplate :: Maybe T.Text
-> Render Provider
-> Providers
-> B.Builder
providersTemplate merrMsg render providers =
renderHtmlBuilder $ [hamlet|
$doctype 5
<html>
<head>
<title>WAI Auth Middleware Authentication Providers.
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap.min.css" integrity="sha384-BVYiiSIFeK1dGmJRAkycuHAHRg32OmUcww7on3RYdg4Va+PmSTsz/K68vbdEjh4u" crossorigin="anonymous">
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/css/bootstrap-theme.min.css" integrity="sha384-rHyoN1iRsVXV4nD0JutlnGaslCJuC7uwjduW9SVrLvRYooPp2bWYgmgJQIXwl/Sp" crossorigin="anonymous">
<script src="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.7/js/bootstrap.min.js" integrity="sha384-Tc5IQib027qvyjSMfHjOMaLkfuWVxZxUPnCJA7l2mCWNIpG9mGCD8wGNIcPD7Txa" crossorigin="anonymous">
<style>
.providerlogo {
maxheight: 64px;
maxwidth: 64px;
padding: 5px;
margin: auto;
position: absolute;
top: 0;
bottom: 0;
left: 0;
right: 0;
}
.mediacontainer {
width: 600px;
position: absolute;
top: 100px;
bottom: 0;
left: 0;
right: 0;
margin: auto;
}
.provider.media {
border: 1px solid #e1e1e8;
padding: 5px;
height: 82px;
textoverflow: ellipsis;
margintop: 5px;
}
.provider.media:hover {
backgroundcolor: #f5f5f5;
border: 1px solid #337ab7;
}
.provider .medialeft {
height: 70px;
width: 0px;
paddingright: 70px;
position: relative;
}
a:hover {
textdecoration: none;
}
<body>
<div .mediacontainer>
<h3>Select one of available authentication methods:
$maybe errMsg <- merrMsg
<div .alert .alertdanger role="alert">
#{errMsg}
$forall provider <- providers
$with info <- getProviderInfo provider
<div .media.provider>
<a href=@{provider}>
<div .medialeft .container>
<img .providerlogo src=#{providerLogoUrl info}>
<div .mediabody>
<h3 .mediaheading>
#{providerTitle info}
#{providerDescr info}
|] render