From a7bc7c51e3f4667f27d07af8e99210b9bf91ab55 Mon Sep 17 00:00:00 2001
From: patrick brisbin <pbrisbin@gmail.com>
Date: Thu, 8 Feb 2018 09:31:23 -0800
Subject: [PATCH] Display prettier credentials information

---
 example/Main.hs | 37 ++++++++++++++++++++++++++++++++++---
 package.yaml    |  3 +++
 2 files changed, 37 insertions(+), 3 deletions(-)

diff --git a/example/Main.hs b/example/Main.hs
index ec5f95a..6250682 100644
--- a/example/Main.hs
+++ b/example/Main.hs
@@ -3,6 +3,7 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -20,9 +21,15 @@
 --
 module Main where
 
+import Data.Aeson
+import Data.Aeson.Encode.Pretty
+import Data.ByteString.Lazy (fromStrict, toStrict)
+import qualified Data.Map as M
+import Data.Maybe (fromJust)
 import Data.Monoid ((<>))
 import Data.Text (Text)
 import qualified Data.Text as T
+import Data.Text.Encoding (decodeUtf8)
 import LoadEnv
 import Network.HTTP.Conduit
 import Network.Wai.Handler.Warp (runEnv)
@@ -81,13 +88,37 @@ getRootR :: Handler Html
 getRootR = do
     sess <- getSession
 
+    let
+        prettify
+            = decodeUtf8
+            . toStrict
+            . encodePretty
+            . fromJust
+            . decode @Value
+            . fromStrict
+
+        mCredsIdent = decodeUtf8 <$> M.lookup "credsIdent" sess
+        mCredsPlugin = decodeUtf8 <$> M.lookup "credsPlugin" sess
+        mAccessToken = decodeUtf8 <$> M.lookup "accessToken" sess
+        mUserResponse = prettify <$> M.lookup "userResponse" sess
+
     defaultLayout [whamlet|
         <h1>Yesod Auth OAuth2 Example
         <h2>
             <a href=@{AuthR LoginR}>Log in
-        <h2>Session Information
-        <pre style="word-wrap: break-word;">
-            #{show sess}
+
+        <h2>Credentials
+
+        <h3>Plugin / Ident
+        <p>#{show mCredsPlugin} / #{show mCredsIdent}
+
+        <h3>Access Token
+        <p>#{show mAccessToken}
+
+        <h3>User Response
+        <pre>
+            $maybe userResponse <- mUserResponse
+                #{userResponse}
     |]
 
 mkFoundation :: IO App
diff --git a/package.yaml b/package.yaml
index a44f99b..a664f1a 100644
--- a/package.yaml
+++ b/package.yaml
@@ -44,6 +44,9 @@ executables:
       - -with-rtsopts=-N
     dependencies:
       - yesod-auth-oauth2
+      - aeson
+      - aeson-pretty
+      - bytestring
       - containers
       - http-conduit
       - load-env