{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}

-- | A basic LTI 1.3 library.
--   It's intended to be used by implementing routes for 'initiate' and
--   'handleAuthResponse', and work out the associated parameters thereof.
--
--   This is written based on the LTI 1.3 specification
--   <http://www.imsglobal.org/spec/lti/v1p3/ available from the IMS Global
--   website>. Users will probably also find the <https://lti-ri.imsglobal.org/
--   LTI Reference Implementation> helpful.
module Web.LTI13 (
        Role(..)
      , LisClaim(..)
      , ContextClaim(..)
      , UncheckedLtiTokenClaims(..)
      , LtiTokenClaims(..)
      , validateLtiToken
      , LTI13Exception(..)
      , PlatformInfo(..)
      , Issuer
      , ClientId
      , SessionStore(..)
      , AuthFlowConfig(..)
      , RequestParams
      , initiate
      , handleAuthResponse
    ) where
import qualified Web.OIDC.Client.Settings as O
import qualified Web.OIDC.Client.Discovery.Provider as P
import Web.OIDC.Client.Tokens (nonce, aud, otherClaims, iss, IdTokenClaims)
import Web.OIDC.Client.IdTokenFlow (getValidIdTokenClaims)
import Web.OIDC.Client.Types (Nonce, SessionStore(..))
import Jose.Jwa (JwsAlg(RS256))
import qualified Jose.Jwk as Jwk
import Control.Monad (when, (>=>))
import qualified Control.Monad.Fail as Fail
import Control.Exception.Safe (MonadCatch, catch, throwM, Typeable, Exception, MonadThrow, throw)
import Control.Monad.IO.Class (liftIO, MonadIO)
import Data.Aeson (eitherDecode, FromJSON (parseJSON), ToJSON(toJSON, toEncoding), Object,
                   object, pairs, withObject, withText, (.:), (.:?), (.=))
import qualified Data.Aeson as A
import Data.Aeson.Types (Parser)
import Data.Text (Text)
import qualified Network.HTTP.Types.URI as URI
import Network.HTTP.Client (responseBody, Manager, HttpException, parseRequest, httpLbs)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8, decodeUtf8)

-- | Parses a JSON text field to a fixed expected value, failing otherwise
parseFixed :: (FromJSON a, Eq a, Show a) => Object -> Text -> a -> Parser a
parseFixed :: Object -> Text -> a -> Parser a
parseFixed Object
obj Text
field a
fixedVal =
    Object
obj Object -> Text -> Parser a
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
field Parser a -> (a -> Parser a) -> Parser a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
v ->
        if a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
fixedVal then
            a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return a
v
        else
            String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"field " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
field String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" was not the required value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
fixedVal

-- | Roles in the target context (≈ course/section); see
--   <http://www.imsglobal.org/spec/lti/v1p3/#lis-vocabulary-for-institution-roles LTI spec § A.2.2>
--   and <http://www.imsglobal.org/spec/lti/v1p3/#roles-claim LTI spec § 5.3.7>
--   for details
data Role = Administrator
          | ContentDeveloper
          | Instructor
          | Learner
          | Mentor
          | Other Text
          deriving (Int -> Role -> String -> String
[Role] -> String -> String
Role -> String
(Int -> Role -> String -> String)
-> (Role -> String) -> ([Role] -> String -> String) -> Show Role
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Role] -> String -> String
$cshowList :: [Role] -> String -> String
show :: Role -> String
$cshow :: Role -> String
showsPrec :: Int -> Role -> String -> String
$cshowsPrec :: Int -> Role -> String -> String
Show, Role -> Role -> Bool
(Role -> Role -> Bool) -> (Role -> Role -> Bool) -> Eq Role
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Role -> Role -> Bool
$c/= :: Role -> Role -> Bool
== :: Role -> Role -> Bool
$c== :: Role -> Role -> Bool
Eq)

roleFromString :: Text -> Role
roleFromString :: Text -> Role
roleFromString Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Administrator"
    = Role
Administrator
roleFromString Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#ContentDeveloper"
    = Role
ContentDeveloper
roleFromString Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Instructor"
    = Role
Instructor
roleFromString Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Learner"
    = Role
Learner
roleFromString Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Mentor"
    = Role
Mentor
roleFromString Text
s = Text -> Role
Other Text
s

roleToString :: Role -> Text
roleToString :: Role -> Text
roleToString Role
Administrator = Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Administrator"
roleToString Role
ContentDeveloper = Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#ContentDeveloper"
roleToString Role
Instructor = Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Instructor"
roleToString Role
Learner = Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Learner"
roleToString Role
Mentor = Text
"http://purl.imsglobal.org/vocab/lis/v2/membership#Mentor"
roleToString (Other Text
s) = Text
s

instance FromJSON Role where
    parseJSON :: Value -> Parser Role
parseJSON = String -> (Text -> Parser Role) -> Value -> Parser Role
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Role" ((Text -> Parser Role) -> Value -> Parser Role)
-> (Text -> Parser Role) -> Value -> Parser Role
forall a b. (a -> b) -> a -> b
$ Role -> Parser Role
forall (m :: * -> *) a. Monad m => a -> m a
return (Role -> Parser Role) -> (Text -> Role) -> Text -> Parser Role
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Role
roleFromString

instance ToJSON Role where
    toJSON :: Role -> Value
toJSON = Text -> Value
A.String (Text -> Value) -> (Role -> Text) -> Role -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Role -> Text
roleToString

-- | <http://www.imsglobal.org/spec/lti/v1p3/#lislti LTI spec § D> LIS claim
data LisClaim = LisClaim
    { LisClaim -> Maybe Text
personSourcedId   :: Maybe Text
    -- ^ LIS identifier for the person making the request.
    , LisClaim -> Maybe Text
outcomeServiceUrl :: Maybe Text
    -- ^ URL for the Basic Outcomes service, unique per-tool.
    , LisClaim -> Maybe Text
courseOfferingSourcedId :: Maybe Text
    -- ^ Identifier for the course
    , LisClaim -> Maybe Text
courseSectionSourcedId :: Maybe Text
    -- ^ Identifier for the section.
    , LisClaim -> Maybe Text
resultSourcedId :: Maybe Text
    -- ^ An identifier for the position in the gradebook associated with the
    --   assignment being viewed.
    } deriving (Int -> LisClaim -> String -> String
[LisClaim] -> String -> String
LisClaim -> String
(Int -> LisClaim -> String -> String)
-> (LisClaim -> String)
-> ([LisClaim] -> String -> String)
-> Show LisClaim
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LisClaim] -> String -> String
$cshowList :: [LisClaim] -> String -> String
show :: LisClaim -> String
$cshow :: LisClaim -> String
showsPrec :: Int -> LisClaim -> String -> String
$cshowsPrec :: Int -> LisClaim -> String -> String
Show, LisClaim -> LisClaim -> Bool
(LisClaim -> LisClaim -> Bool)
-> (LisClaim -> LisClaim -> Bool) -> Eq LisClaim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LisClaim -> LisClaim -> Bool
$c/= :: LisClaim -> LisClaim -> Bool
== :: LisClaim -> LisClaim -> Bool
$c== :: LisClaim -> LisClaim -> Bool
Eq)

instance FromJSON LisClaim where
    parseJSON :: Value -> Parser LisClaim
parseJSON = String -> (Object -> Parser LisClaim) -> Value -> Parser LisClaim
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LisClaim" ((Object -> Parser LisClaim) -> Value -> Parser LisClaim)
-> (Object -> Parser LisClaim) -> Value -> Parser LisClaim
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Maybe Text
-> Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> LisClaim
LisClaim
            (Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> LisClaim)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> LisClaim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"person_sourcedid"
            Parser
  (Maybe Text -> Maybe Text -> Maybe Text -> Maybe Text -> LisClaim)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> LisClaim)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"outcome_service_url"
            Parser (Maybe Text -> Maybe Text -> Maybe Text -> LisClaim)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> LisClaim)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"course_offering_sourcedid"
            Parser (Maybe Text -> Maybe Text -> LisClaim)
-> Parser (Maybe Text) -> Parser (Maybe Text -> LisClaim)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"course_section_sourcedid"
            Parser (Maybe Text -> LisClaim)
-> Parser (Maybe Text) -> Parser LisClaim
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"result_sourcedid"

instance ToJSON LisClaim where
    toJSON :: LisClaim -> Value
toJSON LisClaim {Maybe Text
personSourcedId :: Maybe Text
personSourcedId :: LisClaim -> Maybe Text
personSourcedId, Maybe Text
outcomeServiceUrl :: Maybe Text
outcomeServiceUrl :: LisClaim -> Maybe Text
outcomeServiceUrl,
                Maybe Text
courseOfferingSourcedId :: Maybe Text
courseOfferingSourcedId :: LisClaim -> Maybe Text
courseOfferingSourcedId, Maybe Text
courseSectionSourcedId :: Maybe Text
courseSectionSourcedId :: LisClaim -> Maybe Text
courseSectionSourcedId,
                Maybe Text
resultSourcedId :: Maybe Text
resultSourcedId :: LisClaim -> Maybe Text
resultSourcedId} =
        [Pair] -> Value
object [
            Text
"person_sourcedid" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
personSourcedId
          , Text
"outcome_service_url" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
outcomeServiceUrl
          , Text
"course_offering_sourcedid" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
courseOfferingSourcedId
          , Text
"course_section_sourcedid" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
courseSectionSourcedId
          , Text
"result_sourcedid" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
resultSourcedId
          ]
    toEncoding :: LisClaim -> Encoding
toEncoding LisClaim {Maybe Text
personSourcedId :: Maybe Text
personSourcedId :: LisClaim -> Maybe Text
personSourcedId, Maybe Text
outcomeServiceUrl :: Maybe Text
outcomeServiceUrl :: LisClaim -> Maybe Text
outcomeServiceUrl,
                    Maybe Text
courseOfferingSourcedId :: Maybe Text
courseOfferingSourcedId :: LisClaim -> Maybe Text
courseOfferingSourcedId, Maybe Text
courseSectionSourcedId :: Maybe Text
courseSectionSourcedId :: LisClaim -> Maybe Text
courseSectionSourcedId,
                    Maybe Text
resultSourcedId :: Maybe Text
resultSourcedId :: LisClaim -> Maybe Text
resultSourcedId} =
        Series -> Encoding
pairs (
            Text
"person_sourcedid" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
personSourcedId Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
            Text
"outcome_service_url" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
outcomeServiceUrl Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
            Text
"course_offering_sourcedid" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
courseOfferingSourcedId Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
            Text
"course_section_sourcedid" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
courseSectionSourcedId Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
            Text
"result_sourcedid" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
resultSourcedId
        )

-- | <http://www.imsglobal.org/spec/lti/v1p3/#context-claim LTI spec § 5.4.1> context claim
data ContextClaim = ContextClaim
    { ContextClaim -> Text
contextId :: Text
    , ContextClaim -> Maybe Text
contextLabel :: Maybe Text
    , ContextClaim -> Maybe Text
contextTitle :: Maybe Text
    }
    deriving (Int -> ContextClaim -> String -> String
[ContextClaim] -> String -> String
ContextClaim -> String
(Int -> ContextClaim -> String -> String)
-> (ContextClaim -> String)
-> ([ContextClaim] -> String -> String)
-> Show ContextClaim
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ContextClaim] -> String -> String
$cshowList :: [ContextClaim] -> String -> String
show :: ContextClaim -> String
$cshow :: ContextClaim -> String
showsPrec :: Int -> ContextClaim -> String -> String
$cshowsPrec :: Int -> ContextClaim -> String -> String
Show, ContextClaim -> ContextClaim -> Bool
(ContextClaim -> ContextClaim -> Bool)
-> (ContextClaim -> ContextClaim -> Bool) -> Eq ContextClaim
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextClaim -> ContextClaim -> Bool
$c/= :: ContextClaim -> ContextClaim -> Bool
== :: ContextClaim -> ContextClaim -> Bool
$c== :: ContextClaim -> ContextClaim -> Bool
Eq)

instance FromJSON ContextClaim where
    parseJSON :: Value -> Parser ContextClaim
parseJSON = String
-> (Object -> Parser ContextClaim) -> Value -> Parser ContextClaim
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ContextClaim" ((Object -> Parser ContextClaim) -> Value -> Parser ContextClaim)
-> (Object -> Parser ContextClaim) -> Value -> Parser ContextClaim
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text -> Maybe Text -> Maybe Text -> ContextClaim
ContextClaim
            (Text -> Maybe Text -> Maybe Text -> ContextClaim)
-> Parser Text -> Parser (Maybe Text -> Maybe Text -> ContextClaim)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id" Parser Text -> (Text -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Text -> Parser Text
forall (m :: * -> *). MonadFail m => Int -> Text -> m Text
limitLength Int
255)
            Parser (Maybe Text -> Maybe Text -> ContextClaim)
-> Parser (Maybe Text) -> Parser (Maybe Text -> ContextClaim)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"label"
            Parser (Maybe Text -> ContextClaim)
-> Parser (Maybe Text) -> Parser ContextClaim
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"title"

instance ToJSON ContextClaim where
    toJSON :: ContextClaim -> Value
toJSON ContextClaim {Text
contextId :: Text
contextId :: ContextClaim -> Text
contextId, Maybe Text
contextLabel :: Maybe Text
contextLabel :: ContextClaim -> Maybe Text
contextLabel, Maybe Text
contextTitle :: Maybe Text
contextTitle :: ContextClaim -> Maybe Text
contextTitle} =
        [Pair] -> Value
object [
            Text
"id" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
contextId
          , Text
"label" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
contextLabel
          , Text
"title" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
contextTitle
          ]
    toEncoding :: ContextClaim -> Encoding
toEncoding ContextClaim {Text
contextId :: Text
contextId :: ContextClaim -> Text
contextId, Maybe Text
contextLabel :: Maybe Text
contextLabel :: ContextClaim -> Maybe Text
contextLabel, Maybe Text
contextTitle :: Maybe Text
contextTitle :: ContextClaim -> Maybe Text
contextTitle} =
        Series -> Encoding
pairs (
            Text
"id" Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
contextId Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
            Text
"label" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
contextLabel Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<>
            Text
"title" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
contextTitle
        )

-- | LTI specific claims on a token. You should not accept this type, and
--   instead prefer the @newtype@ 'LtiTokenClaims' which has had checking
--   performed on it.
data UncheckedLtiTokenClaims = UncheckedLtiTokenClaims
    { UncheckedLtiTokenClaims -> Text
messageType :: Text
    , UncheckedLtiTokenClaims -> Text
ltiVersion :: Text
    , UncheckedLtiTokenClaims -> Text
deploymentId :: Text
    , UncheckedLtiTokenClaims -> Text
targetLinkUri :: Text
    , UncheckedLtiTokenClaims -> [Role]
roles :: [Role]
    , UncheckedLtiTokenClaims -> Maybe Text
email :: Maybe Text
    , UncheckedLtiTokenClaims -> Maybe Text
displayName :: Maybe Text
    , UncheckedLtiTokenClaims -> Maybe Text
firstName :: Maybe Text
    , UncheckedLtiTokenClaims -> Maybe Text
lastName :: Maybe Text
    , UncheckedLtiTokenClaims -> Maybe ContextClaim
context :: Maybe ContextClaim
    , UncheckedLtiTokenClaims -> Maybe LisClaim
lis :: Maybe LisClaim
    } deriving (Int -> UncheckedLtiTokenClaims -> String -> String
[UncheckedLtiTokenClaims] -> String -> String
UncheckedLtiTokenClaims -> String
(Int -> UncheckedLtiTokenClaims -> String -> String)
-> (UncheckedLtiTokenClaims -> String)
-> ([UncheckedLtiTokenClaims] -> String -> String)
-> Show UncheckedLtiTokenClaims
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [UncheckedLtiTokenClaims] -> String -> String
$cshowList :: [UncheckedLtiTokenClaims] -> String -> String
show :: UncheckedLtiTokenClaims -> String
$cshow :: UncheckedLtiTokenClaims -> String
showsPrec :: Int -> UncheckedLtiTokenClaims -> String -> String
$cshowsPrec :: Int -> UncheckedLtiTokenClaims -> String -> String
Show, UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims -> Bool
(UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims -> Bool)
-> (UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims -> Bool)
-> Eq UncheckedLtiTokenClaims
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims -> Bool
$c/= :: UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims -> Bool
== :: UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims -> Bool
$c== :: UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims -> Bool
Eq)

-- | An object representing in the type system a token whose claims have been
--   validated.
newtype LtiTokenClaims = LtiTokenClaims UncheckedLtiTokenClaims
    deriving (Int -> LtiTokenClaims -> String -> String
[LtiTokenClaims] -> String -> String
LtiTokenClaims -> String
(Int -> LtiTokenClaims -> String -> String)
-> (LtiTokenClaims -> String)
-> ([LtiTokenClaims] -> String -> String)
-> Show LtiTokenClaims
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LtiTokenClaims] -> String -> String
$cshowList :: [LtiTokenClaims] -> String -> String
show :: LtiTokenClaims -> String
$cshow :: LtiTokenClaims -> String
showsPrec :: Int -> LtiTokenClaims -> String -> String
$cshowsPrec :: Int -> LtiTokenClaims -> String -> String
Show, LtiTokenClaims -> LtiTokenClaims -> Bool
(LtiTokenClaims -> LtiTokenClaims -> Bool)
-> (LtiTokenClaims -> LtiTokenClaims -> Bool) -> Eq LtiTokenClaims
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LtiTokenClaims -> LtiTokenClaims -> Bool
$c/= :: LtiTokenClaims -> LtiTokenClaims -> Bool
== :: LtiTokenClaims -> LtiTokenClaims -> Bool
$c== :: LtiTokenClaims -> LtiTokenClaims -> Bool
Eq)

limitLength :: (Fail.MonadFail m) => Int -> Text -> m Text
limitLength :: Int -> Text -> m Text
limitLength Int
len Text
string
    | Text -> Int
T.length Text
string Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
len
    = Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
string
limitLength Int
_ Text
_ = String -> m Text
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"String is too long"

claimMessageType :: Text
claimMessageType :: Text
claimMessageType = Text
"https://purl.imsglobal.org/spec/lti/claim/message_type"
claimVersion :: Text
claimVersion :: Text
claimVersion = Text
"https://purl.imsglobal.org/spec/lti/claim/version"
claimDeploymentId :: Text
claimDeploymentId :: Text
claimDeploymentId = Text
"https://purl.imsglobal.org/spec/lti/claim/deployment_id"
claimTargetLinkUri :: Text
claimTargetLinkUri :: Text
claimTargetLinkUri = Text
"https://purl.imsglobal.org/spec/lti/claim/target_link_uri"
claimRoles :: Text
claimRoles :: Text
claimRoles = Text
"https://purl.imsglobal.org/spec/lti/claim/roles"
claimContext :: Text
claimContext :: Text
claimContext = Text
"https://purl.imsglobal.org/spec/lti/claim/context"
claimLis :: Text
claimLis :: Text
claimLis = Text
"https://purl.imsglobal.org/spec/lti/claim/lis"

instance FromJSON UncheckedLtiTokenClaims where
    parseJSON :: Value -> Parser UncheckedLtiTokenClaims
parseJSON = String
-> (Object -> Parser UncheckedLtiTokenClaims)
-> Value
-> Parser UncheckedLtiTokenClaims
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LtiTokenClaims" ((Object -> Parser UncheckedLtiTokenClaims)
 -> Value -> Parser UncheckedLtiTokenClaims)
-> (Object -> Parser UncheckedLtiTokenClaims)
-> Value
-> Parser UncheckedLtiTokenClaims
forall a b. (a -> b) -> a -> b
$ \Object
v ->
        Text
-> Text
-> Text
-> Text
-> [Role]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ContextClaim
-> Maybe LisClaim
-> UncheckedLtiTokenClaims
UncheckedLtiTokenClaims
            (Text
 -> Text
 -> Text
 -> Text
 -> [Role]
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe ContextClaim
 -> Maybe LisClaim
 -> UncheckedLtiTokenClaims)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> [Role]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe ContextClaim
      -> Maybe LisClaim
      -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Text -> Text -> Parser Text
forall a.
(FromJSON a, Eq a, Show a) =>
Object -> Text -> a -> Parser a
parseFixed Object
v Text
claimMessageType Text
"LtiResourceLinkRequest"
            Parser
  (Text
   -> Text
   -> Text
   -> [Role]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe ContextClaim
   -> Maybe LisClaim
   -> UncheckedLtiTokenClaims)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> [Role]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe ContextClaim
      -> Maybe LisClaim
      -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Text -> Text -> Parser Text
forall a.
(FromJSON a, Eq a, Show a) =>
Object -> Text -> a -> Parser a
parseFixed Object
v Text
claimVersion Text
"1.3.0"
            Parser
  (Text
   -> Text
   -> [Role]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe ContextClaim
   -> Maybe LisClaim
   -> UncheckedLtiTokenClaims)
-> Parser Text
-> Parser
     (Text
      -> [Role]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe ContextClaim
      -> Maybe LisClaim
      -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
claimDeploymentId Parser Text -> (Text -> Parser Text) -> Parser Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Text -> Parser Text
forall (m :: * -> *). MonadFail m => Int -> Text -> m Text
limitLength Int
255)
            Parser
  (Text
   -> [Role]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe ContextClaim
   -> Maybe LisClaim
   -> UncheckedLtiTokenClaims)
-> Parser Text
-> Parser
     ([Role]
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe ContextClaim
      -> Maybe LisClaim
      -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
claimTargetLinkUri
            Parser
  ([Role]
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe ContextClaim
   -> Maybe LisClaim
   -> UncheckedLtiTokenClaims)
-> Parser [Role]
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe ContextClaim
      -> Maybe LisClaim
      -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser [Role]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
claimRoles
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe ContextClaim
   -> Maybe LisClaim
   -> UncheckedLtiTokenClaims)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe ContextClaim
      -> Maybe LisClaim
      -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"email"
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe ContextClaim
   -> Maybe LisClaim
   -> UncheckedLtiTokenClaims)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe Text
      -> Maybe ContextClaim
      -> Maybe LisClaim
      -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"name"
            Parser
  (Maybe Text
   -> Maybe Text
   -> Maybe ContextClaim
   -> Maybe LisClaim
   -> UncheckedLtiTokenClaims)
-> Parser (Maybe Text)
-> Parser
     (Maybe Text
      -> Maybe ContextClaim -> Maybe LisClaim -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"given_name"
            Parser
  (Maybe Text
   -> Maybe ContextClaim -> Maybe LisClaim -> UncheckedLtiTokenClaims)
-> Parser (Maybe Text)
-> Parser
     (Maybe ContextClaim -> Maybe LisClaim -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"family_name"
            Parser
  (Maybe ContextClaim -> Maybe LisClaim -> UncheckedLtiTokenClaims)
-> Parser (Maybe ContextClaim)
-> Parser (Maybe LisClaim -> UncheckedLtiTokenClaims)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe ContextClaim)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
claimContext
            Parser (Maybe LisClaim -> UncheckedLtiTokenClaims)
-> Parser (Maybe LisClaim) -> Parser UncheckedLtiTokenClaims
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Text -> Parser (Maybe LisClaim)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
claimLis

instance ToJSON UncheckedLtiTokenClaims where
    toJSON :: UncheckedLtiTokenClaims -> Value
toJSON UncheckedLtiTokenClaims {
              Text
messageType :: Text
messageType :: UncheckedLtiTokenClaims -> Text
messageType, Text
ltiVersion :: Text
ltiVersion :: UncheckedLtiTokenClaims -> Text
ltiVersion, Text
deploymentId :: Text
deploymentId :: UncheckedLtiTokenClaims -> Text
deploymentId
            , Text
targetLinkUri :: Text
targetLinkUri :: UncheckedLtiTokenClaims -> Text
targetLinkUri, [Role]
roles :: [Role]
roles :: UncheckedLtiTokenClaims -> [Role]
roles, Maybe Text
email :: Maybe Text
email :: UncheckedLtiTokenClaims -> Maybe Text
email, Maybe Text
displayName :: Maybe Text
displayName :: UncheckedLtiTokenClaims -> Maybe Text
displayName
            , Maybe Text
firstName :: Maybe Text
firstName :: UncheckedLtiTokenClaims -> Maybe Text
firstName, Maybe Text
lastName :: Maybe Text
lastName :: UncheckedLtiTokenClaims -> Maybe Text
lastName, Maybe ContextClaim
context :: Maybe ContextClaim
context :: UncheckedLtiTokenClaims -> Maybe ContextClaim
context, Maybe LisClaim
lis :: Maybe LisClaim
lis :: UncheckedLtiTokenClaims -> Maybe LisClaim
lis} =
        [Pair] -> Value
object [
              Text
claimMessageType Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
messageType
            , Text
claimVersion Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
ltiVersion
            , Text
claimDeploymentId Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
deploymentId
            , Text
claimTargetLinkUri Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
targetLinkUri
            , Text
claimRoles Text -> [Role] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Role]
roles
            , Text
"email" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
email
            , Text
"name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
displayName
            , Text
"given_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
firstName
            , Text
"family_name" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
lastName
            , Text
claimContext Text -> Maybe ContextClaim -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ContextClaim
context
            , Text
claimLis Text -> Maybe LisClaim -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe LisClaim
lis
          ]
    toEncoding :: UncheckedLtiTokenClaims -> Encoding
toEncoding UncheckedLtiTokenClaims {
              Text
messageType :: Text
messageType :: UncheckedLtiTokenClaims -> Text
messageType, Text
ltiVersion :: Text
ltiVersion :: UncheckedLtiTokenClaims -> Text
ltiVersion, Text
deploymentId :: Text
deploymentId :: UncheckedLtiTokenClaims -> Text
deploymentId
            , Text
targetLinkUri :: Text
targetLinkUri :: UncheckedLtiTokenClaims -> Text
targetLinkUri, [Role]
roles :: [Role]
roles :: UncheckedLtiTokenClaims -> [Role]
roles, Maybe Text
email :: Maybe Text
email :: UncheckedLtiTokenClaims -> Maybe Text
email, Maybe Text
displayName :: Maybe Text
displayName :: UncheckedLtiTokenClaims -> Maybe Text
displayName
            , Maybe Text
firstName :: Maybe Text
firstName :: UncheckedLtiTokenClaims -> Maybe Text
firstName, Maybe Text
lastName :: Maybe Text
lastName :: UncheckedLtiTokenClaims -> Maybe Text
lastName, Maybe ContextClaim
context :: Maybe ContextClaim
context :: UncheckedLtiTokenClaims -> Maybe ContextClaim
context, Maybe LisClaim
lis :: Maybe LisClaim
lis :: UncheckedLtiTokenClaims -> Maybe LisClaim
lis} =
        Series -> Encoding
pairs (
               Text
claimMessageType Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
messageType
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
claimVersion Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
ltiVersion
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
claimDeploymentId Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
deploymentId
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
claimTargetLinkUri Text -> Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
targetLinkUri
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
claimRoles Text -> [Role] -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= [Role]
roles
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"email" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
email
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
displayName
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"given_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
firstName
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
"family_name" Text -> Maybe Text -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
lastName
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
claimContext Text -> Maybe ContextClaim -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe ContextClaim
context
            Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
<> Text
claimLis Text -> Maybe LisClaim -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe LisClaim
lis
          )

-- | A direct implementation of <http://www.imsglobal.org/spec/security/v1p0/#authentication-response-validation Security § 5.1.3>
validateLtiToken
    :: PlatformInfo
    -> IdTokenClaims UncheckedLtiTokenClaims
    -> Either Text (IdTokenClaims LtiTokenClaims)
validateLtiToken :: PlatformInfo
-> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims LtiTokenClaims)
validateLtiToken PlatformInfo
pinfo IdTokenClaims UncheckedLtiTokenClaims
claims =
    Either Text (IdTokenClaims UncheckedLtiTokenClaims)
-> Either Text (IdTokenClaims LtiTokenClaims)
valid (Either Text (IdTokenClaims UncheckedLtiTokenClaims)
 -> Either Text (IdTokenClaims LtiTokenClaims))
-> (IdTokenClaims UncheckedLtiTokenClaims
    -> Either Text (IdTokenClaims UncheckedLtiTokenClaims))
-> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims LtiTokenClaims)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims UncheckedLtiTokenClaims)
forall a a.
IsString a =>
IdTokenClaims a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
issuerMatches
         (IdTokenClaims UncheckedLtiTokenClaims
 -> Either Text (IdTokenClaims UncheckedLtiTokenClaims))
-> (IdTokenClaims UncheckedLtiTokenClaims
    -> Either Text (IdTokenClaims UncheckedLtiTokenClaims))
-> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims UncheckedLtiTokenClaims)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims UncheckedLtiTokenClaims)
forall a a.
IsString a =>
IdTokenClaims a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
audContainsClientId
         (IdTokenClaims UncheckedLtiTokenClaims
 -> Either Text (IdTokenClaims UncheckedLtiTokenClaims))
-> (IdTokenClaims UncheckedLtiTokenClaims
    -> Either Text (IdTokenClaims UncheckedLtiTokenClaims))
-> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims UncheckedLtiTokenClaims)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims UncheckedLtiTokenClaims)
forall a a.
IsString a =>
IdTokenClaims a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
hasNonce) (IdTokenClaims UncheckedLtiTokenClaims
 -> Either Text (IdTokenClaims LtiTokenClaims))
-> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims LtiTokenClaims)
forall a b. (a -> b) -> a -> b
$ IdTokenClaims UncheckedLtiTokenClaims
claims
    where
        -- step 1 handled before we are called
        -- step 2
        issuerMatches :: IdTokenClaims a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
issuerMatches IdTokenClaims a
c
            | IdTokenClaims a -> Text
forall a. IdTokenClaims a -> Text
iss IdTokenClaims a
c Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== PlatformInfo -> Text
platformIssuer PlatformInfo
pinfo
                = IdTokenClaims UncheckedLtiTokenClaims
-> Either a (IdTokenClaims UncheckedLtiTokenClaims)
forall a b. b -> Either a b
Right IdTokenClaims UncheckedLtiTokenClaims
claims
            | Bool
otherwise
                = a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
forall a b. a -> Either a b
Left a
"issuer does not match platform issuer"
        -- step 3
        audContainsClientId :: IdTokenClaims a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
audContainsClientId IdTokenClaims a
c
            -- "The Tool MUST reject the ID Token if it does not list the
            -- client_id as a valid audience, or if it contains additional
            -- audiences not trusted by the Tool."
            -- Game on, I don't trust anyone else.
            | [Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length  (IdTokenClaims a -> [Text]
forall a. IdTokenClaims a -> [Text]
aud IdTokenClaims a
c) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& PlatformInfo -> Text
platformClientId PlatformInfo
pinfo Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` IdTokenClaims a -> [Text]
forall a. IdTokenClaims a -> [Text]
aud IdTokenClaims a
c
                = IdTokenClaims UncheckedLtiTokenClaims
-> Either a (IdTokenClaims UncheckedLtiTokenClaims)
forall a b. b -> Either a b
Right IdTokenClaims UncheckedLtiTokenClaims
claims
            | Bool
otherwise
                = a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
forall a b. a -> Either a b
Left a
"aud is invalid"
        -- step 4 and 5 elided -> we can ignore azp because we don't accept >1 aud entries
        -- step 6 is performed elsewhere, probably
        -- step 7 elided because it is handled by 'validateClaims'
        -- step 8 optional
        -- step 9 nonce checking "The ID Token MUST contain a nonce Claim."
        hasNonce :: IdTokenClaims a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
hasNonce IdTokenClaims a
c =
            case IdTokenClaims a -> Maybe ByteString
forall a. IdTokenClaims a -> Maybe ByteString
nonce IdTokenClaims a
c of
                Just ByteString
_  -> IdTokenClaims UncheckedLtiTokenClaims
-> Either a (IdTokenClaims UncheckedLtiTokenClaims)
forall a b. b -> Either a b
Right IdTokenClaims UncheckedLtiTokenClaims
claims
                Maybe ByteString
Nothing -> a -> Either a (IdTokenClaims UncheckedLtiTokenClaims)
forall a b. a -> Either a b
Left a
"nonce missing"
        valid :: Either Text (IdTokenClaims UncheckedLtiTokenClaims) -> Either Text (IdTokenClaims LtiTokenClaims)
        -- unwrap a validated token and rewrap it as a valid token
        valid :: Either Text (IdTokenClaims UncheckedLtiTokenClaims)
-> Either Text (IdTokenClaims LtiTokenClaims)
valid (Left Text
e) = Text -> Either Text (IdTokenClaims LtiTokenClaims)
forall a b. a -> Either a b
Left Text
e
        valid (Right IdTokenClaims UncheckedLtiTokenClaims
tok) =
            IdTokenClaims LtiTokenClaims
-> Either Text (IdTokenClaims LtiTokenClaims)
forall a b. b -> Either a b
Right IdTokenClaims UncheckedLtiTokenClaims
tok { otherClaims :: LtiTokenClaims
otherClaims = UncheckedLtiTokenClaims -> LtiTokenClaims
LtiTokenClaims (UncheckedLtiTokenClaims -> LtiTokenClaims)
-> UncheckedLtiTokenClaims -> LtiTokenClaims
forall a b. (a -> b) -> a -> b
$ IdTokenClaims UncheckedLtiTokenClaims -> UncheckedLtiTokenClaims
forall a. IdTokenClaims a -> a
otherClaims IdTokenClaims UncheckedLtiTokenClaims
tok }


-----------------------------------------------------------
-- Helpers for the endpoints you have to implement
-----------------------------------------------------------

-- | (most of) the exceptions that can arise in LTI 1.3 handling. Some may have
--   been forgotten, and this is a bug that should be fixed.
data LTI13Exception
    = InvalidHandshake Text
    -- ^ Error in the handshake format
    | DiscoveryException Text
    | GotHttpException HttpException
    | InvalidLtiToken Text
    -- ^ Token validation error. Per <http://www.imsglobal.org/spec/security/v1p0/#authentication-response-validation Security § 5.1.3>
    --   if you get this, you should return a 401.
    deriving (Int -> LTI13Exception -> String -> String
[LTI13Exception] -> String -> String
LTI13Exception -> String
(Int -> LTI13Exception -> String -> String)
-> (LTI13Exception -> String)
-> ([LTI13Exception] -> String -> String)
-> Show LTI13Exception
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [LTI13Exception] -> String -> String
$cshowList :: [LTI13Exception] -> String -> String
show :: LTI13Exception -> String
$cshow :: LTI13Exception -> String
showsPrec :: Int -> LTI13Exception -> String -> String
$cshowsPrec :: Int -> LTI13Exception -> String -> String
Show, Typeable)
instance Exception LTI13Exception

-- | @client_id@, one or more per platform; <https://www.imsglobal.org/spec/lti/v1p3/#tool-deployment LTI spec § 3.1.3>
type ClientId = Text

-- | Preregistered information about a learning platform
data PlatformInfo = PlatformInfo
    {
    -- | Issuer value
      PlatformInfo -> Text
platformIssuer :: Issuer
    -- | @client_id@
    , PlatformInfo -> Text
platformClientId :: ClientId
    -- | URL the client is redirected to for <http://www.imsglobal.org/spec/security/v1p0/#step-3-authentication-response auth stage 2>.
    --   See also <http://www.imsglobal.org/spec/security/v1p0/#openid_connect_launch_flow Security spec § 5.1.1>
    , PlatformInfo -> Text
platformOidcAuthEndpoint :: Text
    -- | URL for a JSON object containing the JWK signing keys for the platform
    , PlatformInfo -> String
jwksUrl :: String
    }

-- | Issuer/@iss@ field
type Issuer = Text

-- | Object you have to provide defining integration points with your app
data AuthFlowConfig m = AuthFlowConfig
    { AuthFlowConfig m -> (Text, Maybe Text) -> m PlatformInfo
getPlatformInfo       :: (Issuer, Maybe ClientId) -> m PlatformInfo
    -- ^ Access some persistent storage of the configured platforms and return the
    --   PlatformInfo for a given platform by name
    , AuthFlowConfig m -> ByteString -> m Bool
haveSeenNonce         :: Nonce -> m Bool
    , AuthFlowConfig m -> Text
myRedirectUri         :: Text
    , AuthFlowConfig m -> SessionStore m
sessionStore          :: SessionStore m
    -- ^ Note that as in the example for haskell-oidc-client, this is intended to
    --   be partially parameterized already with some separate cookie you give
    --   the browser. You should also store the @iss@ from the 'initiate' stage
    --   in the session somewhere for the 'handleAuthResponse' stage.
    }

rethrow :: (MonadCatch m) => HttpException -> m a
rethrow :: HttpException -> m a
rethrow = LTI13Exception -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (LTI13Exception -> m a)
-> (HttpException -> LTI13Exception) -> HttpException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> LTI13Exception
GotHttpException

-- | Grab the JWK set from a URL
getJwkSet
    :: Manager
    -> String
    -> IO [Jwk.Jwk]
getJwkSet :: Manager -> String -> IO [Jwk]
getJwkSet Manager
manager String
fromUrl = do
    ByteString
json <- String -> IO ByteString
getJwkSetJson String
fromUrl IO ByteString -> (HttpException -> IO ByteString) -> IO ByteString
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` HttpException -> IO ByteString
forall (m :: * -> *) a. MonadCatch m => HttpException -> m a
rethrow
    case ByteString -> Either String [Jwk]
jwks ByteString
json of
        Right [Jwk]
keys -> [Jwk] -> IO [Jwk]
forall (m :: * -> *) a. Monad m => a -> m a
return [Jwk]
keys
        Left  String
err  -> LTI13Exception -> IO [Jwk]
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (LTI13Exception -> IO [Jwk]) -> LTI13Exception -> IO [Jwk]
forall a b. (a -> b) -> a -> b
$ Text -> LTI13Exception
DiscoveryException (Text
"Failed to decode JwkSet: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack String
err)
  where
    getJwkSetJson :: String -> IO ByteString
getJwkSetJson String
url = do
        Request
req <- String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseRequest String
url
        Response ByteString
res <- Request -> Manager -> IO (Response ByteString)
httpLbs Request
req Manager
manager
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
res

    jwks :: ByteString -> Either String [Jwk]
jwks ByteString
j = JwkSet -> [Jwk]
Jwk.keys (JwkSet -> [Jwk]) -> Either String JwkSet -> Either String [Jwk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String JwkSet
forall a. FromJSON a => ByteString -> Either String a
eitherDecode ByteString
j

lookupOrThrow :: (MonadThrow m) => Text -> Map.Map Text Text -> m Text
lookupOrThrow :: Text -> Map Text Text -> m Text
lookupOrThrow Text
name Map Text Text
map_ =
    case Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
name Map Text Text
map_ of
        Maybe Text
Nothing -> LTI13Exception -> m Text
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (LTI13Exception -> m Text) -> LTI13Exception -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> LTI13Exception
InvalidHandshake (Text -> LTI13Exception) -> Text -> LTI13Exception
forall a b. (a -> b) -> a -> b
$ Text
"Missing `" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
        Just Text
a -> Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
a

-- | Parameters to a request, either in the URL with a @GET@ or in the body
--   with a @POST@
type RequestParams = Map.Map Text Text

-- | Makes the URL for <http://www.imsglobal.org/spec/security/v1p0/#step-1-third-party-initiated-login IMS Security spec § 5.1.1.2>
--   upon the § 5.1.1.1 request coming in
--
--   Returns @(Issuer, RedirectURL)@.
initiate :: (MonadIO m) => AuthFlowConfig m -> RequestParams -> m (Issuer, ClientId, Text)
initiate :: AuthFlowConfig m -> Map Text Text -> m (Text, Text, Text)
initiate AuthFlowConfig m
cfg Map Text Text
params = do
    -- we don't care about target link uri since we only support one endpoint
    [Text]
res <- IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> IO Text) -> [Text] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Map Text Text -> IO Text
forall (m :: * -> *).
MonadThrow m =>
Text -> Map Text Text -> m Text
`lookupOrThrow` Map Text Text
params) [Text
"iss", Text
"login_hint", Text
"target_link_uri"]
    -- not actually fallible
    let [Text
iss, Text
loginHint, Text
_] = [Text]
res
    let messageHint :: Maybe Text
messageHint = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"lti_message_hint" Map Text Text
params
    -- "This allows for a platform to support multiple registrations from a
    -- single issuer, without relying on the initiate_login_uri as a key."
    --
    -- Canvas puts the same issuer on all their messages (wat)
    -- (https://community.canvaslms.com/thread/36682-lti13-how-to-identify-clientid-and-deploymentid-on-launch)
    -- so we need to be able to distinguish these. Our client code must
    -- therefore key its platform info store by @(Issuer, Maybe ClientId)@
    let gotCid :: Maybe Text
gotCid = Text -> Map Text Text -> Maybe Text
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
"client_id" Map Text Text
params
    PlatformInfo
        { platformOidcAuthEndpoint :: PlatformInfo -> Text
platformOidcAuthEndpoint = Text
endpoint
        , platformClientId :: PlatformInfo -> Text
platformClientId = Text
clientId } <- AuthFlowConfig m -> (Text, Maybe Text) -> m PlatformInfo
forall (m :: * -> *).
AuthFlowConfig m -> (Text, Maybe Text) -> m PlatformInfo
getPlatformInfo AuthFlowConfig m
cfg (Text
iss, Maybe Text
gotCid)

    let ss :: SessionStore m
ss = AuthFlowConfig m -> SessionStore m
forall (m :: * -> *). AuthFlowConfig m -> SessionStore m
sessionStore AuthFlowConfig m
cfg
    ByteString
nonce <- SessionStore m -> m ByteString
forall (m :: * -> *). SessionStore m -> m ByteString
sessionStoreGenerate SessionStore m
ss
    ByteString
state <- SessionStore m -> m ByteString
forall (m :: * -> *). SessionStore m -> m ByteString
sessionStoreGenerate SessionStore m
ss
    SessionStore m -> ByteString -> ByteString -> m ()
forall (m :: * -> *).
SessionStore m -> ByteString -> ByteString -> m ()
sessionStoreSave SessionStore m
ss ByteString
state ByteString
nonce

    let query :: Query
query = SimpleQuery -> Query
URI.simpleQueryToQuery (SimpleQuery -> Query) -> SimpleQuery -> Query
forall a b. (a -> b) -> a -> b
$
                [ (ByteString
"scope", ByteString
"openid")
                , (ByteString
"response_type", ByteString
"id_token")
                , (ByteString
"client_id", Text -> ByteString
encodeUtf8 Text
clientId)
                , (ByteString
"redirect_uri", Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ AuthFlowConfig m -> Text
forall (m :: * -> *). AuthFlowConfig m -> Text
myRedirectUri AuthFlowConfig m
cfg)
                , (ByteString
"login_hint", Text -> ByteString
encodeUtf8 Text
loginHint)
                , (ByteString
"state", ByteString
state)
                , (ByteString
"response_mode", ByteString
"form_post")
                , (ByteString
"nonce", ByteString
nonce)
                , (ByteString
"prompt", ByteString
"none")
                ] SimpleQuery -> SimpleQuery -> SimpleQuery
forall a. [a] -> [a] -> [a]
++ SimpleQuery -> (Text -> SimpleQuery) -> Maybe Text -> SimpleQuery
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Text
mh -> [(ByteString
"lti_message_hint", Text -> ByteString
encodeUtf8 Text
mh)]) Maybe Text
messageHint
    (Text, Text, Text) -> m (Text, Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
iss, Text
clientId, Text
endpoint Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Query -> ByteString) -> Query -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Query -> ByteString
URI.renderQuery Bool
True) Query
query)

-- | Makes a fake OIDC object with the bare minimum attributes to hand to
--   verification library functions
fakeOidc :: [Jwk.Jwk] -> O.OIDC
fakeOidc :: [Jwk] -> OIDC
fakeOidc [Jwk]
jset = OIDC :: Text
-> Text
-> ByteString
-> ByteString
-> ByteString
-> Provider
-> OIDC
O.OIDC
        { oidcProvider :: Provider
O.oidcProvider = Provider :: Configuration -> [Jwk] -> Provider
P.Provider
                { configuration :: Configuration
P.configuration = Configuration :: Text
-> Text
-> Text
-> Maybe Text
-> Maybe Text
-> Text
-> [Text]
-> [Text]
-> [JwsAlgJson]
-> Maybe [Text]
-> Maybe [Text]
-> Maybe [Text]
-> Configuration
P.Configuration
                    { idTokenSigningAlgValuesSupported :: [JwsAlgJson]
P.idTokenSigningAlgValuesSupported = [ JwsAlg -> JwsAlgJson
P.JwsAlgJson JwsAlg
RS256 ]
                    , issuer :: Text
P.issuer = Text
forall a. HasCallStack => a
undefined
                    , authorizationEndpoint :: Text
P.authorizationEndpoint = Text
forall a. HasCallStack => a
undefined
                    , tokenEndpoint :: Text
P.tokenEndpoint = Text
forall a. HasCallStack => a
undefined
                    , userinfoEndpoint :: Maybe Text
P.userinfoEndpoint = Maybe Text
forall a. HasCallStack => a
undefined
                    , revocationEndpoint :: Maybe Text
P.revocationEndpoint = Maybe Text
forall a. HasCallStack => a
undefined
                    , jwksUri :: Text
P.jwksUri = Text
forall a. HasCallStack => a
undefined
                    , responseTypesSupported :: [Text]
P.responseTypesSupported = [Text]
forall a. HasCallStack => a
undefined
                    , subjectTypesSupported :: [Text]
P.subjectTypesSupported = [Text]
forall a. HasCallStack => a
undefined
                    , scopesSupported :: Maybe [Text]
P.scopesSupported = Maybe [Text]
forall a. HasCallStack => a
undefined
                    , tokenEndpointAuthMethodsSupported :: Maybe [Text]
P.tokenEndpointAuthMethodsSupported = Maybe [Text]
forall a. HasCallStack => a
undefined
                    , claimsSupported :: Maybe [Text]
P.claimsSupported = Maybe [Text]
forall a. HasCallStack => a
undefined
                    }
                , jwkSet :: [Jwk]
P.jwkSet = [Jwk]
jset
                }
        , oidcAuthorizationServerUrl :: Text
O.oidcAuthorizationServerUrl = Text
forall a. HasCallStack => a
undefined
        , oidcTokenEndpoint :: Text
O.oidcTokenEndpoint = Text
forall a. HasCallStack => a
undefined
        , oidcClientId :: ByteString
O.oidcClientId = ByteString
forall a. HasCallStack => a
undefined
        , oidcClientSecret :: ByteString
O.oidcClientSecret = ByteString
forall a. HasCallStack => a
undefined
        , oidcRedirectUri :: ByteString
O.oidcRedirectUri = ByteString
forall a. HasCallStack => a
undefined
        }

-- | Handle the <http://www.imsglobal.org/spec/security/v1p0/#step-3-authentication-response § 5.1.1.3 Step 3>
--   response sent to the 'AuthFlowConfig.myRedirectUri'
--
--   Returns @(State, Token)@
handleAuthResponse :: (MonadIO m)
    => Manager
    -> AuthFlowConfig m
    -> RequestParams
    -> PlatformInfo
    -> m (Text, IdTokenClaims LtiTokenClaims)
handleAuthResponse :: Manager
-> AuthFlowConfig m
-> Map Text Text
-> PlatformInfo
-> m (Text, IdTokenClaims LtiTokenClaims)
handleAuthResponse Manager
mgr AuthFlowConfig m
cfg Map Text Text
params PlatformInfo
pinfo = do
    [Text]
params' <- IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> IO Text) -> [Text] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text -> Map Text Text -> IO Text
forall (m :: * -> *).
MonadThrow m =>
Text -> Map Text Text -> m Text
`lookupOrThrow` Map Text Text
params) [Text
"state", Text
"id_token"]
    let [Text
state, Text
idToken] = [Text]
params'

    let PlatformInfo { String
jwksUrl :: String
jwksUrl :: PlatformInfo -> String
jwksUrl } = PlatformInfo
pinfo
    [Jwk]
jwkSet <- IO [Jwk] -> m [Jwk]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Jwk] -> m [Jwk]) -> IO [Jwk] -> m [Jwk]
forall a b. (a -> b) -> a -> b
$ Manager -> String -> IO [Jwk]
getJwkSet Manager
mgr String
jwksUrl

    let ss :: SessionStore m
ss = AuthFlowConfig m -> SessionStore m
forall (m :: * -> *). AuthFlowConfig m -> SessionStore m
sessionStore AuthFlowConfig m
cfg
        oidc :: OIDC
oidc = [Jwk] -> OIDC
fakeOidc [Jwk]
jwkSet
    IdTokenClaims UncheckedLtiTokenClaims
toCheck <- SessionStore m
-> OIDC
-> ByteString
-> m ByteString
-> m (IdTokenClaims UncheckedLtiTokenClaims)
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
SessionStore m
-> OIDC -> ByteString -> m ByteString -> m (IdTokenClaims a)
getValidIdTokenClaims SessionStore m
ss OIDC
oidc (Text -> ByteString
encodeUtf8 Text
state) (ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
idToken)

    -- present nonce but seen -> error
    -- present nonce unseen -> good
    -- absent nonce -> different error
    Bool
nonceSeen <- case IdTokenClaims UncheckedLtiTokenClaims -> Maybe ByteString
forall a. IdTokenClaims a -> Maybe ByteString
nonce IdTokenClaims UncheckedLtiTokenClaims
toCheck of
        Just ByteString
n  -> AuthFlowConfig m -> ByteString -> m Bool
forall (m :: * -> *). AuthFlowConfig m -> ByteString -> m Bool
haveSeenNonce AuthFlowConfig m
cfg ByteString
n
        Maybe ByteString
Nothing -> IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ LTI13Exception -> IO Bool
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (LTI13Exception -> IO Bool) -> LTI13Exception -> IO Bool
forall a b. (a -> b) -> a -> b
$ Text -> LTI13Exception
InvalidLtiToken Text
"missing nonce"
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
nonceSeen (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ LTI13Exception -> IO ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (LTI13Exception -> IO ()) -> LTI13Exception -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> LTI13Exception
InvalidLtiToken Text
"nonce seen before")

    case PlatformInfo
-> IdTokenClaims UncheckedLtiTokenClaims
-> Either Text (IdTokenClaims LtiTokenClaims)
validateLtiToken PlatformInfo
pinfo IdTokenClaims UncheckedLtiTokenClaims
toCheck of
        Left Text
err  -> IO (Text, IdTokenClaims LtiTokenClaims)
-> m (Text, IdTokenClaims LtiTokenClaims)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Text, IdTokenClaims LtiTokenClaims)
 -> m (Text, IdTokenClaims LtiTokenClaims))
-> IO (Text, IdTokenClaims LtiTokenClaims)
-> m (Text, IdTokenClaims LtiTokenClaims)
forall a b. (a -> b) -> a -> b
$ LTI13Exception -> IO (Text, IdTokenClaims LtiTokenClaims)
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throw (LTI13Exception -> IO (Text, IdTokenClaims LtiTokenClaims))
-> LTI13Exception -> IO (Text, IdTokenClaims LtiTokenClaims)
forall a b. (a -> b) -> a -> b
$ Text -> LTI13Exception
InvalidLtiToken Text
err
        Right IdTokenClaims LtiTokenClaims
tok -> (Text, IdTokenClaims LtiTokenClaims)
-> m (Text, IdTokenClaims LtiTokenClaims)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
state, IdTokenClaims LtiTokenClaims
tok)