@@ -0,0 +1,472 @@
1+[OpenID Connect](https://openid.net/connect/)
2+=============================================
4+Use OpenID Connect to authenticate your users.
5+This example use google OIDC provider.
6+It was made for a working with single page application where
7+some login token would be saved in the user agent local storage.
11+1. user is presentend with a login button,
12+2. when the user click on the button it is redirected to the OIDC
14+3. the user login in the OIDC provider,
15+4. the OIDC provider will redirect the user and provide a `code`,
16+5. the server will use this code to make a POST to the OIDC provider
17+ and will get back authentication infos,
18+6. The user will get display an HTML page that will save a secret
19+ identifying him in the local storage, then it will be redirected to
22+Let's put the imports behind us:
25+{-# LANGUAGE DataKinds #-}
26+{-# LANGUAGE DeriveGeneric #-}
27+{-# LANGUAGE DuplicateRecordFields #-}
28+{-# LANGUAGE FlexibleContexts #-}
29+{-# LANGUAGE FlexibleInstances #-}
30+{-# LANGUAGE MultiParamTypeClasses #-}
31+{-# LANGUAGE NoImplicitPrelude #-}
32+{-# LANGUAGE OverloadedLists #-}
33+{-# LANGUAGE OverloadedStrings #-}
34+{-# LANGUAGE PartialTypeSignatures #-}
35+{-# LANGUAGE PolyKinds #-}
36+{-# LANGUAGE RankNTypes #-}
37+{-# LANGUAGE RecordWildCards #-}
38+{-# LANGUAGE ScopedTypeVariables #-}
39+{-# LANGUAGE TypeFamilies #-}
40+{-# LANGUAGE TypeOperators #-}
41+{-# LANGUAGE TypeSynonymInstances #-}
48+ (FromJSON (..), (.:))
49+import qualified Data.Aeson as JSON
50+import qualified Data.Aeson.Types as AeT
51+import qualified Data.ByteString.Lazy as LBS
52+import qualified Data.List as List
53+import qualified Data.Text as Text
55+ (Jwt (..), decodeClaims)
56+import Network.HTTP.Client
57+ (Manager, newManager)
58+import Network.HTTP.Client.TLS
60+import Network.Wai.Handler.Warp
63+import Servant.HTML.Blaze
65+import qualified System.Random as Random
68+import qualified Text.Blaze.Html as H
69+import Text.Blaze.Html5
71+import qualified Text.Blaze.Html5 as H
72+import qualified Text.Blaze.Html5.Attributes as HA
73+import Text.Blaze.Renderer.Utf8
75+import qualified Web.OIDC.Client as O
78+You'll need to create a new OpenID Connect client in an OpenID Provider.
79+This example was tested with Google.
81+You can find a list of public OIDC provider here:
82+https://connect2id.com/products/nimbus-oauth-openid-connect-sdk/openid-connect-providers
86+- Google: https://developers.google.com/identity/protocols/OpenIDConnect
87+ more precisely: https://console.developers.google.com/apis/credentials
88+- Microsoft: https://docs.microsoft.com/en-us/previous-versions/azure/dn645541(v=azure.100)
89+- Yahoo: https://developer.yahoo.com/oauth2/guide/openid_connect/
90+- PayPal: https://developer.paypal.com/docs/integration/direct/identity/log-in-with-paypal/
92+During the configuration you'll need to provide a redirect uri.
93+The redirect_uri should correspond to the uri user will be redirected to
94+after a successful login into the OpenID provider.
96+So during your test, you should certainly just use `http://localhost:3000/login/cb`.
97+In general you should use your own domain name.
99+You'll then be given a `client_id` and a `client_password`.
100+Fill those values in here:
104+oidcConf = OIDCConf { redirectUri = "http://localhost:3000/login/cb"
105+ , clientId = "xxxxxxxxxxxx-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx.apps.googleusercontent.com"
106+ , clientPassword = "************************" }
109+Then we declare our main server:
114+ oidcEnv <- initOIDC oidcConf
115+ run 3000 (app oidcEnv)
117+type API = IdentityRoutes Customer
118+ :<|> Get '[HTML] Homepage
123+server :: OIDCEnv -> Server API
124+server oidcEnv = serveOIDC oidcEnv handleOIDCLogin
125+ :<|> return Homepage
128+app :: OIDCEnv -> Application
129+app oidcEnv = serve api (server oidcEnv)
135+That part try to separate concern, and certainly in a real world
136+application that should be in its distinct module.
142+ OIDCConf { redirectUri :: ByteString
143+ , clientId :: ByteString
144+ , clientPassword :: ByteString
145+ } deriving (Show, Eq)
148+First we need to initialize OIDC.
149+A short explanation about it:
151+- to complete the workflow we need to make a POST request to the OIDC provider.
152+ So we need to create an http manager to make those call properly.
153+- Then in order to prevent replay attack, each time an user wants to login we
154+ should provide a random string called the `state`. When the user is
155+ redirected to the `redirect_uri`, the OIDC provider should provide the same
156+ `state` along a `code` parameter.
159+initOIDC :: OIDCConf -> IO OIDCEnv
160+initOIDC OIDCConf{..} = do
161+ mgr <- newManager tlsManagerSettings
162+ prov <- O.discover "https://accounts.google.com" mgr
163+ let oidc = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov)
164+ return OIDCEnv { oidc = oidc
166+ , genState = genRandomBS
168+ , redirectUri = redirectUri
169+ , clientId = clientId
170+ , clientPassword = clientPassword
173+data OIDCEnv = OIDCEnv { oidc :: O.OIDC
175+ , genState :: IO ByteString
176+ , prov :: O.Provider
177+ , redirectUri :: ByteString
178+ , clientId :: ByteString
179+ , clientPassword :: ByteString
183+The `IdentityRoutes` are two endpoints:
185+- an endpoint to redirect the users to the OIDC Provider,
186+- another one the user will be redirected to from the OIDC Provider.
189+type IdentityRoutes a =
190+ "login" :> ( -- redirect User to the OpenID Provider
191+ Get '[JSON] NoContent
192+ -- render the page that will save the user creds in the user-agent
193+ :<|> "cb" :> QueryParam "error" Text
194+ :> QueryParam "code" Text
195+ :> Get '[HTML] User)
197+-- | gen a 302 redirect helper
198+redirects :: (StringConv s ByteString) => s -> Handler ()
199+redirects url = throwError err302 { errHeaders = [("Location",toS url)]}
202+That function will generate the URL to redirect the users to when
203+they'll click on the login link: `https://yourdomain/login`.
206+genOIDCURL :: OIDCEnv -> IO ByteString
207+genOIDCURL OIDCEnv{..} = do
208+ st <- genState -- generate a random string
209+ let oidcCreds = O.setCredentials clientId clientPassword redirectUri (O.newOIDC prov)
210+ loc <- O.getAuthenticationRequestUrl oidcCreds [O.openId, O.email, O.profile] (Just st) []
213+handleLogin :: OIDCEnv -> Handler NoContent
214+handleLogin oidcenv = do
215+ loc <- liftIO (genOIDCURL oidcenv)
220+The `AuthInfo` is about the infos we can grab from OIDC provider.
222+To be more precise, the user should come with a `code` (a token) and
223+POSTing that code to the correct OIDC provider endpoint should return a JSON
224+object. One of the field should be named `id_token` which should be a
225+JWT containing all the informations we need. Depending on the scopes we
226+asked we might get more informations.
230+data AuthInfo = AuthInfo { email :: Text
231+ , emailVerified :: Bool
232+ , name :: Text } deriving (Eq, Show, Generic)
234+instance FromJSON AuthInfo where
235+ parseJSON (JSON.Object v) = do
236+ email :: Text <- v .: "email"
237+ email_verified :: Bool <- v .: "email_verified"
238+ name :: Text <- v .: "name"
239+ return $ AuthInfo (toS email) email_verified (toS name)
240+ parseJSON invalid = AeT.typeMismatch "Coord" invalid
241+instance JSON.ToJSON AuthInfo where
242+ toJSON (AuthInfo e ev n) =
243+ JSON.object [ "email" JSON..= (toS e :: Text)
244+ , "email_verified" JSON..= ev
245+ , "name" JSON..= (toS n :: Text)
248+type LoginHandler = AuthInfo -> IO (Either Text User)
251+The `handleLoggedIn` is that part that will retrieve the informations from
252+the user once he is redirected from the OIDC Provider after login.
254+If the user is redirected to the `redirect_uri` but with an `error` query
255+parameter then it means something goes wrong.
256+If there is no error query param but a `code` query param it means the user
257+sucessfully logged in. From there we need to make a request to the token
258+endpoint of the OIDC provider. Its a POST that should contains the code
259+as well as the client id & secret.
260+This is the role of the `requestTokens` to make this HTTP POST.
262+From there we extract the `claims` of the JWT contained in one of the value
263+of the JSON returned by the POST HTTP Request.
266+data User = User { userId :: Text
267+ , userSecret :: Text
268+ , localStorageKey :: Text
269+ , redirectUrl :: Maybe Text
270+ } deriving (Show,Eq,Ord)
272+handleLoggedIn :: OIDCEnv
273+ -> LoginHandler -- ^ handle successful id
274+ -> Maybe Text -- ^ error
275+ -> Maybe Text -- ^ code
277+handleLoggedIn oidcenv handleSuccessfulId err mcode =
279+ Just errorMsg -> forbidden errorMsg
280+ Nothing -> case mcode of
281+ Just oauthCode -> do
282+ tokens <- liftIO $ O.requestTokens (oidc oidcenv) (toS oauthCode) (mgr oidcenv)
283+ putText . show . O.claims . O.idToken $ tokens
284+ let jwt = toS . unJwt . O.jwt . O.idToken $ tokens
285+ eAuthInfo = decodeClaims jwt :: Either O.JwtError (O.JwtHeader,AuthInfo)
287+ Left jwtErr -> forbidden $ "JWT decode/check problem: " <> show jwtErr
288+ Right (_,authInfo) ->
289+ if emailVerified authInfo
291+ user <- liftIO $ handleSuccessfulId authInfo
292+ either forbidden return user
293+ else forbidden "Please verify your email"
295+ liftIO $ putText "No code param"
296+ forbidden "no code parameter given"
299+When you render a User with blaze-html, it will generate a page with a js
300+that will put a secret for that user in the local storage. And it will
301+redirect the user to /.
304+instance ToMarkup User where
305+ toMarkup User{..} = H.docTypeHtml $ do
310+ H.p (H.toHtml ("Successful login with id " <> userId))
311+ H.script (H.toHtml ("localStorage.setItem('" <> localStorageKey <> "','" <> userSecret <> "');"
312+ <> "localStorage.setItem('user-id','" <> userId <> "');"
313+ <> "window.location='" <> fromMaybe "/" redirectUrl <> "';" -- redirect the user to /
316+serveOIDC :: OIDCEnv -> LoginHandler -> Server (IdentityRoutes a)
317+serveOIDC oidcenv loginHandler =
318+ handleLogin oidcenv :<|> handleLoggedIn oidcenv loginHandler
321+type APIKey = ByteString
322+type Account = Text.Text
323+type Conf = [(APIKey,Account)]
324+data Customer = Customer {
327+ , mail :: Maybe Text
328+ , fullname :: Maybe Text
332+Here is the code that display the homepage.
333+It should contain a link to the the `/login` URL.
334+When the user will click on this link it will be redirected to Google login page
335+with some generated informations.
337+The page also display the content of the local storage.
338+And in particular the items `api-key` and `user-id`.
339+Those items should be set after a successful login when the user is redirected to
342+The logic used generally is to use that api-key to uniquely identify an user.
343+Another option would have been to set a cookie.
346+data Homepage = Homepage
348+instance ToMarkup Homepage where
349+ toMarkup Homepage = H.docTypeHtml $ do
351+ H.title "OpenID Connect Servant Example"
352+ H.style (H.toHtml ("body { font-family: monospace; font-size: 18px; }" :: Text.Text))
354+ H.h1 "OpenID Connect Servant Example"
356+ H.a ! HA.href "/login" $ "Click here to login"
359+ H.span "API Key in Local storage: "
360+ H.script (H.toHtml ("document.write(localStorage.getItem('api-key'));" :: Text.Text))
362+ H.span "User ID in Local storage: "
363+ H.script (H.toHtml ("document.write(localStorage.getItem('user-id'));" :: Text.Text))
366+We need some helpers to generate random string for generating state and API Keys.
369+-- | generate a random Bystestring, not necessarily extremely good randomness
370+-- still the password will be long enough to be very difficult to crack
371+genRandomBS :: IO ByteString
373+ g <- Random.newStdGen
374+ Random.randomRs (0, n) g & take 42 & fmap toChar & readable 0 & toS & return
376+ n = length letters - 1
377+ toChar i = letters List.!! i
378+ letters = ['A'..'Z'] <> ['0'..'9'] <> ['a'..'z']
379+ readable :: Int -> [Char] -> [Char]
382+ let blocksize = case n of
388+ block = take blocksize str
389+ rest = drop blocksize str
390+ in if List.null rest
392+ else block <> "-" <> readable (i+1) rest
394+customerFromAuthInfo :: AuthInfo -> IO Customer
395+customerFromAuthInfo authinfo = do
396+ apikey <- genRandomBS
397+ return Customer { account = toS (email authinfo)
399+ , mail = Just (toS (email authinfo))
400+ , fullname = Just (toS (name authinfo))
403+handleOIDCLogin :: LoginHandler
404+handleOIDCLogin authInfo = do
405+ custInfo <- customerFromAuthInfo authInfo
406+ if emailVerified authInfo
407+ then return . Right . customerToUser $ custInfo
408+ else return (Left "You emails is not verified by your provider. Please verify your email.")
410+ customerToUser :: Customer -> User
412+ User { userId = toS (account c)
413+ , userSecret = toS (apiKey c)
414+ , redirectUrl = Nothing
415+ , localStorageKey = "api-key"
423+data Err = Err { errTitle :: Text
426+instance ToMarkup Err where
427+ toMarkup Err{..} = H.docTypeHtml $ do
431+ H.h1 (H.a ! HA.href "/" $ "Home")
432+ H.h2 (H.toHtml errTitle)
433+ H.p (H.toHtml errMsg)
435+format :: ToMarkup a => a -> LBS.ByteString
436+format err = toMarkup err & renderMarkup
438+appToErr :: ServerError -> Text -> ServerError
440+ { errBody = toS $ format (Err (toS (errReasonPhrase x)) msg)
441+ , errHeaders = [("Content-Type","text/html")]}
443+unauthorized :: (MonadError ServerError m) => Text -> m a
444+unauthorized = throwError . unauthorizedErr
446+unauthorizedErr :: Text -> ServerError
447+unauthorizedErr = appToErr err401
449+forbidden :: (MonadError ServerError m) => Text -> m a
450+forbidden = throwError . forbiddenErr
452+forbiddenErr :: Text -> ServerError
453+forbiddenErr = appToErr err403
455+notFound :: ( MonadError ServerError m) => Text -> m a
456+notFound = throwError . notFoundErr
458+notFoundErr :: Text -> ServerError
459+notFoundErr = appToErr err404
461+preconditionFailed :: ( MonadError ServerError m) => Text -> m a
462+preconditionFailed = throwError . preconditionFailedErr
464+preconditionFailedErr :: Text -> ServerError
465+preconditionFailedErr = appToErr err412
467+serverError :: ( MonadError ServerError m) => Text -> m a
468+serverError = throwError . serverErrorErr
470+serverErrorErr :: Text -> ServerError
471+serverErrorErr = appToErr err500