Display prettier credentials information

This commit is contained in:
patrick brisbin 2018-02-08 09:31:23 -08:00
parent 72c64102b0
commit a7bc7c51e3
2 changed files with 37 additions and 3 deletions

View File

@ -3,6 +3,7 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
-- | -- |
@ -20,9 +21,15 @@
-- --
module Main where 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.Monoid ((<>))
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8)
import LoadEnv import LoadEnv
import Network.HTTP.Conduit import Network.HTTP.Conduit
import Network.Wai.Handler.Warp (runEnv) import Network.Wai.Handler.Warp (runEnv)
@ -81,13 +88,37 @@ getRootR :: Handler Html
getRootR = do getRootR = do
sess <- getSession 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| defaultLayout [whamlet|
<h1>Yesod Auth OAuth2 Example <h1>Yesod Auth OAuth2 Example
<h2> <h2>
<a href=@{AuthR LoginR}>Log in <a href=@{AuthR LoginR}>Log in
<h2>Session Information
<pre style="word-wrap: break-word;"> <h2>Credentials
#{show sess}
<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 mkFoundation :: IO App

View File

@ -44,6 +44,9 @@ executables:
- -with-rtsopts=-N - -with-rtsopts=-N
dependencies: dependencies:
- yesod-auth-oauth2 - yesod-auth-oauth2
- aeson
- aeson-pretty
- bytestring
- containers - containers
- http-conduit - http-conduit
- load-env - load-env