diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 + diff --git a/lti13.cabal b/lti13.cabal --- a/lti13.cabal +++ b/lti13.cabal @@ -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 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 diff --git a/src/Web/LTI13.hs b/src/Web/LTI13.hs --- a/src/Web/LTI13.hs +++ b/src/Web/LTI13.hs @@ -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 -- @@ -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