diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,12 @@ # Revision history for lti13 +## 0.3.0.0 -- 2022-11-23 + +* Support newer compilers and dependencies + * aeson >= 2 now required; + * oidc-client >= 0.7 now required + * Support ghc-9.4 + ## 0.2.0.3 -- 2021-08-10 * Bump version for yesod-auth-lti13. diff --git a/lti13.cabal b/lti13.cabal --- a/lti13.cabal +++ b/lti13.cabal @@ -1,57 +1,91 @@ -cabal-version: >=1.10 +cabal-version: 1.12 -name: lti13 -version: 0.2.0.3 -synopsis: Core functionality for LTI 1.3. -description: A library implementing the core - authentication protocol, - suitable for use in implementing libraries for any web framework. An example - use is -bug-reports: https://github.com/lf-/lti13/issues -license: LGPL-3 -author: Jade -maintainer: Jade --- copyright: -category: Web -license-file: LICENSE -build-type: Simple -extra-source-files: CHANGELOG.md - README.md +-- This file has been generated from package.yaml by hpack version 0.34.7. +-- +-- see: https://github.com/sol/hpack -test-suite spec - type: exitcode-stdio-1.0 - default-language: Haskell2010 - hs-source-dirs: tests - ghc-options: -Wall - main-is: Spec.hs - build-depends: base - , hspec - , QuickCheck - , file-embed - , th-utilities - , text - , bytestring - , aeson - , lti13 +name: lti13 +version: 0.3.0.0 +synopsis: Core functionality for LTI 1.3 +description: A library implementing the core authentication protocol, suitable for use in implementing libraries for any web framework. An example use is +category: Web +homepage: https://github.com/lf-/lti13#readme +bug-reports: https://github.com/lf-/lti13/issues +author: Jade Lovelace +maintainer: Jade Lovelace +license: LGPL-3 +license-file: LICENSE +build-type: Simple +tested-with: + GHC ==8.10.7 || ==9.2.5 || ==9.4.3 +extra-source-files: + CHANGELOG.md + README.md + ./tests/example.json +source-repository head + type: git + location: https://github.com/lf-/lti13 + library - exposed-modules: Web.LTI13 - -- other-modules: - -- other-extensions: - hs-source-dirs: src - 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.10 - , oidc-client >= 0.5.1 && < 0.7 - , safe-exceptions >= 0.1.7 && < 0.2 - default-language: Haskell2010 - ghc-options: -Wall + exposed-modules: + Web.LTI13 + other-modules: + Paths_lti13 + hs-source-dirs: + src + default-extensions: + NamedFieldPuns + OverloadedStrings + RecordWildCards + DerivingStrategies + DeriveGeneric + ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-export-lists -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-missing-kind-signatures + build-depends: + aeson >=2 && <2.2 + , base >=4.12.0 && <5 + , bytestring >=0.10.10 && <0.12 + , containers >=0.6.2 && <0.7 + , http-client >=0.6.4 && <0.8 + , http-types >=0.12.3 && <0.13 + , jose-jwt >=0.8.0 && <0.10 + , oidc-client ==0.7.* + , safe-exceptions >=0.1.7 && <0.2 + , text >=1.2.4 && <1.3 || >=2.0 && <2.1 + default-language: Haskell2010 -source-repository head - type: git - location: https://github.com/lf-/lti13 +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + AnonSpec + ParsingSpec + Paths_lti13 + hs-source-dirs: + tests + default-extensions: + NamedFieldPuns + OverloadedStrings + RecordWildCards + DerivingStrategies + DeriveGeneric + ghc-options: -Weverything -Wno-missing-exported-signatures -Wno-missing-export-lists -Wno-missing-import-lists -Wno-missed-specialisations -Wno-all-missed-specialisations -Wno-unsafe -Wno-missing-local-signatures -Wno-monomorphism-restriction -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module -Wno-unused-packages -Wno-missing-kind-signatures + build-tool-depends: + hspec-discover:hspec-discover + build-depends: + QuickCheck + , aeson >=2 && <2.2 + , base >=4.12.0 && <5 + , bytestring >=0.10.10 && <0.12 + , containers >=0.6.2 && <0.7 + , file-embed + , hspec + , http-client >=0.6.4 && <0.8 + , http-types >=0.12.3 && <0.13 + , jose-jwt >=0.8.0 && <0.10 + , lti13 + , oidc-client ==0.7.* + , safe-exceptions >=0.1.7 && <0.2 + , text >=1.2.4 && <1.3 || >=2.0 && <2.1 + , th-utilities + default-language: Haskell2010 diff --git a/src/Web/LTI13.hs b/src/Web/LTI13.hs --- a/src/Web/LTI13.hs +++ b/src/Web/LTI13.hs @@ -1,8 +1,4 @@ -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RecordWildCards #-} - --- | A basic LTI 1.3 library. +-- | A simple LTI 1.3 library. -- It's intended to be used by implementing routes for 'initiate' and -- 'handleAuthResponse', and work out the associated parameters thereof. -- @@ -35,7 +31,7 @@ , handleAuthResponse ) where import Control.Exception.Safe (Exception, MonadCatch, - MonadThrow, Typeable, + MonadThrow, catch, throw, throwM) import Control.Monad (when, (>=>)) import qualified Control.Monad.Fail as Fail @@ -50,6 +46,7 @@ import qualified Data.Aeson as A import Data.Aeson.Types (Parser) import qualified Data.Map.Strict as Map +import Data.String (IsString) import Data.Text (Text) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8, encodeUtf8) @@ -59,6 +56,7 @@ httpLbs, parseRequest, responseBody) import qualified Network.HTTP.Types.URI as URI +import Prelude import qualified Web.OIDC.Client.Discovery.Provider as P import Web.OIDC.Client.IdTokenFlow (getValidIdTokenClaims) import qualified Web.OIDC.Client.Settings as O @@ -67,7 +65,7 @@ import Web.OIDC.Client.Types (Nonce, SessionStore (..)) -- | 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 :: (FromJSON a, Eq a, Show a) => Object -> A.Key -> a -> Parser a parseFixed obj field fixedVal = obj .: field >>= \v -> if v == fixedVal then @@ -85,7 +83,7 @@ | Learner | Mentor | Other Text - deriving (Show, Eq) + deriving stock (Show, Eq) roleFromString :: Text -> Role roleFromString "http://purl.imsglobal.org/vocab/lis/v2/membership#Administrator" @@ -127,7 +125,7 @@ , resultSourcedId :: Maybe Text -- ^ An identifier for the position in the gradebook associated with the -- assignment being viewed. - } deriving (Show, Eq) + } deriving stock (Show, Eq) instance FromJSON LisClaim where parseJSON = withObject "LisClaim" $ \v -> @@ -166,7 +164,7 @@ , contextLabel :: Maybe Text , contextTitle :: Maybe Text } - deriving (Show, Eq) + deriving stock (Show, Eq) instance FromJSON ContextClaim where parseJSON = withObject "ContextClaim" $ \v -> @@ -204,16 +202,16 @@ , lastName :: Maybe Text , context :: Maybe ContextClaim , lis :: Maybe LisClaim - } deriving (Show, Eq) + } deriving stock (Show, Eq) -- | An object representing in the type system a token whose claims have been -- validated. newtype LtiTokenClaims = LtiTokenClaims { unLtiTokenClaims :: UncheckedLtiTokenClaims } - deriving (Show, Eq) + deriving stock (Show, Eq) -- | LTI token claims from which all student data has been removed. For logging. newtype AnonymizedLtiTokenClaims = AnonymizedLtiTokenClaims UncheckedLtiTokenClaims - deriving (Show, Eq) + deriving stock (Show, Eq) limitLength :: (Fail.MonadFail m) => Int -> Text -> m Text limitLength len string @@ -221,19 +219,19 @@ = return string limitLength _ _ = fail "String is too long" -claimMessageType :: Text +claimMessageType :: IsString t => t claimMessageType = "https://purl.imsglobal.org/spec/lti/claim/message_type" -claimVersion :: Text +claimVersion :: IsString t => t claimVersion = "https://purl.imsglobal.org/spec/lti/claim/version" -claimDeploymentId :: Text +claimDeploymentId :: IsString t => t claimDeploymentId = "https://purl.imsglobal.org/spec/lti/claim/deployment_id" -claimTargetLinkUri :: Text +claimTargetLinkUri :: IsString t => t claimTargetLinkUri = "https://purl.imsglobal.org/spec/lti/claim/target_link_uri" -claimRoles :: Text +claimRoles :: IsString t => t claimRoles = "https://purl.imsglobal.org/spec/lti/claim/roles" -claimContext :: Text +claimContext :: IsString t => t claimContext = "https://purl.imsglobal.org/spec/lti/claim/context" -claimLis :: Text +claimLis :: IsString t => t claimLis = "https://purl.imsglobal.org/spec/lti/claim/lis" instance FromJSON UncheckedLtiTokenClaims where @@ -345,7 +343,7 @@ | InvalidLtiToken Text -- ^ Token validation error. Per -- if you get this, you should return a 401. - deriving (Show, Typeable) + deriving stock (Show) instance Exception LTI13Exception -- | @client_id@, one or more per platform; @@ -420,9 +418,10 @@ 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 (`lookupOrThrow` params) ["iss", "login_hint", "target_link_uri"] - -- not actually fallible - let [iss, loginHint, _] = res + iss <- liftIO $ lookupOrThrow "iss" params + loginHint <- liftIO $ lookupOrThrow "login_hint" params + _targetLinkUri <- liftIO $ lookupOrThrow "target_link_uri" params + let messageHint = Map.lookup "lti_message_hint" params -- "This allows for a platform to support multiple registrations from a -- single issuer, without relying on the initiate_login_uri as a key." @@ -493,8 +492,8 @@ -> PlatformInfo -> m (Text, IdTokenClaims LtiTokenClaims) handleAuthResponse mgr cfg params pinfo = do - params' <- liftIO $ mapM (`lookupOrThrow` params) ["state", "id_token"] - let [state, idToken] = params' + state <- liftIO $ lookupOrThrow "state" params + idToken <- liftIO $ lookupOrThrow "id_token" params let PlatformInfo { jwksUrl } = pinfo jwkSet <- liftIO $ getJwkSet mgr jwksUrl diff --git a/tests/AnonSpec.hs b/tests/AnonSpec.hs new file mode 100644 --- /dev/null +++ b/tests/AnonSpec.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | Tests the various parsers in lti13 round-trip and parse the samples. +module AnonSpec (spec) where + +import Test.Hspec hiding (context) +import Prelude +import Web.LTI13 + +exampleToken :: UncheckedLtiTokenClaims +exampleToken = UncheckedLtiTokenClaims + { messageType = "LtiResourceLinkRequest" + , ltiVersion = "1.3.0" + , deploymentId = "07940580-b309-415e-a37c-914d387c1150" + , targetLinkUri = "https://tool.example.com/lti/48320/ruix8782rs" + , roles = [Other "http://purl.imsglobal.org/vocab/lis/v2/institution/person#Student",Learner,Mentor] + , email = secret + , displayName = secret + , firstName = secret + , lastName = secret + , context = Just ( + ContextClaim + { contextId = "c1d887f0-a1a3-4bca-ae25-c375edcc131a" + , contextLabel = Just "ECON 1010" + , contextTitle = Just "Economics as a Social Science"} + ) + , lis = Just ( + LisClaim { + personSourcedId = secret + , outcomeServiceUrl = Nothing + , courseOfferingSourcedId = Just "example.edu:SI182-F16" + , courseSectionSourcedId = Just "example.edu:SI182-001-F16" + , resultSourcedId = Nothing + } + )} + where + secret = Just "secret" + +spec :: Spec +spec = do + it "removes secrets" $ do + show exampleToken `shouldContain` "secret" + (show . anonymizeLtiTokenForLogging $ exampleToken) `shouldNotContain` "secret" diff --git a/tests/ParsingSpec.hs b/tests/ParsingSpec.hs new file mode 100644 --- /dev/null +++ b/tests/ParsingSpec.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE TemplateHaskell, OverloadedStrings #-} +-- | Tests the various parsers in lti13 round-trip and parse the samples. +module ParsingSpec (spec) where + +import Test.Hspec +import Test.Hspec.QuickCheck +import Data.FileEmbed +import TH.RelativePaths +import Web.LTI13 +import qualified Web.LTI13 as LTI +import Data.Aeson +import Prelude +import qualified Data.ByteString as BS + +-- | This is lifted directly from section E of the LTI 1.3 spec. +ltiSpecExample :: BS.ByteString +ltiSpecExample = $(embedFile =<< pathRelativeToCabalPackage "tests/example.json") + +specExampleOutput :: UncheckedLtiTokenClaims +specExampleOutput = UncheckedLtiTokenClaims { + messageType = "LtiResourceLinkRequest" + , ltiVersion = "1.3.0" + , deploymentId = "07940580-b309-415e-a37c-914d387c1150" + , targetLinkUri = "https://tool.example.com/lti/48320/ruix8782rs" + , roles = [Other "http://purl.imsglobal.org/vocab/lis/v2/institution/person#Student",Learner,Mentor] + , email = Just "jane@platform.example.edu" + , displayName = Just "Ms Jane Marie Doe" + , firstName = Just "Jane" + , lastName = Just "Doe" + , LTI.context = Just ( + ContextClaim + { contextId = "c1d887f0-a1a3-4bca-ae25-c375edcc131a" + , contextLabel = Just "ECON 1010" + , contextTitle = Just "Economics as a Social Science"} + ) + , lis = Just ( + LisClaim { + personSourcedId = Just "example.edu:71ee7e42-f6d2-414a-80db-b69ac2defd4" + , outcomeServiceUrl = Nothing + , courseOfferingSourcedId = Just "example.edu:SI182-F16" + , courseSectionSourcedId = Just "example.edu:SI182-001-F16" + , resultSourcedId = Nothing + } + )} + +spec :: Spec +spec = do + describe "id" $ do + prop "id" $ \x y -> + add x y == add y x + describe "main parser" $ do + it "parses the file from section E of the lti spec" $ do + let v = decodeStrict ltiSpecExample :: Maybe UncheckedLtiTokenClaims + -- (putStrLn . show $ v) `shouldReturn` () + v `shouldBe` Just specExampleOutput + let roundTripped = decode . encode =<< v + roundTripped `shouldBe` Just specExampleOutput + +add :: Int -> Int -> Int +add x y = x + y diff --git a/tests/example.json b/tests/example.json new file mode 100644 --- /dev/null +++ b/tests/example.json @@ -0,0 +1,71 @@ +{ + "iss": "https://platform.example.edu", + "sub": "a6d5c443-1f51-4783-ba1a-7686ffe3b54a", + "aud": ["962fa4d8-bcbf-49a0-94b2-2de05ad274af"], + "exp": 1510185728, + "iat": 1510185228, + "azp": "962fa4d8-bcbf-49a0-94b2-2de05ad274af", + "nonce": "fc5fdc6d-5dd6-47f4-b2c9-5d1216e9b771", + "name": "Ms Jane Marie Doe", + "given_name": "Jane", + "family_name": "Doe", + "middle_name": "Marie", + "picture": "https://platform.example.edu/jane.jpg", + "email": "jane@platform.example.edu", + "locale": "en-US", + "https://purl.imsglobal.org/spec/lti/claim/deployment_id": + "07940580-b309-415e-a37c-914d387c1150", + "https://purl.imsglobal.org/spec/lti/claim/message_type": "LtiResourceLinkRequest", + "https://purl.imsglobal.org/spec/lti/claim/version": "1.3.0", + "https://purl.imsglobal.org/spec/lti/claim/roles": [ + "http://purl.imsglobal.org/vocab/lis/v2/institution/person#Student", + "http://purl.imsglobal.org/vocab/lis/v2/membership#Learner", + "http://purl.imsglobal.org/vocab/lis/v2/membership#Mentor" + ], + "https://purl.imsglobal.org/spec/lti/claim/role_scope_mentor": [ + "fad5fb29-a91c-770-3c110-1e687120efd9", + "5d7373de-c76c-e2b-01214-69e487e2bd33", + "d779cfd4-bc7b-019-9bf1a-04bf1915d4d0" + ], + "https://purl.imsglobal.org/spec/lti/claim/context": { + "id": "c1d887f0-a1a3-4bca-ae25-c375edcc131a", + "label": "ECON 1010", + "title": "Economics as a Social Science", + "type": ["http://purl.imsglobal.org/vocab/lis/v2/course#CourseOffering"] + }, + "https://purl.imsglobal.org/spec/lti/claim/resource_link": { + "id": "200d101f-2c14-434a-a0f3-57c2a42369fd", + "description": "Assignment to introduce who you are", + "title": "Introduction Assignment" + }, + "https://purl.imsglobal.org/spec/lti/claim/tool_platform": { + "guid": "ex/48bbb541-ce55-456e-8b7d-ebc59a38d435", + "contact_email": "support@platform.example.edu", + "description": "An Example Tool Platform", + "name": "Example Tool Platform", + "url": "https://platform.example.edu", + "product_family_code": "ExamplePlatformVendor-Product", + "version": "1.0" + }, + "https://purl.imsglobal.org/spec/lti/claim/target_link_uri": + "https://tool.example.com/lti/48320/ruix8782rs", + "https://purl.imsglobal.org/spec/lti/claim/launch_presentation": { + "document_target": "iframe", + "height": 320, + "width": 240, + "return_url": "https://platform.example.edu/terms/201601/courses/7/sections/1/resources/2" + }, + "https://purl.imsglobal.org/spec/lti/claim/custom": { + "xstart": "2017-04-21T01:00:00Z", + "request_url": "https://tool.com/link/123" + }, + "https://purl.imsglobal.org/spec/lti/claim/lis": { + "person_sourcedid": "example.edu:71ee7e42-f6d2-414a-80db-b69ac2defd4", + "course_offering_sourcedid": "example.edu:SI182-F16", + "course_section_sourcedid": "example.edu:SI182-001-F16" + }, + "http://www.ExamplePlatformVendor.com/session": { + "id": "89023sj890dju080" +} + +}