473 lines
16 KiB
Plaintext
473 lines
16 KiB
Plaintext
[OpenID Connect](https://openid.net/connect/)
|
|
=============================================
|
|
|
|
Use OpenID Connect to authenticate your users.
|
|
This example use google OIDC provider.
|
|
It was made for a working with single page application where
|
|
some login token would be saved in the user agent local storage.
|
|
|
|
Workflow:
|
|
|
|
1. user is presented with a login button,
|
|
2. when the user clicks on the button it is redirected to the OIDC
|
|
provider,
|
|
3. the user login in the OIDC provider,
|
|
4. the OIDC provider will redirect the user and provide a `code`,
|
|
5. the server will use this code to make a POST to the OIDC provider
|
|
and will get back authentication infos,
|
|
6. The user will get display an HTML page that will save a secret
|
|
identifying him in the local storage, then it will be redirected to
|
|
/.
|
|
|
|
Let's put the imports behind us:
|
|
|
|
``` haskell
|
|
{-# LANGUAGE DataKinds #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE DuplicateRecordFields #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE OverloadedLists #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE PartialTypeSignatures #-}
|
|
{-# LANGUAGE PolyKinds #-}
|
|
{-# LANGUAGE RankNTypes #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
{-# LANGUAGE TypeOperators #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
|
|
module Main where
|
|
|
|
import Protolude
|
|
|
|
import Data.Aeson
|
|
(FromJSON (..), (.:))
|
|
import qualified Data.Aeson as JSON
|
|
import qualified Data.Aeson.Types as AeT
|
|
import qualified Data.ByteString.Lazy as LBS
|
|
import qualified Data.List as List
|
|
import qualified Data.Text as Text
|
|
import Jose.Jwt
|
|
(Jwt (..), decodeClaims)
|
|
import Network.HTTP.Client
|
|
(Manager, newManager)
|
|
import Network.HTTP.Client.TLS
|
|
(tlsManagerSettings)
|
|
import Network.Wai.Handler.Warp
|
|
(run)
|
|
import Servant
|
|
import Servant.HTML.Blaze
|
|
(HTML)
|
|
import qualified System.Random as Random
|
|
import Text.Blaze
|
|
(ToMarkup (..))
|
|
import qualified Text.Blaze.Html as H
|
|
import Text.Blaze.Html5
|
|
((!))
|
|
import qualified Text.Blaze.Html5 as H
|
|
import qualified Text.Blaze.Html5.Attributes as HA
|
|
import Text.Blaze.Renderer.Utf8
|
|
(renderMarkup)
|
|
import qualified Web.OIDC.Client as O
|
|
```
|
|
|
|
You'll need to create a new OpenID Connect client in an OpenID Provider.
|
|
This example was tested with Google.
|
|
|
|
You can find a list of public OIDC provider here:
|
|
https://connect2id.com/products/nimbus-oauth-openid-connect-sdk/openid-connect-providers
|
|
|
|
I copied some here:
|
|
|
|
- Google: https://developers.google.com/identity/protocols/OpenIDConnect
|
|
more precisely: https://console.developers.google.com/apis/credentials
|
|
- Microsoft: https://docs.microsoft.com/en-us/previous-versions/azure/dn645541(v=azure.100)
|
|
- Yahoo: https://developer.yahoo.com/oauth2/guide/openid_connect/
|
|
- PayPal: https://developer.paypal.com/docs/integration/direct/identity/log-in-with-paypal/
|
|
|
|
During the configuration you'll need to provide a redirect uri.
|
|
The redirect_uri should correspond to the uri user will be redirected to
|
|
after a successful login into the OpenID provider.
|
|
|
|
So during your test, you should certainly just use `http://localhost:3000/login/cb`.
|
|
In general you should use your own domain name.
|
|
|
|
You'll then be given a `client_id` and a `client_password`.
|
|
Fill those values in here:
|
|
|
|
``` haskell
|
|
oidcConf :: OIDCConf
|
|
oidcConf = OIDCConf { redirectUri = "http://localhost:3000/login/cb"
|
|
, clientId = "xxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com"
|
|
, clientPassword = "************************" }
|
|
```
|
|
|
|
Then we declare our main server:
|
|
|
|
``` haskell
|
|
main :: IO ()
|
|
main = do
|
|
oidcEnv <- initOIDC oidcConf
|
|
run 3000 (app oidcEnv)
|
|
|
|
type API = IdentityRoutes Customer
|
|
:<|> Get '[HTML] Homepage
|
|
|
|
api :: Proxy API
|
|
api = Proxy
|
|
|
|
server :: OIDCEnv -> Server API
|
|
server oidcEnv = serveOIDC oidcEnv handleOIDCLogin
|
|
:<|> return Homepage
|
|
|
|
-- | Then main app
|
|
app :: OIDCEnv -> Application
|
|
app oidcEnv = serve api (server oidcEnv)
|
|
```
|
|
|
|
OIDC
|
|
----
|
|
|
|
That part try to separate concern, and certainly in a real world
|
|
application that should be in its distinct module.
|
|
|
|
``` haskell
|
|
-- * OIDC
|
|
|
|
data OIDCConf =
|
|
OIDCConf { redirectUri :: ByteString
|
|
, clientId :: ByteString
|
|
, clientPassword :: ByteString
|
|
} deriving (Show, Eq)
|
|
```
|
|
|
|
First we need to initialize OIDC.
|
|
A short explanation about it:
|
|
|
|
- to complete the workflow we need to make a POST request to the OIDC provider.
|
|
So we need to create an http manager to make those call properly.
|
|
- Then in order to prevent replay attack, each time an user wants to login we
|
|
should provide a random string called the `state`. When the user is
|
|
redirected to the `redirect_uri`, the OIDC provider should provide the same
|
|
`state` along a `code` parameter.
|
|
|
|
``` haskell
|
|
initOIDC :: OIDCConf -> IO OIDCEnv
|
|
initOIDC OIDCConf{..} = do
|
|
mgr <- newManager tlsManagerSettings
|
|
prov <- O.discover "https://accounts.google.com" mgr
|
|
let oidc = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov)
|
|
return OIDCEnv { oidc = oidc
|
|
, mgr = mgr
|
|
, genState = genRandomBS
|
|
, prov = prov
|
|
, redirectUri = redirectUri
|
|
, clientId = clientId
|
|
, clientPassword = clientPassword
|
|
}
|
|
|
|
data OIDCEnv = OIDCEnv { oidc :: O.OIDC
|
|
, mgr :: Manager
|
|
, genState :: IO ByteString
|
|
, prov :: O.Provider
|
|
, redirectUri :: ByteString
|
|
, clientId :: ByteString
|
|
, clientPassword :: ByteString
|
|
}
|
|
```
|
|
|
|
The `IdentityRoutes` are two endpoints:
|
|
|
|
- an endpoint to redirect the users to the OIDC Provider,
|
|
- another one the user will be redirected to from the OIDC Provider.
|
|
|
|
``` haskell
|
|
type IdentityRoutes a =
|
|
"login" :> ( -- redirect User to the OpenID Provider
|
|
Get '[JSON] NoContent
|
|
-- render the page that will save the user creds in the user-agent
|
|
:<|> "cb" :> QueryParam "error" Text
|
|
:> QueryParam "code" Text
|
|
:> Get '[HTML] User)
|
|
|
|
-- | gen a 302 redirect helper
|
|
redirects :: (StringConv s ByteString) => s -> Handler ()
|
|
redirects url = throwError err302 { errHeaders = [("Location",toS url)]}
|
|
```
|
|
|
|
That function will generate the URL to redirect the users to when
|
|
they'll click on the login link: `https://yourdomain/login`.
|
|
|
|
``` haskell
|
|
genOIDCURL :: OIDCEnv -> IO ByteString
|
|
genOIDCURL OIDCEnv{..} = do
|
|
st <- genState -- generate a random string
|
|
let oidcCreds = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov)
|
|
loc <- O.getAuthenticationRequestUrl oidcCreds [O.openId, O.email, O.profile] (Just st) []
|
|
return (show loc)
|
|
|
|
handleLogin :: OIDCEnv -> Handler NoContent
|
|
handleLogin oidcenv = do
|
|
loc <- liftIO (genOIDCURL oidcenv)
|
|
redirects loc
|
|
return NoContent
|
|
```
|
|
|
|
The `AuthInfo` is about the infos we can grab from OIDC provider.
|
|
|
|
To be more precise, the user should come with a `code` (a token) and
|
|
POSTing that code to the correct OIDC provider endpoint should return a JSON
|
|
object. One of the fields should be named `id_token` which should be a
|
|
JWT containing all the information we need. Depending on the scopes we
|
|
asked we might get more information.
|
|
|
|
``` haskell
|
|
-- | @AuthInfo@
|
|
data AuthInfo = AuthInfo { email :: Text
|
|
, emailVerified :: Bool
|
|
, name :: Text } deriving (Eq, Show, Generic)
|
|
|
|
instance FromJSON AuthInfo where
|
|
parseJSON (JSON.Object v) = do
|
|
email :: Text <- v .: "email"
|
|
email_verified :: Bool <- v .: "email_verified"
|
|
name :: Text <- v .: "name"
|
|
return $ AuthInfo (toS email) email_verified (toS name)
|
|
parseJSON invalid = AeT.typeMismatch "Coord" invalid
|
|
instance JSON.ToJSON AuthInfo where
|
|
toJSON (AuthInfo e ev n) =
|
|
JSON.object [ "email" JSON..= (toS e :: Text)
|
|
, "email_verified" JSON..= ev
|
|
, "name" JSON..= (toS n :: Text)
|
|
]
|
|
|
|
type LoginHandler = AuthInfo -> IO (Either Text User)
|
|
```
|
|
|
|
The `handleLoggedIn` is that part that will retrieve the information from
|
|
the user once he is redirected from the OIDC Provider after login.
|
|
|
|
If the user is redirected to the `redirect_uri` but with an `error` query
|
|
parameter then it means something went wrong.
|
|
If there is no error query param but a `code` query param it means the user
|
|
successfully logged in. From there we need to make a request to the token
|
|
endpoint of the OIDC provider. It's a POST that should contain the code
|
|
as well as the client id and secret.
|
|
Making this HTTP POST is the responsibility of `requestTokens`.
|
|
|
|
From there we extract the `claims` of the JWT contained in one of the value
|
|
of the JSON returned by the POST HTTP Request.
|
|
|
|
``` haskell
|
|
data User = User { userId :: Text
|
|
, userSecret :: Text
|
|
, localStorageKey :: Text
|
|
, redirectUrl :: Maybe Text
|
|
} deriving (Show,Eq,Ord)
|
|
|
|
handleLoggedIn :: OIDCEnv
|
|
-> LoginHandler -- ^ handle successful id
|
|
-> Maybe Text -- ^ error
|
|
-> Maybe Text -- ^ code
|
|
-> Handler User
|
|
handleLoggedIn oidcenv handleSuccessfulId err mcode =
|
|
case err of
|
|
Just errorMsg -> forbidden errorMsg
|
|
Nothing -> case mcode of
|
|
Just oauthCode -> do
|
|
tokens <- liftIO $ O.requestTokens (oidc oidcenv) (toS oauthCode) (mgr oidcenv)
|
|
putText . show . O.claims . O.idToken $ tokens
|
|
let jwt = toS . unJwt . O.jwt . O.idToken $ tokens
|
|
eAuthInfo = decodeClaims jwt :: Either O.JwtError (O.JwtHeader,AuthInfo)
|
|
case eAuthInfo of
|
|
Left jwtErr -> forbidden $ "JWT decode/check problem: " <> show jwtErr
|
|
Right (_,authInfo) ->
|
|
if emailVerified authInfo
|
|
then do
|
|
user <- liftIO $ handleSuccessfulId authInfo
|
|
either forbidden return user
|
|
else forbidden "Please verify your email"
|
|
Nothing -> do
|
|
liftIO $ putText "No code param"
|
|
forbidden "no code parameter given"
|
|
```
|
|
|
|
When you render a User with blaze-html, it will generate a page with a js
|
|
that will put a secret for that user in the local storage. And it will
|
|
redirect the user to /.
|
|
|
|
``` haskell
|
|
instance ToMarkup User where
|
|
toMarkup User{..} = H.docTypeHtml $ do
|
|
H.head $
|
|
H.title "Logged In"
|
|
H.body $ do
|
|
H.h1 "Logged In"
|
|
H.p (H.toHtml ("Successful login with id " <> userId))
|
|
H.script (H.toHtml ("localStorage.setItem('" <> localStorageKey <> "','" <> userSecret <> "');"
|
|
<> "localStorage.setItem('user-id','" <> userId <> "');"
|
|
<> "window.location='" <> fromMaybe "/" redirectUrl <> "';" -- redirect the user to /
|
|
));
|
|
|
|
serveOIDC :: OIDCEnv -> LoginHandler -> Server (IdentityRoutes a)
|
|
serveOIDC oidcenv loginHandler =
|
|
handleLogin oidcenv :<|> handleLoggedIn oidcenv loginHandler
|
|
|
|
-- * Auth
|
|
type APIKey = ByteString
|
|
type Account = Text.Text
|
|
type Conf = [(APIKey,Account)]
|
|
data Customer = Customer {
|
|
account :: Account
|
|
, apiKey :: APIKey
|
|
, mail :: Maybe Text
|
|
, fullname :: Maybe Text
|
|
}
|
|
```
|
|
|
|
Here is the code that displays the homepage.
|
|
It should contain a link to the `/login` URL.
|
|
When the user clicks on this link it will be redirected to Google login page
|
|
with some generated information.
|
|
|
|
The page also displays the content of the local storage.
|
|
And in particular the items `api-key` and `user-id`.
|
|
Those items should be set after a successful login when the user is redirected to
|
|
`/login/cb`.
|
|
|
|
The logic used generally is to use that api-key to uniquely identify an user.
|
|
Another option would have been to set a cookie.
|
|
|
|
``` haskell
|
|
data Homepage = Homepage
|
|
|
|
instance ToMarkup Homepage where
|
|
toMarkup Homepage = H.docTypeHtml $ do
|
|
H.head $ do
|
|
H.title "OpenID Connect Servant Example"
|
|
H.style (H.toHtml ("body { font-family: monospace; font-size: 18px; }" :: Text.Text))
|
|
H.body $ do
|
|
H.h1 "OpenID Connect Servant Example"
|
|
H.div $
|
|
H.a ! HA.href "/login" $ "Click here to login"
|
|
H.ul $ do
|
|
H.li $ do
|
|
H.span "API Key in Local storage: "
|
|
H.script (H.toHtml ("document.write(localStorage.getItem('api-key'));" :: Text.Text))
|
|
H.li $ do
|
|
H.span "User ID in Local storage: "
|
|
H.script (H.toHtml ("document.write(localStorage.getItem('user-id'));" :: Text.Text))
|
|
```
|
|
|
|
We need some helpers to generate random string for generating state and API Keys.
|
|
|
|
``` haskell
|
|
-- | generate a random ByteString, not necessarily extremely good randomness
|
|
-- still the password will be long enough to be very difficult to crack
|
|
genRandomBS :: IO ByteString
|
|
genRandomBS = do
|
|
g <- Random.newStdGen
|
|
Random.randomRs (0, n) g & take 42 & fmap toChar & readable 0 & toS & return
|
|
where
|
|
n = length letters - 1
|
|
toChar i = letters List.!! i
|
|
letters = ['A'..'Z'] <> ['0'..'9'] <> ['a'..'z']
|
|
readable :: Int -> [Char] -> [Char]
|
|
readable _ [] = []
|
|
readable i str =
|
|
let blocksize = case n of
|
|
0 -> 8
|
|
1 -> 4
|
|
2 -> 4
|
|
3 -> 4
|
|
_ -> 12
|
|
block = take blocksize str
|
|
rest = drop blocksize str
|
|
in if List.null rest
|
|
then str
|
|
else block <> "-" <> readable (i+1) rest
|
|
|
|
customerFromAuthInfo :: AuthInfo -> IO Customer
|
|
customerFromAuthInfo authinfo = do
|
|
apikey <- genRandomBS
|
|
return Customer { account = toS (email authinfo)
|
|
, apiKey = apikey
|
|
, mail = Just (toS (email authinfo))
|
|
, fullname = Just (toS (name authinfo))
|
|
}
|
|
|
|
handleOIDCLogin :: LoginHandler
|
|
handleOIDCLogin authInfo = do
|
|
custInfo <- customerFromAuthInfo authInfo
|
|
if emailVerified authInfo
|
|
then return . Right . customerToUser $ custInfo
|
|
else return (Left "You emails is not verified by your provider. Please verify your email.")
|
|
where
|
|
customerToUser :: Customer -> User
|
|
customerToUser c =
|
|
User { userId = toS (account c)
|
|
, userSecret = toS (apiKey c)
|
|
, redirectUrl = Nothing
|
|
, localStorageKey = "api-key"
|
|
}
|
|
```
|
|
|
|
`Error` helpers
|
|
---------------
|
|
|
|
``` haskell
|
|
data Err = Err { errTitle :: Text
|
|
, errMsg :: Text }
|
|
|
|
instance ToMarkup Err where
|
|
toMarkup Err{..} = H.docTypeHtml $ do
|
|
H.head $ do
|
|
H.title "Error"
|
|
H.body $ do
|
|
H.h1 (H.a ! HA.href "/" $ "Home")
|
|
H.h2 (H.toHtml errTitle)
|
|
H.p (H.toHtml errMsg)
|
|
|
|
format :: ToMarkup a => a -> LBS.ByteString
|
|
format err = toMarkup err & renderMarkup
|
|
|
|
appToErr :: ServerError -> Text -> ServerError
|
|
appToErr x msg = x
|
|
{ errBody = toS $ format (Err (toS (errReasonPhrase x)) msg)
|
|
, errHeaders = [("Content-Type","text/html")]}
|
|
|
|
unauthorized :: (MonadError ServerError m) => Text -> m a
|
|
unauthorized = throwError . unauthorizedErr
|
|
|
|
unauthorizedErr :: Text -> ServerError
|
|
unauthorizedErr = appToErr err401
|
|
|
|
forbidden :: (MonadError ServerError m) => Text -> m a
|
|
forbidden = throwError . forbiddenErr
|
|
|
|
forbiddenErr :: Text -> ServerError
|
|
forbiddenErr = appToErr err403
|
|
|
|
notFound :: ( MonadError ServerError m) => Text -> m a
|
|
notFound = throwError . notFoundErr
|
|
|
|
notFoundErr :: Text -> ServerError
|
|
notFoundErr = appToErr err404
|
|
|
|
preconditionFailed :: ( MonadError ServerError m) => Text -> m a
|
|
preconditionFailed = throwError . preconditionFailedErr
|
|
|
|
preconditionFailedErr :: Text -> ServerError
|
|
preconditionFailedErr = appToErr err412
|
|
|
|
serverError :: ( MonadError ServerError m) => Text -> m a
|
|
serverError = throwError . serverErrorErr
|
|
|
|
serverErrorErr :: Text -> ServerError
|
|
serverErrorErr = appToErr err500
|
|
```
|