lti13 0.2.0.0 → 0.2.0.1
raw patch · 3 files changed
+41/−36 lines, 3 filesdep ~aesondep ~jose-jwtdep ~oidc-client
Dependency ranges changed: aeson, jose-jwt, oidc-client
Files
- CHANGELOG.md +16/−11
- lti13.cabal +4/−4
- src/Web/LTI13.hs +21/−21
CHANGELOG.md view
@@ -1,26 +1,31 @@ # Revision history for lti13 -## 0.1.0.0 -- 2020-08-13+## 0.2.0.1 -- 2021-02-26 -* Unreleased+* Fix version bounds -## 0.1.1.0 -- 2020-09-15+## 0.2.0.0 -- 2021-01-09 -* Handle Canvas Cloud setting all their issuers the same.+* We parse the LIS claim+* Unit tests added -## 0.1.2.0 -- 2020-09-16+## 0.1.2.2 -- 2020-09-19 -* No changes+* We now parse the name fields ## 0.1.2.1 -- 2020-09-16 * Attempt to fix docs building on ghc862 -## 0.1.2.2 -- 2020-09-19+## 0.1.2.0 -- 2020-09-16 -* We now parse the name fields+* No changes -## 0.2.0.0 -- 2021-01-09+## 0.1.1.0 -- 2020-09-15 -* We parse the LIS claim-* Unit tests added+* Handle Canvas Cloud setting all their issuers the same.++## 0.1.0.0 -- 2020-08-13++* Unreleased+
lti13.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.10 name: lti13-version: 0.2.0.0+version: 0.2.0.1 synopsis: Core functionality for LTI 1.3. description: A library implementing the core <http://www.imsglobal.org/spec/lti/v1p3/ LTI 1.3> authentication protocol,@@ -39,15 +39,15 @@ -- other-modules: -- other-extensions: hs-source-dirs: src- build-depends: aeson >= 1.4.7 && < 1.5+ build-depends: aeson >= 1.4.7 && < 1.6 , base >= 4.12.0 && < 5 , bytestring >= 0.10.10 && < 0.11 , containers >= 0.6.2 && < 0.7 , text >= 1.2.4 && < 1.3 , http-client >= 0.6.4 && < 0.7 , http-types >= 0.12.3 && < 0.13- , jose-jwt >= 0.8.0 && < 0.9- , oidc-client >= 0.5.1 && < 0.6+ , jose-jwt >= 0.8.0 && < 0.10+ , oidc-client >= 0.5.1 && < 0.7 , safe-exceptions >= 0.1.7 && < 0.2 default-language: Haskell2010 ghc-options: -Wall
src/Web/LTI13.hs view
@@ -55,7 +55,7 @@ if v == fixedVal then return v else- fail $ "field " ++ (show field) ++ " was not the required value " ++ (show fixedVal)+ fail $ "field " ++ show field ++ " was not the required value " ++ show 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>@@ -66,7 +66,7 @@ | Instructor | Learner | Mentor- | Other (Text)+ | Other Text deriving (Show, Eq) roleFromString :: Text -> Role@@ -121,9 +121,9 @@ <*> v .:? "result_sourcedid" instance ToJSON LisClaim where- toJSON (LisClaim {personSourcedId, outcomeServiceUrl,+ toJSON LisClaim {personSourcedId, outcomeServiceUrl, courseOfferingSourcedId, courseSectionSourcedId,- resultSourcedId}) =+ resultSourcedId} = object [ "person_sourcedid" .= personSourcedId , "outcome_service_url" .= outcomeServiceUrl@@ -131,9 +131,9 @@ , "course_section_sourcedid" .= courseSectionSourcedId , "result_sourcedid" .= resultSourcedId ]- toEncoding (LisClaim {personSourcedId, outcomeServiceUrl,+ toEncoding LisClaim {personSourcedId, outcomeServiceUrl, courseOfferingSourcedId, courseSectionSourcedId,- resultSourcedId}) =+ resultSourcedId} = pairs ( "person_sourcedid" .= personSourcedId <> "outcome_service_url" .= outcomeServiceUrl <>@@ -158,13 +158,13 @@ <*> v .:? "title" instance ToJSON ContextClaim where- toJSON (ContextClaim {contextId, contextLabel, contextTitle}) =+ toJSON ContextClaim {contextId, contextLabel, contextTitle} = object [ "id" .= contextId , "label" .= contextLabel , "title" .= contextTitle ]- toEncoding (ContextClaim {contextId, contextLabel, contextTitle}) =+ toEncoding ContextClaim {contextId, contextLabel, contextTitle} = pairs ( "id" .= contextId <> "label" .= contextLabel <>@@ -195,7 +195,7 @@ limitLength :: (Fail.MonadFail m) => Int -> Text -> m Text limitLength len string- | (T.length string) <= len+ | T.length string <= len = return string limitLength _ _ = fail "String is too long" @@ -217,8 +217,8 @@ instance FromJSON UncheckedLtiTokenClaims where parseJSON = withObject "LtiTokenClaims" $ \v -> UncheckedLtiTokenClaims- <$> (parseFixed v claimMessageType "LtiResourceLinkRequest")- <*> (parseFixed v claimVersion "1.3.0")+ <$> parseFixed v claimMessageType "LtiResourceLinkRequest"+ <*> parseFixed v claimVersion "1.3.0" <*> (v .: claimDeploymentId >>= limitLength 255) <*> v .: claimTargetLinkUri <*> v .: claimRoles@@ -230,10 +230,10 @@ <*> v .:? claimLis instance ToJSON UncheckedLtiTokenClaims where- toJSON (UncheckedLtiTokenClaims {+ toJSON UncheckedLtiTokenClaims { messageType, ltiVersion, deploymentId , targetLinkUri, roles, email, displayName- , firstName, lastName, context, lis}) =+ , firstName, lastName, context, lis} = object [ claimMessageType .= messageType , claimVersion .= ltiVersion@@ -247,10 +247,10 @@ , claimContext .= context , claimLis .= lis ]- toEncoding (UncheckedLtiTokenClaims {+ toEncoding UncheckedLtiTokenClaims { messageType, ltiVersion, deploymentId , targetLinkUri, roles, email, displayName- , firstName, lastName, context, lis}) =+ , firstName, lastName, context, lis} = pairs ( claimMessageType .= messageType <> claimVersion .= ltiVersion@@ -289,7 +289,7 @@ -- 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.- | (length $ aud c) == 1 && (platformClientId pinfo) `elem` (aud c)+ | length (aud c) == 1 && platformClientId pinfo `elem` aud c = Right claims | otherwise = Left "aud is invalid"@@ -306,7 +306,7 @@ -- unwrap a validated token and rewrap it as a valid token valid (Left e) = Left e valid (Right tok) =- Right tok { otherClaims = (LtiTokenClaims $ otherClaims tok) }+ Right tok { otherClaims = LtiTokenClaims $ otherClaims tok } -----------------------------------------------------------@@ -398,7 +398,7 @@ initiate :: (MonadIO m) => AuthFlowConfig m -> RequestParams -> m (Issuer, ClientId, Text) initiate cfg params = do -- we don't care about target link uri since we only support one endpoint- res <- liftIO $ mapM (flip lookupOrThrow params) ["iss", "login_hint", "target_link_uri"]+ res <- liftIO $ mapM (`lookupOrThrow` params) ["iss", "login_hint", "target_link_uri"] -- not actually fallible let [iss, loginHint, _] = res let messageHint = Map.lookup "lti_message_hint" params@@ -412,7 +412,7 @@ let gotCid = Map.lookup "client_id" params PlatformInfo { platformOidcAuthEndpoint = endpoint- , platformClientId = clientId } <- (getPlatformInfo cfg) (iss, gotCid)+ , platformClientId = clientId } <- getPlatformInfo cfg (iss, gotCid) let ss = sessionStore cfg nonce <- sessionStoreGenerate ss@@ -430,7 +430,7 @@ , ("nonce", nonce) , ("prompt", "none") ] ++ maybe [] (\mh -> [("lti_message_hint", encodeUtf8 mh)]) messageHint- return $ (iss, clientId, endpoint <> (decodeUtf8 . URI.renderQuery True) query)+ return (iss, clientId, endpoint <> (decodeUtf8 . URI.renderQuery True) query) -- | Makes a fake OIDC object with the bare minimum attributes to hand to -- verification library functions@@ -471,7 +471,7 @@ -> PlatformInfo -> m (Text, IdTokenClaims LtiTokenClaims) handleAuthResponse mgr cfg params pinfo = do- params' <- liftIO $ mapM (flip lookupOrThrow params) ["state", "id_token"]+ params' <- liftIO $ mapM (`lookupOrThrow` params) ["state", "id_token"] let [state, idToken] = params' let PlatformInfo { jwksUrl } = pinfo