summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjade <>2020-09-15 21:41:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-09-15 21:41:00 (GMT)
commit33ea2f5e5a75bfb0ad95a2ae0c1cbce719f50a00 (patch)
treea3e703b55fcc767d89d54bda31bd034615ad9dbc
version 0.1.1.00.1.1.0
-rwxr-xr-xCHANGELOG.md10
-rw-r--r--LICENSE165
-rwxr-xr-xREADME.md24
-rw-r--r--Setup.hs2
-rw-r--r--example/Main.hs139
-rw-r--r--src/Yesod/Auth/LTI13.hs326
-rw-r--r--yesod-auth-lti13.cabal80
7 files changed, 746 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100755
index 0000000..06ee4f6
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,10 @@
+# Revision history for lti13
+
+## 0.1.0.0 -- 2020-08-13
+
+* Unreleased
+
+## 0.1.1.0 -- 2020-09-15
+
+* Handle Canvas Cloud setting all their issuers the same.
+* Remove dependency on changed jose-jwt. Thanks @tekul for the help on this.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..0a04128
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/README.md b/README.md
new file mode 100755
index 0000000..cfa2d6c
--- /dev/null
+++ b/README.md
@@ -0,0 +1,24 @@
+# yesod-auth-lti13
+
+A [lti13](https://hackage.haskell.org/package/lti13) based authentication
+provider for Yesod.
+
+## Usage
+
+Implement an `instance YesodAuthLTI13 App` for your Yesod site, using your
+persistence mechanisms. See the example for details.
+
+To build the example, pass `-f example` with your cabal commands. You can also
+`cabal configure -f example` to make it apply to commands by default (and also
+enable it for haskell-language-server).
+
+A sample configuration of the LTI 1.3 reference implementation for a site using
+this library is available here: https://lti-ri.imsglobal.org/platforms/1255/
+
+The following configuration is used on the provider (LMS) side, assuming your
+`AuthR` is `/auth`:
+
+* `oidc_initiation_url`: https://YOURAPPROOT/auth/page/lti13/initiate
+* `target_link_uri`: https://YOURAPPROOT
+* Public JWK URL: https://YOURAPPROOT/auth/page/lti13/jwks
+* Redirect URLs: https://YOURAPPROOT/auth/page/lti13/authenticate
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/example/Main.hs b/example/Main.hs
new file mode 100644
index 0000000..ff2322a
--- /dev/null
+++ b/example/Main.hs
@@ -0,0 +1,139 @@
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE LambdaCase #-}
+
+import qualified Data.ByteString as BS
+import qualified Data.Map as M
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.Set as Set
+import Data.IORef (readIORef, atomicModifyIORef', newIORef, IORef)
+import Data.Text.Encoding (decodeUtf8)
+import LoadEnv
+import Network.HTTP.Conduit
+import Network.Wai.Handler.Warp (runEnv)
+import Yesod
+import Yesod.Auth
+import Yesod.Auth.LTI13
+import System.IO.Unsafe (unsafePerformIO)
+
+
+type SeenNonces = Set.Set Nonce
+
+data App = App
+ { appHttpManager :: Manager
+ , appAuthPlugins :: [AuthPlugin App]
+ }
+
+mkYesod "App" [parseRoutes|
+ / RootR GET
+ /auth AuthR Auth getAuth
+|]
+
+instance Yesod App where
+ approot = ApprootStatic "http://localhost:3000"
+ shouldLogIO _ _ level = return $ level >= LevelDebug
+
+instance YesodAuth App where
+ type AuthId App = Text
+ loginDest _ = RootR
+ logoutDest _ = RootR
+
+ -- Disable any attempt to read persisted authenticated state
+ maybeAuthId = return Nothing
+
+ -- Copy the Creds response into the session for viewing after
+ authenticate c = do
+ mapM_ (uncurry setSession) $
+ [ ("credsIdent", credsIdent c)
+ , ("credsPlugin", credsPlugin c)
+ ] ++ credsExtra c
+
+ return $ Authenticated "1"
+
+ authPlugins = appAuthPlugins
+
+instance RenderMessage App FormMessage where
+ renderMessage _ _ = defaultFormMessage
+
+-- brittany-disable-next-binding
+
+getRootR :: Handler Html
+getRootR = do
+ sess <- getSession
+
+ let
+ mCredsIdent = decodeUtf8 <$> M.lookup "credsIdent" sess
+ mCredsPlugin = decodeUtf8 <$> M.lookup "credsPlugin" sess
+ mIss = getLtiIss sess
+ mSub = getLtiSub sess
+ mTok = getLtiToken sess
+
+ defaultLayout [whamlet|
+ <h1>Yesod Auth LTI1.3 Example
+ <h2>Credentials
+
+ <h3>Plugin / Ident
+ <p>#{show mCredsPlugin} / #{show mCredsIdent}
+
+ <h3>Issuer
+ <p>#{show mIss}
+
+ <h3>Subject
+ <p>#{show mSub}
+
+ <h3>Token info
+ <p>#{show mTok}
+
+ <h3>The entire session
+ <p>#{show $ M.toList sess}
+ |]
+
+-- This is strictly wrong but I have no idea how to properly get the state into
+-- the `instance YesodAuthLTI13 App` if I put it in the App. PRs welcome.
+seenNonces :: IORef SeenNonces
+seenNonces = unsafePerformIO $ newIORef Set.empty
+
+jwks :: IORef (Maybe BS.ByteString)
+jwks = unsafePerformIO $ newIORef Nothing
+
+instance YesodAuthLTI13 App where
+ checkSeenNonce nonce = do
+ -- how do I get the App in this function?! literally WHAT
+ seen <- liftIO $ atomicModifyIORef' seenNonces (\s -> (Set.insert nonce s, Set.member nonce s))
+ return seen
+
+ -- You should actually put a database here
+ retrievePlatformInfo ("aaaaa", Just "abcde") = return $ PlatformInfo {
+ platformIssuer = "aaaaa"
+ , platformClientId = "abcde"
+ , platformOidcAuthEndpoint = "https://lti-ri.imsglobal.org/platforms/1255/authorizations/new"
+ , jwksUrl = "https://lti-ri.imsglobal.org/platforms/1255/platform_keys/1248.json"
+ }
+ retrievePlatformInfo (iss, cid) = do
+ $logWarn $ "unknown platform " <> iss <> " with client id " <> (T.pack $ show cid)
+ liftIO $ fail "unknown platform"
+
+ retrieveOrInsertJwks new = do
+ -- possibly not thread safe. Also you should actually persist this.
+ cur <- liftIO $ readIORef jwks
+ makeIt <- liftIO $ maybe new pure cur
+ liftIO $ atomicModifyIORef' jwks
+ (\case
+ Nothing -> (Just makeIt, makeIt)
+ Just j -> (Just j, j))
+
+mkFoundation :: IO App
+mkFoundation = do
+ loadEnv
+ appHttpManager <- newManager tlsManagerSettings
+ appAuthPlugins <- return $ [ authLTI13 ]
+ return App {..}
+
+main :: IO ()
+main = runEnv 3000 =<< toWaiApp =<< mkFoundation
diff --git a/src/Yesod/Auth/LTI13.hs b/src/Yesod/Auth/LTI13.hs
new file mode 100644
index 0000000..1d6eacb
--- /dev/null
+++ b/src/Yesod/Auth/LTI13.hs
@@ -0,0 +1,326 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+
+-- | A Yesod authentication module for LTI 1.3
+-- See @example/Main.hs@ for a sample implementation.
+--
+-- Configuration:
+--
+-- * Login initiation URL: http://localhost:3000/auth/page/lti13/initiate
+--
+-- * JWKs URL: http://localhost:3000/auth/page/lti13/jwks
+--
+-- * Tool link URL: http://localhost:3000
+module Yesod.Auth.LTI13 (
+ PlatformInfo(..)
+ , Issuer
+ , ClientId
+ , Nonce
+ , authLTI13
+ , YesodAuthLTI13(..)
+ , getLtiIss
+ , getLtiSub
+ , getLtiToken
+ , LtiTokenClaims(..)
+ , UncheckedLtiTokenClaims(..)
+ , ContextClaim(..)
+ , Role(..)
+ ) where
+
+import Yesod.Core.Widget
+import Yesod.Auth (Route(PluginR), setCredsRedirect, Creds(..), authHttpManager, AuthHandler, AuthPlugin(..), YesodAuth)
+import Web.LTI13
+import qualified Data.Aeson as A
+import Data.Text (Text)
+import qualified Data.Map.Strict as Map
+import Crypto.Random (getRandomBytes)
+import qualified Crypto.PubKey.RSA as RSA
+import Yesod.Core.Types (TypedContent)
+import Yesod.Core (toTypedContent, permissionDenied, setSession, lookupSession, redirect,
+ deleteSession, lookupSessionBS, setSessionBS, runRequestBody,
+ getRequest, MonadHandler, SessionMap, notFound, getUrlRender)
+import qualified Data.ByteString.Base64.URL as B64
+import Web.OIDC.Client.Tokens (IdTokenClaims(..))
+import Yesod.Core (YesodRequest(reqGetParams))
+import Control.Exception.Safe (Exception, throwIO)
+import Control.Monad.IO.Class (MonadIO(liftIO))
+import Web.OIDC.Client (Nonce)
+import Yesod.Core.Handler (getRouteToParent)
+import qualified Data.Text.Encoding as E
+import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString as BS
+import Jose.Jwk (JwkSet(..), Jwk(..), generateRsaKeyPair, KeyUse(Sig))
+import Data.Time (getCurrentTime)
+import Jose.Jwt (KeyId(UTCKeyId))
+import Jose.Jwa (Alg(Signed), JwsAlg(RS256))
+
+data YesodAuthLTI13Exception
+ = LTIException Text LTI13Exception
+ -- ^ Issue with the token
+ -- Plugin name and the original exception
+ | BadRequest Text Text
+ -- ^ Issue with the request
+ -- Plugin name and an error message
+ | CorruptJwks Text Text
+ -- ^ The jwks stored in the database are corrupt. Wat.
+ deriving (Show)
+
+instance Exception YesodAuthLTI13Exception
+
+dispatchAuthRequest
+ :: YesodAuthLTI13 master
+ => PluginName
+ -- ^ Name of the auth provider
+ -> Text
+ -- ^ Method
+ -> [Text]
+ -- ^ Path parts
+ -> AuthHandler master TypedContent
+dispatchAuthRequest name "GET" ["initiate"] =
+ unifyParams GET >>= dispatchInitiate name
+dispatchAuthRequest name "POST" ["initiate"] =
+ unifyParams POST >>= dispatchInitiate name
+dispatchAuthRequest name "POST" ["authenticate"] =
+ dispatchAuthenticate name
+dispatchAuthRequest name "GET" ["jwks"] =
+ dispatchJwks name
+dispatchAuthRequest _ _ _ = notFound
+
+-- | HTTP method for @unifyParams@
+data Method = GET
+ | POST
+
+-- | Turns parameters from their respective request type to a simple map.
+unifyParams
+ :: MonadHandler m
+ => Method
+ -> m RequestParams
+unifyParams GET = do
+ req <- getRequest
+ return $ Map.fromList $ reqGetParams req
+unifyParams POST = do
+ (params, _) <- runRequestBody
+ return $ Map.fromList params
+
+-- | Makes a name for a saved session piece
+prefixSession :: Text -> Text -> Text
+prefixSession name datum =
+ "_lti13_" <> name <> "_" <> datum
+
+-- | Makes the name for the @clientId@ cookie
+myCid :: Text -> Text
+myCid = flip prefixSession $ "clientId"
+
+-- | Makes the name for the @iss@ cookie
+myIss :: Text -> Text
+myIss = flip prefixSession $ "iss"
+
+-- | Makes the name for the @state@ cookie
+myState :: Text -> Text
+myState = flip prefixSession $ "state"
+
+-- | Makes the name for the @nonce@ cookie
+myNonce :: Text -> Text
+myNonce = flip prefixSession $ "nonce"
+
+mkSessionStore :: MonadHandler m => Text -> SessionStore m
+mkSessionStore name =
+ SessionStore
+ { sessionStoreGenerate = gen
+ , sessionStoreSave = sessionSave
+ , sessionStoreGet = sessionGet
+ , sessionStoreDelete = sessionDelete
+ }
+ where
+ -- we make only url safe stuff to not cause chaos elsewhere
+ gen = liftIO $ (B64.encode <$> getRandomBytes 33)
+ sname = myState name
+ nname = myNonce name
+ sessionSave state nonce = do
+ setSessionBS sname state
+ setSessionBS nname nonce
+ return ()
+ sessionGet = do
+ state <- lookupSessionBS sname
+ nonce <- lookupSessionBS nname
+ return (state, nonce)
+ sessionDelete = do
+ deleteSession sname
+ deleteSession nname
+
+type PluginName = Text
+
+makeCfg
+ :: MonadHandler m
+ => PluginName
+ -> ((Issuer, Maybe ClientId) -> m PlatformInfo)
+ -> (Nonce -> m Bool)
+ -> Text
+ -> AuthFlowConfig m
+makeCfg name pinfo seenNonce callback =
+ AuthFlowConfig
+ { getPlatformInfo = pinfo
+ , haveSeenNonce = seenNonce
+ , myRedirectUri = callback
+ , sessionStore = mkSessionStore name
+ }
+
+createNewJwk :: IO Jwk
+createNewJwk = do
+ kid <- UTCKeyId <$> getCurrentTime
+ let use = Sig
+ alg = Signed RS256
+ (_, priv) <- generateRsaKeyPair 256 kid use $ Just alg
+ return priv
+
+dispatchJwks
+ :: YesodAuthLTI13 master
+ => PluginName
+ -> AuthHandler master TypedContent
+dispatchJwks name = do
+ jwks <- retrieveOrInsertJwks makeJwks
+ JwkSet privs <- maybe (liftIO $ throwIO $ CorruptJwks name "json decode failed")
+ pure (A.decodeStrict jwks)
+ let pubs = JwkSet $ map rsaPrivToPub privs
+ return $ toTypedContent $ A.toJSON pubs
+ where makeJwks = (LBS.toStrict . A.encode) <$> makeJwkSet
+ makeJwkSet = fmap (\jwk -> JwkSet {keys = [jwk]}) createNewJwk
+
+rsaPrivToPub :: Jwk -> Jwk
+rsaPrivToPub (RsaPrivateJwk privKey mId mUse mAlg) =
+ RsaPublicJwk (RSA.private_pub privKey) mId mUse mAlg
+rsaPrivToPub _ = error "rsaPrivToPub called on a Jwk that's not a RsaPrivateJwk"
+
+dispatchInitiate
+ :: YesodAuthLTI13 master
+ => PluginName
+ -- ^ Name of the provider
+ -> RequestParams
+ -- ^ Request parameters
+ -> AuthHandler master TypedContent
+dispatchInitiate name params = do
+ -- TODO: this should be refactored into a function but I don't know how
+ let url = PluginR name ["authenticate"]
+ tm <- getRouteToParent
+ render <- getUrlRender
+ let authUrl = render $ tm url
+
+ let cfg = makeCfg name retrievePlatformInfo checkSeenNonce authUrl
+ (iss, cid, redir) <- initiate cfg params
+ setSession (myIss name) iss
+ setSession (myCid name) cid
+ redirect redir
+
+type State = Text
+
+checkCSRFToken :: MonadHandler m => State -> Maybe State -> m ()
+checkCSRFToken state state' = do
+ -- they do not match or the state is wrong
+ if state' /= Just state then do
+ permissionDenied "Bad CSRF token"
+ else
+ return ()
+
+-- | Makes a user ID that is not an email address (and should thus be safe from
+-- [possible security problem] collisions with email based auth systems)
+makeUserId :: Issuer -> Text -> Text
+makeUserId iss name = name <> "@@" <> iss
+
+dispatchAuthenticate :: YesodAuthLTI13 m => PluginName -> AuthHandler m TypedContent
+dispatchAuthenticate name = do
+ mgr <- authHttpManager
+ -- first, find who the issuer was
+ -- this is safe, least of which because Yesod has encrypted session cookies
+ maybeIss <- lookupSession $ myIss name
+ iss <- maybe (liftIO . throwIO $ BadRequest name "missing `iss` cookie")
+ pure
+ maybeIss
+ cid <- lookupSession $ myCid name
+ deleteSession $ myIss name
+ deleteSession $ myCid name
+
+ state' <- lookupSession $ myState name
+
+ pinfo <- retrievePlatformInfo (iss, cid)
+
+ -- we don't care about having a callback URL here since we *are* the callback
+ let cfg = makeCfg name retrievePlatformInfo checkSeenNonce undefined
+ (params', _) <- runRequestBody
+ let params = Map.fromList params'
+ (state, tok) <- handleAuthResponse mgr cfg params pinfo
+
+ -- check CSRF token against the state in the request
+ checkCSRFToken state state'
+
+ let LtiTokenClaims ltiClaims = otherClaims tok
+ ltiClaimsJson = E.decodeUtf8 $ LBS.toStrict $ A.encode ltiClaims
+
+ let IdTokenClaims { sub } = tok
+ myCreds = Creds {
+ credsPlugin = name
+ , credsIdent = makeUserId iss sub
+ , credsExtra = [("ltiIss", iss), ("ltiSub", sub), ("ltiToken", ltiClaimsJson)]
+ }
+
+ setCredsRedirect myCreds
+
+-- | Gets the @iss@ for the given sesssion
+getLtiIss :: SessionMap -> Maybe Issuer
+getLtiIss sess =
+ E.decodeUtf8 <$> Map.lookup "ltiIss" sess
+
+-- | Gets the @sub@ for the given session
+getLtiSub :: SessionMap -> Maybe Issuer
+getLtiSub sess =
+ E.decodeUtf8 <$> Map.lookup "ltiSub" sess
+
+-- | Gets and decodes the extra token claims with the full LTI launch
+-- information from a session
+--
+-- Signature slightly inaccurate: the claims have been checked at this stage.
+getLtiToken :: SessionMap -> Maybe UncheckedLtiTokenClaims
+getLtiToken sess =
+ (Map.lookup "ltiToken" sess)
+ >>= A.decodeStrict
+
+-- | Callbacks into your site for LTI 1.3
+class (YesodAuth site)
+ => YesodAuthLTI13 site where
+ -- | Check if a nonce has been seen in the last validity period. It is
+ -- expected that nonces given to this function are stored somewhere,
+ -- returning False, then when seen again, True should be returned.
+ -- See the <http://www.imsglobal.org/spec/security/v1p0/#authentication-response-validation
+ -- relevant section of the IMS security specification> for details.
+ checkSeenNonce :: Nonce -> AuthHandler site (Bool)
+
+ -- | Get the configuration for the given platform.
+ --
+ -- It is possible that the relation between Issuer and ClientId is 1
+ -- to n rather than 1 to 1, for instance in the case of cloud hosted
+ -- Canvas. You *must* therefore key your 'PlatformInfo' retrieval
+ -- with the pair of both and throw an error if there are multiple
+ -- 'ClientId' for the given 'Issuer' and the 'ClientId' is 'Nothing'.
+ retrievePlatformInfo :: (Issuer, Maybe ClientId) -> AuthHandler site (PlatformInfo)
+
+ -- | Retrieve JWKs list from the database or other store. If not
+ -- present, please create a new one by evaluating the given 'IO', store
+ -- it, and return it.
+ retrieveOrInsertJwks
+ :: (IO BS.ByteString)
+ -- ^ an 'IO' which, if evaluated, will make a new 'Jwk' set
+ -> AuthHandler site (BS.ByteString)
+
+-- | Auth plugin. Add this to @appAuthPlugins@ to enable this plugin.
+authLTI13 :: YesodAuthLTI13 m => AuthPlugin m
+authLTI13 = do
+ AuthPlugin name (dispatchAuthRequest name) login
+ where
+ name = "lti13"
+ login _ = [whamlet|Login via your Learning Management System|]
+
diff --git a/yesod-auth-lti13.cabal b/yesod-auth-lti13.cabal
new file mode 100644
index 0000000..37ef948
--- /dev/null
+++ b/yesod-auth-lti13.cabal
@@ -0,0 +1,80 @@
+cabal-version: >=1.10
+
+name: yesod-auth-lti13
+version: 0.1.1.0
+synopsis: A yesod-auth plugin for LTI 1.3
+description: A plugin using <https://hackage.haskell.org/package/lti13>
+ to implement IMS Global LTI 1.3 authentication for
+ yesod-auth.
+bug-reports: https://github.com/lf-/lti13/issues
+license: LGPL-3
+author: Jade
+maintainer: Jade <software at lfcode dot ca>
+-- copyright:
+category: Web, Yesod
+license-file: LICENSE
+build-type: Simple
+extra-source-files: CHANGELOG.md
+ README.md
+
+library
+ hs-source-dirs: src/
+ exposed-modules: Yesod.Auth.LTI13
+ ghc-options: -Wall
+ -- other-modules:
+ -- other-extensions:
+ build-depends: base >=4.12 && <5
+ , lti13
+ , base64-bytestring >= 1.0.0 && < 1.1
+ , bytestring >= 0.10.10 && < 0.11
+ , containers >= 0.6.2 && < 0.7
+ , cryptonite >= 0.26 && < 0.27
+ , http-client >= 0.6.4 && < 0.7
+ , text >= 1.2.4 && < 1.3
+ , random >= 1.1 && < 1.2
+ , microlens >= 0.4.11 && < 0.5
+ , oidc-client >= 0.5.1 && < 0.6
+ , aeson >= 1.4.7 && < 1.5
+ , safe-exceptions >= 0.1.7 && < 0.2
+ , yesod-auth >= 1.6.10 && < 1.7
+ , http-conduit >= 2.3.7 && < 2.4
+ , yesod-core >= 1.6.18 && < 1.7
+ , warp >= 3.3.13 && < 3.4
+ , aeson-pretty >= 0.8.8 && < 0.9
+ , load-env >= 0.2.1 && < 0.3
+ , yesod >= 1.6.1 && < 1.7
+ , jose-jwt >= 0.8.0 && < 0.9.0
+ , time >= 1.0.0 && < 1.11
+ -- hs-source-dirs:
+ default-language: Haskell2010
+
+flag example
+ description: "Should I build the Yesod example?"
+ manual: False
+ default: False
+
+executable yesod-lti13-example
+ main-is: Main.hs
+ hs-source-dirs:
+ example
+ ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N
+ build-depends:
+ aeson
+ , aeson-pretty
+ , base >=4.9.0.0 && <5
+ , bytestring
+ , containers
+ , http-conduit
+ , load-env
+ , text
+ , warp
+ , yesod
+ , yesod-auth
+ , yesod-auth-lti13
+ if !(flag(example))
+ buildable: False
+ default-language: Haskell2010
+
+source-repository head
+ type: git
+ location: https://github.com/lf-/lti13