{-# LANGUAGE QuasiQuotes #-}
module Yesod.Auth.LTI13 (
authLTI13
, authLTI13WithWidget
, YesodAuthLTI13(..)
, getLtiIss
, getLtiSub
, getLtiToken
, LtiTokenClaims(..)
, UncheckedLtiTokenClaims(..)
, ContextClaim(..)
, LisClaim(..)
, Role(..)
, anonymizeLtiTokenForLogging
, AnonymizedLtiTokenClaims(..)
, PlatformInfo(..)
, Issuer
, ClientId
, Nonce
) where
import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Crypto.PubKey.RSA as RSA
import Crypto.Random (getRandomBytes)
import qualified Data.Aeson as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base64.URL as B64
import Data.ByteString.Builder (toLazyByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map.Strict as Map
import Data.Text (Text)
import qualified Data.Text.Encoding as E
import Data.Time (getCurrentTime)
import Jose.Jwa (Alg (Signed), JwsAlg (RS256))
import Jose.Jwk (Jwk (..), JwkSet (..),
KeyUse (Sig), generateRsaKeyPair)
import Jose.Jwt (KeyId (UTCKeyId))
import Prelude
import Web.LTI13
import Web.OIDC.Client (Nonce)
import Web.OIDC.Client.Tokens (IdTokenClaims (..))
import Yesod.Auth (Auth, AuthHandler, AuthPlugin (..),
Creds (..), Route (PluginR),
YesodAuth, authHttpManager,
setCredsRedirect)
import Yesod.Core (MonadHandler,
YesodRequest (reqGetParams),
deleteSession, getRequest,
getUrlRender, lookupSession,
lookupSessionBS, notFound,
permissionDenied, redirect,
runRequestBody, setSession,
setSessionBS, toTypedContent)
import Yesod.Core.Handler (getRouteToParent, sendResponseStatus)
import Yesod.Core.Types (TypedContent)
import Yesod.Core.Widget
import Network.HTTP.Types (unauthorized401, badRequest400)
import qualified Data.Text as T
import UnliftIO.Exception (Exception, throwIO, catch)
import Control.Monad (guard)
data YesodAuthLTI13Exception
= LTIException Text LTI13Exception
| BadRequest Text Text
| CorruptJwks Text Text
deriving stock (Int -> YesodAuthLTI13Exception -> ShowS
[YesodAuthLTI13Exception] -> ShowS
YesodAuthLTI13Exception -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [YesodAuthLTI13Exception] -> ShowS
$cshowList :: [YesodAuthLTI13Exception] -> ShowS
show :: YesodAuthLTI13Exception -> String
$cshow :: YesodAuthLTI13Exception -> String
showsPrec :: Int -> YesodAuthLTI13Exception -> ShowS
$cshowsPrec :: Int -> YesodAuthLTI13Exception -> ShowS
Show)
instance Exception YesodAuthLTI13Exception
dispatchAuthRequest
:: YesodAuthLTI13 master
=> PluginName
-> Text
-> [Text]
-> AuthHandler master TypedContent
dispatchAuthRequest :: forall master.
YesodAuthLTI13 master =>
Text -> Text -> [Text] -> AuthHandler master TypedContent
dispatchAuthRequest Text
name Text
"GET" [Text
"initiate"] =
forall (m :: * -> *). MonadHandler m => Method -> m RequestParams
unifyParams Method
GET forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall master.
YesodAuthLTI13 master =>
Text -> RequestParams -> AuthHandler master TypedContent
dispatchInitiate Text
name
dispatchAuthRequest Text
name Text
"POST" [Text
"initiate"] =
forall (m :: * -> *). MonadHandler m => Method -> m RequestParams
unifyParams Method
POST forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall master.
YesodAuthLTI13 master =>
Text -> RequestParams -> AuthHandler master TypedContent
dispatchInitiate Text
name
dispatchAuthRequest Text
name Text
"POST" [Text
"authenticate"] =
forall m. YesodAuthLTI13 m => Text -> AuthHandler m TypedContent
dispatchAuthenticate Text
name
dispatchAuthRequest Text
name Text
"GET" [Text
"jwks"] =
forall m. YesodAuthLTI13 m => Text -> AuthHandler m TypedContent
dispatchJwks Text
name
dispatchAuthRequest Text
_ Text
_ [Text]
_ = forall (m :: * -> *) a. MonadHandler m => m a
notFound
data Method = GET
| POST
unifyParams
:: MonadHandler m
=> Method
-> m RequestParams
unifyParams :: forall (m :: * -> *). MonadHandler m => Method -> m RequestParams
unifyParams Method
GET = do
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. YesodRequest -> [(Text, Text)]
reqGetParams forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadHandler m => m YesodRequest
getRequest
unifyParams Method
POST = do
([(Text, Text)]
params, [(Text, FileInfo)]
_) <- forall (m :: * -> *).
MonadHandler m =>
m ([(Text, Text)], [(Text, FileInfo)])
runRequestBody
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
params
prefixSession :: Text -> Text -> Text
prefixSession :: Text -> Text -> Text
prefixSession Text
name Text
datum =
Text
"_lti13_" forall a. Semigroup a => a -> a -> a
<> Text
name forall a. Semigroup a => a -> a -> a
<> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
datum
myCid :: Text -> Text
myCid :: Text -> Text
myCid = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
prefixSession Text
"clientId"
myIss :: Text -> Text
myIss :: Text -> Text
myIss = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
prefixSession Text
"iss"
myState :: Text -> Text
myState :: Text -> Text
myState = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
prefixSession Text
"state"
myNonce :: Text -> Text
myNonce :: Text -> Text
myNonce = forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> Text -> Text
prefixSession Text
"nonce"
mkSessionStore :: MonadHandler m => Text -> SessionStore m
mkSessionStore :: forall (m :: * -> *). MonadHandler m => Text -> SessionStore m
mkSessionStore Text
name =
SessionStore
{ sessionStoreGenerate :: m ByteString
sessionStoreGenerate = m ByteString
gen
, sessionStoreSave :: ByteString -> ByteString -> m ()
sessionStoreSave = ByteString -> ByteString -> m ()
sessionSave
, sessionStoreGet :: ByteString -> m (Maybe ByteString)
sessionStoreGet = ByteString -> m (Maybe ByteString)
sessionGet
, sessionStoreDelete :: m ()
sessionStoreDelete = m ()
sessionDelete
}
where
gen :: m ByteString
gen = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ByteString -> ByteString
B64.encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
33)
sname :: Text
sname = Text -> Text
myState Text
name
nname :: Text
nname = Text -> Text
myNonce Text
name
sessionSave :: ByteString -> ByteString -> m ()
sessionSave ByteString
state ByteString
nonce = do
forall (m :: * -> *). MonadHandler m => Text -> ByteString -> m ()
setSessionBS Text
sname ByteString
state
forall (m :: * -> *). MonadHandler m => Text -> ByteString -> m ()
setSessionBS Text
nname ByteString
nonce
forall (m :: * -> *) a. Monad m => a -> m a
return ()
sessionGet :: ByteString -> m (Maybe ByteString)
sessionGet ByteString
givenState = do
Maybe ByteString
state_ <- forall (m :: * -> *).
MonadHandler m =>
Text -> m (Maybe ByteString)
lookupSessionBS Text
sname
Maybe ByteString
nonce <- forall (m :: * -> *).
MonadHandler m =>
Text -> m (Maybe ByteString)
lookupSessionBS Text
nname
forall (m :: * -> *) a. Monad m => a -> m a
return do
ByteString
state <- Maybe ByteString
state_
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString
givenState forall a. Eq a => a -> a -> Bool
== ByteString
state
Maybe ByteString
nonce
sessionDelete :: m ()
sessionDelete = do
forall (m :: * -> *). MonadHandler m => Text -> m ()
deleteSession Text
sname
forall (m :: * -> *). MonadHandler m => Text -> m ()
deleteSession Text
nname
type PluginName = Text
makeCfg
:: MonadHandler m
=> PluginName
-> ((Issuer, Maybe ClientId) -> m PlatformInfo)
-> (Nonce -> m Bool)
-> Text
-> AuthFlowConfig m
makeCfg :: forall (m :: * -> *).
MonadHandler m =>
Text
-> ((Text, Maybe Text) -> m PlatformInfo)
-> (ByteString -> m Bool)
-> Text
-> AuthFlowConfig m
makeCfg Text
name (Text, Maybe Text) -> m PlatformInfo
pinfo ByteString -> m Bool
seenNonce Text
callback =
AuthFlowConfig
{ getPlatformInfo :: (Text, Maybe Text) -> m PlatformInfo
getPlatformInfo = (Text, Maybe Text) -> m PlatformInfo
pinfo
, haveSeenNonce :: ByteString -> m Bool
haveSeenNonce = ByteString -> m Bool
seenNonce
, myRedirectUri :: Text
myRedirectUri = Text
callback
, sessionStore :: SessionStore m
sessionStore = forall (m :: * -> *). MonadHandler m => Text -> SessionStore m
mkSessionStore Text
name
}
createNewJwk :: IO Jwk
createNewJwk :: IO Jwk
createNewJwk = do
KeyId
kid <- UTCTime -> KeyId
UTCKeyId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime
getCurrentTime
let use :: KeyUse
use = KeyUse
Sig
alg :: Alg
alg = JwsAlg -> Alg
Signed JwsAlg
RS256
(Jwk
_, Jwk
priv) <- forall (m :: * -> *).
MonadRandom m =>
Int -> KeyId -> KeyUse -> Maybe Alg -> m (Jwk, Jwk)
generateRsaKeyPair Int
256 KeyId
kid KeyUse
use forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Alg
alg
forall (m :: * -> *) a. Monad m => a -> m a
return Jwk
priv
dispatchJwks
:: YesodAuthLTI13 master
=> PluginName
-> AuthHandler master TypedContent
dispatchJwks :: forall m. YesodAuthLTI13 m => Text -> AuthHandler m TypedContent
dispatchJwks Text
name = do
ByteString
jwks <- forall site.
YesodAuthLTI13 site =>
IO ByteString -> AuthHandler site ByteString
retrieveOrInsertJwks IO ByteString
makeJwks
JwkSet [Jwk]
privs <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> Text -> YesodAuthLTI13Exception
CorruptJwks Text
name Text
"json decode failed")
forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict ByteString
jwks)
let pubs :: JwkSet
pubs = [Jwk] -> JwkSet
JwkSet forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Jwk -> Jwk
rsaPrivToPub [Jwk]
privs
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToTypedContent a => a -> TypedContent
toTypedContent forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
A.toJSON JwkSet
pubs
where makeJwks :: IO ByteString
makeJwks = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
A.encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO JwkSet
makeJwkSet
makeJwkSet :: IO JwkSet
makeJwkSet = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Jwk
jwk -> JwkSet {keys :: [Jwk]
keys = [Jwk
jwk]}) IO Jwk
createNewJwk
rsaPrivToPub :: Jwk -> Jwk
rsaPrivToPub :: Jwk -> Jwk
rsaPrivToPub (RsaPrivateJwk PrivateKey
privKey Maybe KeyId
mId Maybe KeyUse
mUse Maybe Alg
mAlg) =
PublicKey -> Maybe KeyId -> Maybe KeyUse -> Maybe Alg -> Jwk
RsaPublicJwk (PrivateKey -> PublicKey
RSA.private_pub PrivateKey
privKey) Maybe KeyId
mId Maybe KeyUse
mUse Maybe Alg
mAlg
rsaPrivToPub Jwk
_ = forall a. HasCallStack => String -> a
error String
"rsaPrivToPub called on a Jwk that's not a RsaPrivateJwk"
lti13ExceptionToYesod :: (MonadHandler m) => LTI13Exception -> m a
lti13ExceptionToYesod :: forall (m :: * -> *) a. MonadHandler m => LTI13Exception -> m a
lti13ExceptionToYesod e :: LTI13Exception
e@(InvalidHandshake Text
_) = forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
badRequest400 (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ LTI13Exception
e)
lti13ExceptionToYesod e :: LTI13Exception
e@(InvalidLtiToken Text
_) = forall (m :: * -> *) c a.
(MonadHandler m, ToTypedContent c) =>
Status -> c -> m a
sendResponseStatus Status
unauthorized401 (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ LTI13Exception
e)
lti13ExceptionToYesod e :: LTI13Exception
e@(DiscoveryException Text
_) = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO LTI13Exception
e
lti13ExceptionToYesod e :: LTI13Exception
e@(GotHttpException HttpException
_) = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO LTI13Exception
e
dispatchInitiate
:: (YesodAuthLTI13 master)
=> PluginName
-> RequestParams
-> AuthHandler master TypedContent
dispatchInitiate :: forall master.
YesodAuthLTI13 master =>
Text -> RequestParams -> AuthHandler master TypedContent
dispatchInitiate Text
name RequestParams
params = do
let url :: Route Auth
url = Text -> [Text] -> Route Auth
PluginR Text
name [Text
"authenticate"]
Route Auth -> Route master
tm <- forall (m :: * -> *).
MonadHandler m =>
m (Route (SubHandlerSite m) -> Route (HandlerSite m))
getRouteToParent
Route master -> Text
render <- forall (m :: * -> *).
MonadHandler m =>
m (Route (HandlerSite m) -> Text)
getUrlRender
let authUrl :: Text
authUrl = Route master -> Text
render forall a b. (a -> b) -> a -> b
$ Route Auth -> Route master
tm Route Auth
url
let cfg :: AuthFlowConfig m
cfg = forall (m :: * -> *).
MonadHandler m =>
Text
-> ((Text, Maybe Text) -> m PlatformInfo)
-> (ByteString -> m Bool)
-> Text
-> AuthFlowConfig m
makeCfg Text
name forall site.
YesodAuthLTI13 site =>
(Text, Maybe Text) -> AuthHandler site PlatformInfo
retrievePlatformInfo forall site.
YesodAuthLTI13 site =>
ByteString -> AuthHandler site Bool
checkSeenNonce Text
authUrl
(Text
iss, Text
cid, Text
redir) <- forall (m :: * -> *).
MonadIO m =>
AuthFlowConfig m -> RequestParams -> m (Text, Text, Text)
initiate AuthFlowConfig m
cfg RequestParams
params forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` forall (m :: * -> *) a. MonadHandler m => LTI13Exception -> m a
lti13ExceptionToYesod
forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
setSession (Text -> Text
myIss Text
name) Text
iss
forall (m :: * -> *). MonadHandler m => Text -> Text -> m ()
setSession (Text -> Text
myCid Text
name) Text
cid
forall (m :: * -> *) url a.
(MonadHandler m, RedirectUrl (HandlerSite m) url) =>
url -> m a
redirect Text
redir
type State = Text
checkCSRFToken :: MonadHandler m => State -> Maybe State -> m ()
checkCSRFToken :: forall (m :: * -> *). MonadHandler m => Text -> Maybe Text -> m ()
checkCSRFToken Text
state Maybe Text
state' =
if Maybe Text
state' forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just Text
state then do
forall (m :: * -> *) a. MonadHandler m => Text -> m a
permissionDenied Text
"Bad CSRF token"
else
forall (m :: * -> *) a. Monad m => a -> m a
return ()
makeUserId :: Issuer -> Text -> Text
makeUserId :: Text -> Text -> Text
makeUserId Text
iss Text
name = Text
name forall a. Semigroup a => a -> a -> a
<> Text
"@@" forall a. Semigroup a => a -> a -> a
<> Text
iss
dispatchAuthenticate :: YesodAuthLTI13 m => PluginName -> AuthHandler m TypedContent
dispatchAuthenticate :: forall m. YesodAuthLTI13 m => Text -> AuthHandler m TypedContent
dispatchAuthenticate Text
name = do
Manager
mgr <- forall master (m :: * -> *).
(YesodAuth master, MonadHandler m, HandlerSite m ~ master) =>
m Manager
authHttpManager
Maybe Text
maybeIss <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession forall a b. (a -> b) -> a -> b
$ Text -> Text
myIss Text
name
Text
iss <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ Text -> Text -> YesodAuthLTI13Exception
BadRequest Text
name Text
"missing `iss` cookie")
forall (f :: * -> *) a. Applicative f => a -> f a
pure
Maybe Text
maybeIss
Maybe Text
cid <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession forall a b. (a -> b) -> a -> b
$ Text -> Text
myCid Text
name
forall (m :: * -> *). MonadHandler m => Text -> m ()
deleteSession forall a b. (a -> b) -> a -> b
$ Text -> Text
myIss Text
name
forall (m :: * -> *). MonadHandler m => Text -> m ()
deleteSession forall a b. (a -> b) -> a -> b
$ Text -> Text
myCid Text
name
Maybe Text
state' <- forall (m :: * -> *). MonadHandler m => Text -> m (Maybe Text)
lookupSession forall a b. (a -> b) -> a -> b
$ Text -> Text
myState Text
name
PlatformInfo
pinfo <- forall site.
YesodAuthLTI13 site =>
(Text, Maybe Text) -> AuthHandler site PlatformInfo
retrievePlatformInfo (Text
iss, Maybe Text
cid)
let cfg :: AuthFlowConfig m
cfg = forall (m :: * -> *).
MonadHandler m =>
Text
-> ((Text, Maybe Text) -> m PlatformInfo)
-> (ByteString -> m Bool)
-> Text
-> AuthFlowConfig m
makeCfg Text
name forall site.
YesodAuthLTI13 site =>
(Text, Maybe Text) -> AuthHandler site PlatformInfo
retrievePlatformInfo forall site.
YesodAuthLTI13 site =>
ByteString -> AuthHandler site Bool
checkSeenNonce forall a. HasCallStack => a
undefined
([(Text, Text)]
params', [(Text, FileInfo)]
_) <- forall (m :: * -> *).
MonadHandler m =>
m ([(Text, Text)], [(Text, FileInfo)])
runRequestBody
let params :: RequestParams
params = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Text)]
params'
(Text
state, IdTokenClaims LtiTokenClaims
tok) <- forall (m :: * -> *).
MonadIO m =>
Manager
-> AuthFlowConfig m
-> RequestParams
-> PlatformInfo
-> m (Text, IdTokenClaims LtiTokenClaims)
handleAuthResponse Manager
mgr AuthFlowConfig m
cfg RequestParams
params PlatformInfo
pinfo
forall (m :: * -> *). MonadHandler m => Text -> Maybe Text -> m ()
checkCSRFToken Text
state Maybe Text
state'
let LtiTokenClaims UncheckedLtiTokenClaims
ltiClaims = forall a. IdTokenClaims a -> a
otherClaims IdTokenClaims LtiTokenClaims
tok
ltiClaimsJson :: Text
ltiClaimsJson = ByteString -> Text
E.decodeUtf8 forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
A.encode UncheckedLtiTokenClaims
ltiClaims
let IdTokenClaims { Text
sub :: forall a. IdTokenClaims a -> Text
sub :: Text
sub } = IdTokenClaims LtiTokenClaims
tok
myCreds :: Creds m
myCreds = Creds {
credsPlugin :: Text
credsPlugin = Text
name
, credsIdent :: Text
credsIdent = Text -> Text -> Text
makeUserId Text
iss Text
sub
, credsExtra :: [(Text, Text)]
credsExtra = [(Text
"ltiIss", Text
iss), (Text
"ltiSub", Text
sub), (Text
"ltiToken", Text
ltiClaimsJson)]
}
forall (m :: * -> *).
(MonadHandler m, YesodAuth (HandlerSite m)) =>
Creds (HandlerSite m) -> m TypedContent
setCredsRedirect Creds m
myCreds
type = [(Text, Text)]
getLtiIss :: CredsExtra -> Maybe Issuer
getLtiIss :: [(Text, Text)] -> Maybe Text
getLtiIss = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"ltiIss"
getLtiSub :: CredsExtra -> Maybe Issuer
getLtiSub :: [(Text, Text)] -> Maybe Text
getLtiSub = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"ltiSub"
getLtiToken :: CredsExtra -> Maybe LtiTokenClaims
getLtiToken :: [(Text, Text)] -> Maybe LtiTokenClaims
getLtiToken [(Text, Text)]
crExtra =
UncheckedLtiTokenClaims -> LtiTokenClaims
LtiTokenClaims forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Text
"ltiToken" [(Text, Text)]
crExtra forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe UncheckedLtiTokenClaims
intoClaims)
where
intoClaims :: Text -> Maybe UncheckedLtiTokenClaims
intoClaims :: Text -> Maybe UncheckedLtiTokenClaims
intoClaims = forall a. FromJSON a => ByteString -> Maybe a
A.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
E.encodeUtf8Builder
class (YesodAuth site)
=> YesodAuthLTI13 site where
checkSeenNonce :: Nonce -> AuthHandler site Bool
retrievePlatformInfo :: (Issuer, Maybe ClientId) -> AuthHandler site PlatformInfo
retrieveOrInsertJwks
:: IO BS.ByteString
-> AuthHandler site BS.ByteString
authLTI13 :: YesodAuthLTI13 m => AuthPlugin m
authLTI13 :: forall m. YesodAuthLTI13 m => AuthPlugin m
authLTI13 = forall m.
YesodAuthLTI13 m =>
((Route Auth -> Route m) -> WidgetFor m ()) -> AuthPlugin m
authLTI13WithWidget forall {p} {site} {m :: * -> *}. p -> WidgetT site m ()
login
where
login :: p -> WidgetT site m ()
login p
_ = [whamlet|<p>Go to your Learning Management System to log in via LTI 1.3|]
authLTI13WithWidget :: YesodAuthLTI13 m => ((Route Auth -> Route m) -> WidgetFor m ()) -> AuthPlugin m
authLTI13WithWidget :: forall m.
YesodAuthLTI13 m =>
((Route Auth -> Route m) -> WidgetFor m ()) -> AuthPlugin m
authLTI13WithWidget (Route Auth -> Route m) -> WidgetFor m ()
login =
forall master.
Text
-> (Text -> [Text] -> AuthHandler master TypedContent)
-> ((Route Auth -> Route master) -> WidgetFor master ())
-> AuthPlugin master
AuthPlugin Text
name (forall master.
YesodAuthLTI13 master =>
Text -> Text -> [Text] -> AuthHandler master TypedContent
dispatchAuthRequest Text
name) (Route Auth -> Route m) -> WidgetFor m ()
login
where
name :: Text
name = Text
"lti13"