lti13 0.1.2.2 → 0.2.0.0
raw patch · 4 files changed
+88/−7 lines, 4 filesdep +QuickCheckdep +file-embeddep +hspecdep ~aesondep ~basedep ~bytestring
Dependencies added: QuickCheck, file-embed, hspec, lti13, th-utilities
Dependency ranges changed: aeson, base, bytestring, text
Files
- CHANGELOG.md +5/−0
- lti13.cabal +17/−1
- src/Web/LTI13.hs +64/−6
- tests/Spec.hs +2/−0
CHANGELOG.md view
@@ -19,3 +19,8 @@ ## 0.1.2.2 -- 2020-09-19 * We now parse the name fields++## 0.2.0.0 -- 2021-01-09++* We parse the LIS claim+* Unit tests added
lti13.cabal view
@@ -1,7 +1,7 @@ cabal-version: >=1.10 name: lti13-version: 0.1.2.2+version: 0.2.0.0 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,@@ -17,6 +17,22 @@ build-type: Simple extra-source-files: CHANGELOG.md README.md++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 library exposed-modules: Web.LTI13
src/Web/LTI13.hs view
@@ -4,8 +4,14 @@ -- | 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(..)@@ -61,7 +67,7 @@ | Learner | Mentor | Other (Text)- deriving (Show)+ deriving (Show, Eq) roleFromString :: Text -> Role roleFromString "http://purl.imsglobal.org/vocab/lis/v2/membership#Administrator"@@ -90,13 +96,59 @@ instance ToJSON Role where toJSON = A.String . roleToString +-- | <http://www.imsglobal.org/spec/lti/v1p3/#lislti LTI spec § D> LIS claim+data LisClaim = LisClaim+ { personSourcedId :: Maybe Text+ -- ^ LIS identifier for the person making the request.+ , outcomeServiceUrl :: Maybe Text+ -- ^ URL for the Basic Outcomes service, unique per-tool.+ , courseOfferingSourcedId :: Maybe Text+ -- ^ Identifier for the course+ , courseSectionSourcedId :: Maybe Text+ -- ^ Identifier for the section.+ , resultSourcedId :: Maybe Text+ -- ^ An identifier for the position in the gradebook associated with the+ -- assignment being viewed.+ } deriving (Show, Eq)++instance FromJSON LisClaim where+ parseJSON = withObject "LisClaim" $ \v ->+ LisClaim+ <$> v .:? "person_sourcedid"+ <*> v .:? "outcome_service_url"+ <*> v .:? "course_offering_sourcedid"+ <*> v .:? "course_section_sourcedid"+ <*> v .:? "result_sourcedid"++instance ToJSON LisClaim where+ toJSON (LisClaim {personSourcedId, outcomeServiceUrl,+ courseOfferingSourcedId, courseSectionSourcedId,+ resultSourcedId}) =+ object [+ "person_sourcedid" .= personSourcedId+ , "outcome_service_url" .= outcomeServiceUrl+ , "course_offering_sourcedid" .= courseOfferingSourcedId+ , "course_section_sourcedid" .= courseSectionSourcedId+ , "result_sourcedid" .= resultSourcedId+ ]+ toEncoding (LisClaim {personSourcedId, outcomeServiceUrl,+ courseOfferingSourcedId, courseSectionSourcedId,+ resultSourcedId}) =+ pairs (+ "person_sourcedid" .= personSourcedId <>+ "outcome_service_url" .= outcomeServiceUrl <>+ "course_offering_sourcedid" .= courseOfferingSourcedId <>+ "course_section_sourcedid" .= courseSectionSourcedId <>+ "result_sourcedid" .= resultSourcedId+ )+ -- | <http://www.imsglobal.org/spec/lti/v1p3/#context-claim LTI spec § 5.4.1> context claim data ContextClaim = ContextClaim { contextId :: Text , contextLabel :: Maybe Text , contextTitle :: Maybe Text }- deriving (Show)+ deriving (Show, Eq) instance FromJSON ContextClaim where parseJSON = withObject "ContextClaim" $ \v ->@@ -133,12 +185,13 @@ , firstName :: Maybe Text , lastName :: Maybe Text , context :: Maybe ContextClaim- } deriving (Show)+ , lis :: Maybe LisClaim+ } deriving (Show, Eq) -- | An object representing in the type system a token whose claims have been -- validated. newtype LtiTokenClaims = LtiTokenClaims UncheckedLtiTokenClaims- deriving (Show)+ deriving (Show, Eq) limitLength :: (Fail.MonadFail m) => Int -> Text -> m Text limitLength len string@@ -158,6 +211,8 @@ claimRoles = "https://purl.imsglobal.org/spec/lti/claim/roles" claimContext :: Text claimContext = "https://purl.imsglobal.org/spec/lti/claim/context"+claimLis :: Text+claimLis = "https://purl.imsglobal.org/spec/lti/claim/lis" instance FromJSON UncheckedLtiTokenClaims where parseJSON = withObject "LtiTokenClaims" $ \v ->@@ -172,12 +227,13 @@ <*> v .:? "given_name" <*> v .:? "family_name" <*> v .:? claimContext+ <*> v .:? claimLis instance ToJSON UncheckedLtiTokenClaims where toJSON (UncheckedLtiTokenClaims { messageType, ltiVersion, deploymentId , targetLinkUri, roles, email, displayName- , firstName, lastName, context}) =+ , firstName, lastName, context, lis}) = object [ claimMessageType .= messageType , claimVersion .= ltiVersion@@ -189,11 +245,12 @@ , "given_name" .= firstName , "family_name" .= lastName , claimContext .= context+ , claimLis .= lis ] toEncoding (UncheckedLtiTokenClaims { messageType, ltiVersion, deploymentId , targetLinkUri, roles, email, displayName- , firstName, lastName, context}) =+ , firstName, lastName, context, lis}) = pairs ( claimMessageType .= messageType <> claimVersion .= ltiVersion@@ -205,6 +262,7 @@ <> "given_name" .= firstName <> "family_name" .= lastName <> claimContext .= context+ <> claimLis .= lis ) -- | A direct implementation of <http://www.imsglobal.org/spec/security/v1p0/#authentication-response-validation Security § 5.1.3>
+ tests/Spec.hs view
@@ -0,0 +1,2 @@+-- from https://blog.nikosbaxevanis.com/2015/01/30/quickcheck-setup-in-haskell/+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}