OpenID 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:

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

oidcConf :: OIDCConf
oidcConf = OIDCConf { redirectUri = "http://localhost:3000/login/cb"
                    , clientId = "xxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com"
                    , clientPassword = "************************" }

Then we declare our main server:

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.

-- * 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.
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.
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.

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.

-- | @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.

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 /.

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.

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.

-- | 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

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