hsaml2 0.1 → 0.1.1
raw patch · 21 files changed
+673/−66 lines, 21 filesdep +string-conversionsdep +utf8-stringdep ~basePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: string-conversions, utf8-string
Dependency ranges changed: base
API changes (from Hackage documentation)
- SAML2.XML: instance (GHC.Classes.Eq b, GHC.Classes.Eq a) => GHC.Classes.Eq (SAML2.XML.Identified b a)
- SAML2.XML: instance (GHC.Show.Show b, GHC.Show.Show a) => GHC.Show.Show (SAML2.XML.Identified b a)
+ SAML2.Core.Assertions: instance GHC.Base.Semigroup SAML2.Core.Assertions.Evidence
+ SAML2.Core.Signature: verifySAMLProtocol' :: SAMLProtocol a => PublicKeys -> XmlTree -> IO a
+ SAML2.Metadata.Metadata: instance GHC.Base.Semigroup SAML2.Metadata.Metadata.Extensions
+ SAML2.XML: instance (GHC.Classes.Eq a, GHC.Classes.Eq b) => GHC.Classes.Eq (SAML2.XML.Identified b a)
+ SAML2.XML: instance (GHC.Show.Show a, GHC.Show.Show b) => GHC.Show.Show (SAML2.XML.Identified b a)
+ SAML2.XML.Signature: instance GHC.Base.Semigroup SAML2.XML.Signature.PublicKeys
- SAML2.Bindings.HTTPPOST: decodeForm :: forall a. (SAMLProtocol a) => Bool -> (ByteString -> Maybe ByteString) -> IO a
+ SAML2.Bindings.HTTPPOST: decodeForm :: forall a. SAMLProtocol a => Bool -> (ByteString -> Maybe ByteString) -> IO a
- SAML2.Core: AssertionIDRequest :: !RequestAbstractType -> List1 (AssertionIDRef) -> AssertionIDRequest
+ SAML2.Core: AssertionIDRequest :: !RequestAbstractType -> List1 AssertionIDRef -> AssertionIDRequest
- SAML2.Core: AssertionRef :: (PossiblyEncrypted Assertion) -> AssertionRef
+ SAML2.Core: AssertionRef :: PossiblyEncrypted Assertion -> AssertionRef
- SAML2.Core: AudienceRestriction :: (List1 Audience) -> Condition
+ SAML2.Core: AudienceRestriction :: List1 Audience -> Condition
- SAML2.Core: AuthnContextClassRefs :: (List1 AnyURI) -> AuthnContextRefs
+ SAML2.Core: AuthnContextClassRefs :: List1 AnyURI -> AuthnContextRefs
- SAML2.Core: AuthnContextDeclRefs :: (List1 AnyURI) -> AuthnContextRefs
+ SAML2.Core: AuthnContextDeclRefs :: List1 AnyURI -> AuthnContextRefs
- SAML2.Core: IdentifierBase :: (BaseID Nodes) -> Identifier
+ SAML2.Core: IdentifierBase :: BaseID Nodes -> Identifier
- SAML2.Core: LogoutRequest :: !RequestAbstractType -> Maybe (Identified XString LogoutReason) -> Maybe DateTime -> PossiblyEncrypted Identifier -> Maybe XString -> LogoutRequest
+ SAML2.Core: LogoutRequest :: !RequestAbstractType -> Maybe (Identified XString LogoutReason) -> Maybe DateTime -> PossiblyEncrypted Identifier -> [XString] -> LogoutRequest
- SAML2.Core: SoEncrypted :: (EncryptedElement a) -> PossiblyEncrypted a
+ SAML2.Core: SoEncrypted :: EncryptedElement a -> PossiblyEncrypted a
- SAML2.Core: [assertionIDRequestRef] :: AssertionIDRequest -> List1 (AssertionIDRef)
+ SAML2.Core: [assertionIDRequestRef] :: AssertionIDRequest -> List1 AssertionIDRef
- SAML2.Core: [logoutRequestSessionIndex] :: LogoutRequest -> Maybe XString
+ SAML2.Core: [logoutRequestSessionIndex] :: LogoutRequest -> [XString]
- SAML2.Core.Assertions: AssertionRef :: (PossiblyEncrypted Assertion) -> AssertionRef
+ SAML2.Core.Assertions: AssertionRef :: PossiblyEncrypted Assertion -> AssertionRef
- SAML2.Core.Assertions: AudienceRestriction :: (List1 Audience) -> Condition
+ SAML2.Core.Assertions: AudienceRestriction :: List1 Audience -> Condition
- SAML2.Core.Assertions: IdentifierBase :: (BaseID Nodes) -> Identifier
+ SAML2.Core.Assertions: IdentifierBase :: BaseID Nodes -> Identifier
- SAML2.Core.Assertions: SoEncrypted :: (EncryptedElement a) -> PossiblyEncrypted a
+ SAML2.Core.Assertions: SoEncrypted :: EncryptedElement a -> PossiblyEncrypted a
- SAML2.Core.Protocols: AssertionIDRequest :: !RequestAbstractType -> List1 (AssertionIDRef) -> AssertionIDRequest
+ SAML2.Core.Protocols: AssertionIDRequest :: !RequestAbstractType -> List1 AssertionIDRef -> AssertionIDRequest
- SAML2.Core.Protocols: AuthnContextClassRefs :: (List1 AnyURI) -> AuthnContextRefs
+ SAML2.Core.Protocols: AuthnContextClassRefs :: List1 AnyURI -> AuthnContextRefs
- SAML2.Core.Protocols: AuthnContextDeclRefs :: (List1 AnyURI) -> AuthnContextRefs
+ SAML2.Core.Protocols: AuthnContextDeclRefs :: List1 AnyURI -> AuthnContextRefs
- SAML2.Core.Protocols: LogoutRequest :: !RequestAbstractType -> Maybe (Identified XString LogoutReason) -> Maybe DateTime -> PossiblyEncrypted Identifier -> Maybe XString -> LogoutRequest
+ SAML2.Core.Protocols: LogoutRequest :: !RequestAbstractType -> Maybe (Identified XString LogoutReason) -> Maybe DateTime -> PossiblyEncrypted Identifier -> [XString] -> LogoutRequest
- SAML2.Core.Protocols: [assertionIDRequestRef] :: AssertionIDRequest -> List1 (AssertionIDRef)
+ SAML2.Core.Protocols: [assertionIDRequestRef] :: AssertionIDRequest -> List1 AssertionIDRef
- SAML2.Core.Protocols: [logoutRequestSessionIndex] :: LogoutRequest -> Maybe XString
+ SAML2.Core.Protocols: [logoutRequestSessionIndex] :: LogoutRequest -> [XString]
- SAML2.XML: data URI :: *
+ SAML2.XML: data URI
Files
- SAML2/Core/Assertions.hs +6/−1
- SAML2/Core/Protocols.hs +30/−30
- SAML2/Core/Signature.hs +19/−2
- SAML2/Metadata/Metadata.hs +6/−1
- SAML2/XML.hs +6/−3
- SAML2/XML/Schema/Datatypes.hs +21/−7
- SAML2/XML/Signature.hs +25/−7
- hsaml2.cabal +19/−4
- test/Bindings/HTTPRedirect.hs +1/−1
- test/Metadata/metadata-idp.xml +86/−0
- test/Metadata/metadata-nyu.xml +114/−0
- test/Metadata/metadata-osf.xml +73/−0
- test/Metadata/metadata-sp.xml +48/−0
- test/XML/Signature.hs +149/−10
- test/XML/noncanonical1.xml +13/−0
- test/XML/noncanonical2.xml +11/−0
- test/XML/noncanonical3.xml +18/−0
- test/XML/noncanonical4.xml +13/−0
- test/XML/noncanonical5.xml +12/−0
- test/XML/noncanonical6.xml +2/−0
- test/XML/world.txt +1/−0
SAML2/Core/Assertions.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE FlexibleContexts #-}@@ -445,7 +446,11 @@ -- |§2.7.4.3 newtype Evidence = Evidence{ evidence :: [AssertionRef] }- deriving (Eq, Show, Monoid)+ deriving (Eq, Show+#if MIN_VERSION_base(4,11,0)+ , Semigroup+#endif+ , Monoid) instance XP.XmlPickler Evidence where xpickle = [XP.biCase|
SAML2/Core/Protocols.hs view
@@ -66,7 +66,7 @@ samlProtocol' :: Lens' a ProtocolType isSAMLResponse :: a -> Bool isSAMLResponse_ :: Proxy a -> Maybe Bool- isSAMLResponse_ = Just . isSAMLResponse . asProxyTypeOf undefined + isSAMLResponse_ = Just . isSAMLResponse . asProxyTypeOf undefined -- |§3.2.1 newtype RequestAbstractType = RequestAbstractType@@ -152,24 +152,24 @@ data StatusCode2 = StatusAuthnFailed- | StatusInvalidAttrNameOrValue - | StatusInvalidNameIDPolicy - | StatusNoAuthnContext - | StatusNoAvailableIDP - | StatusNoPassive - | StatusNoSupportedIDP - | StatusPartialLogout - | StatusProxyCountExceeded - | StatusRequestDenied - | StatusRequestUnsupported + | StatusInvalidAttrNameOrValue+ | StatusInvalidNameIDPolicy+ | StatusNoAuthnContext+ | StatusNoAvailableIDP+ | StatusNoPassive+ | StatusNoSupportedIDP+ | StatusPartialLogout+ | StatusProxyCountExceeded+ | StatusRequestDenied+ | StatusRequestUnsupported | StatusRequestVersionDeprecated- | StatusRequestVersionTooHigh - | StatusRequestVersionTooLow - | StatusResourceNotRecognized - | StatusTooManyResponses - | StatusUnknownAttrProfile - | StatusUnknownPrincipal - | StatusUnsupportedBinding + | StatusRequestVersionTooHigh+ | StatusRequestVersionTooLow+ | StatusResourceNotRecognized+ | StatusTooManyResponses+ | StatusUnknownAttrProfile+ | StatusUnknownPrincipal+ | StatusUnsupportedBinding deriving (Eq, Bounded, Enum, Show) instance Identifiable URI StatusCode2 where@@ -564,7 +564,7 @@ , logoutRequestReason :: Maybe (Identified XString LogoutReason) , logoutRequestNotOnOrAfter :: Maybe XS.DateTime , logoutRequestIdentifier :: SAML.PossiblyEncrypted SAML.Identifier- , logoutRequestSessionIndex :: Maybe XString+ , logoutRequestSessionIndex :: [XString] } deriving (Eq, Show) instance XP.XmlPickler LogoutRequest where@@ -574,7 +574,7 @@ XP.>*< XP.xpAttrImplied "Reason" XP.xpickle XP.>*< XP.xpAttrImplied "NotOnOrAfter" XS.xpDateTime XP.>*< SAML.xpPossiblyEncrypted- XP.>*< XP.xpOption (xpElem "SessionIndex" XS.xpString))+ XP.>*< XP.xpList (xpElem "SessionIndex" XS.xpString)) instance DS.Signable LogoutRequest where signature' = samlProtocol' . DS.signature' signedID = protocolID . view samlProtocol'@@ -659,14 +659,14 @@ data AnyRequest = RequestAssertionIDRequest !AssertionIDRequest- | RequestAuthnQuery !AuthnQuery - | RequestAttributeQuery !AttributeQuery - | RequestAuthzDecisionQuery !AuthzDecisionQuery + | RequestAuthnQuery !AuthnQuery+ | RequestAttributeQuery !AttributeQuery+ | RequestAuthzDecisionQuery !AuthzDecisionQuery | RequestAuthnRequest !AuthnRequest- | RequestArtifactResolve !ArtifactResolve - | RequestManageNameIDRequest !ManageNameIDRequest - | RequestLogoutRequest !LogoutRequest - | RequestNameIDMappingRequest !NameIDMappingRequest + | RequestArtifactResolve !ArtifactResolve+ | RequestManageNameIDRequest !ManageNameIDRequest+ | RequestLogoutRequest !LogoutRequest+ | RequestNameIDMappingRequest !NameIDMappingRequest deriving (Eq, Show) instance XP.XmlPickler AnyRequest where@@ -717,8 +717,8 @@ s (RequestNameIDMappingRequest r) q = RequestNameIDMappingRequest $ samlRequest' .~ q $ r data AnyResponse- = ResponseResponse !Response - | ResponseArtifactResponse !ArtifactResponse + = ResponseResponse !Response+ | ResponseArtifactResponse !ArtifactResponse deriving (Eq, Show) instance XP.XmlPickler AnyResponse where@@ -739,7 +739,7 @@ g (ResponseArtifactResponse r) = r ^. samlResponse' s (ResponseResponse r) q = ResponseResponse $ samlResponse' .~ q $ r s (ResponseArtifactResponse r) q = ResponseArtifactResponse $ samlResponse' .~ q $ r- + data AnyProtocol = ProtocolRequest !AnyRequest | ProtocolResponse !AnyResponse
SAML2/Core/Signature.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} -- | -- SAML and XML Signature Syntax and Processing --@@ -5,16 +6,18 @@ module SAML2.Core.Signature ( signSAMLProtocol , verifySAMLProtocol+ , verifySAMLProtocol' ) where +import Control.Exception import Control.Lens ((^.), (.~)) import Control.Monad (unless) import qualified Data.ByteString.Lazy as BSL import Data.List.NonEmpty (NonEmpty((:|))) import Network.URI (URI(uriFragment), nullURI)+import Text.XML.HXT.DOM.TypeDefs import SAML2.XML-import qualified Text.XML.HXT.Arrow.Pickle.Xml.Invertible as XP import qualified SAML2.XML.Canonical as C14N import qualified SAML2.XML.Signature as DS import qualified SAML2.Core.Protocols as SAMLP@@ -31,7 +34,7 @@ : [] , DS.referenceDigestMethod = DS.simpleDigest DS.DigestSHA1 , DS.referenceDigestValue = error "signSAMLProtocol: referenceDigestValue"- } $ XP.pickleDoc XP.xpickle m+ } $ samlToDoc m s' <- DS.generateSignature sk $ maybe DS.SignedInfo { DS.signedInfoId = Nothing , DS.signedInfoCanonicalizationMethod = DS.simpleCanonicalization $ C14N.CanonicalXMLExcl10 False@@ -53,3 +56,17 @@ v <- DS.verifySignature mempty (DS.signedID m) x unless (or v) $ fail "verifySAMLProtocol: invalid or missing signature" return m++-- | A variant of 'verifySAMLProtocol' that is more symmetric to 'signSAMLProtocol'. The reason it+-- takes an 'XmlTree' and not an @a@ is that signature verification needs both.+--+-- TODO: Should this replace 'verifySAMLProtocol'?+verifySAMLProtocol' :: SAMLP.SAMLProtocol a => DS.PublicKeys -> XmlTree -> IO a+verifySAMLProtocol' pubkeys x = do+ m <- either fail return $ docToSAML x+ v :: Either SomeException (Maybe Bool) <- try $ DS.verifySignature pubkeys (DS.signedID m) x+ case v of+ Left e -> fail $ "signature verification failed: " ++ show e+ Right Nothing -> fail "signature verification failed: no matching key/alg pair."+ Right (Just False) -> fail "signature verification failed: verification failed."+ Right (Just True) -> pure m
SAML2/Metadata/Metadata.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TypeSynonymInstances #-}@@ -149,7 +150,11 @@ -- |§2.3.1 empty list means missing newtype Extensions = Extensions{ extensions :: Nodes }- deriving (Eq, Show, Monoid)+ deriving (Eq, Show+#if MIN_VERSION_base(4,11,0)+ , Semigroup+#endif+ , Monoid) instance XP.XmlPickler Extensions where xpickle = XP.xpDefault (Extensions []) $
SAML2/XML.hs view
@@ -26,12 +26,15 @@ ) where import qualified Data.ByteString.Lazy as BSL-import qualified Data.ByteString.Lazy.Char8 as BSLC+import qualified Data.ByteString.Lazy.UTF8 as BSLU import Data.Default (Default(..)) import qualified Data.Invertible as Inv import Data.Maybe (listToMaybe) import Network.URI (URI) import qualified Text.XML.HXT.Core as HXT+import Text.XML.HXT.Arrow.Edit (escapeXmlRefs)+import Text.XML.HXT.DOM.ShowXml (xshow')+import Text.XML.HXT.DOM.XmlNode (getChildren) import SAML2.XML.Types import SAML2.Core.Datatypes@@ -98,7 +101,7 @@ . XP.pickleDoc XP.xpickle docToXML :: HXT.XmlTree -> BSL.ByteString-docToXML = BSL.concat . HXT.runLA (HXT.xshowBlob HXT.getChildren)+docToXML = xshow' cquot aquot (:) . getChildren where (cquot, aquot) = escapeXmlRefs samlToXML :: XP.XmlPickler a => a -> BSL.ByteString samlToXML = docToXML . samlToDoc@@ -109,7 +112,7 @@ HXT.>>> HXT.removeWhiteSpace HXT.>>> HXT.neg HXT.isXmlPi HXT.>>> HXT.propagateNamespaces)- . BSLC.unpack -- XXX encoding?+ . BSLU.toString docToSAML :: XP.XmlPickler a => HXT.XmlTree -> Either String a docToSAML = XP.unpickleDoc' XP.xpickle
SAML2/XML/Schema/Datatypes.hs view
@@ -13,6 +13,8 @@ import Data.Char (isDigit) import Data.Char.Properties.XMLCharProps (isXmlSpaceChar, isXmlNameChar) import Data.Fixed (Pico, showFixed)+import Data.List (elemIndex)+import Data.Semigroup ((<>)) import qualified Data.Time.Clock as Time import Data.Time.Format (formatTime, parseTimeM, defaultTimeLocale) import Data.Word (Word16)@@ -57,7 +59,7 @@ prd ('+':s) = prp s prd s = prp s prp ('P':s) = pru (0 :: Pico) prt [('Y',31556952),('M',2629746),('D',86400)] s- prp _ = Nothing + prp _ = Nothing prt x "" = Just x prt x ('T':s) = pru x prs [('H',3600),('M',60)] s prt _ _ = Nothing@@ -76,13 +78,26 @@ xpDateTime :: XP.PU DateTime xpDateTime = XP.PU { XP.theSchema = XPS.scDTxsd XSD.xsd_dateTime []- , XP.appPickle = XP.putCont . XN.mkText . formatTime defaultTimeLocale fmt- , XP.appUnPickle = XP.getCont >>= XP.liftMaybe "dateTime expects text" . XN.getText >>= parseTimeM True defaultTimeLocale fmtz+ , XP.appPickle = XP.putCont . XN.mkText . tweakTimeString . formatTime defaultTimeLocale fmtz+ , XP.appUnPickle = XP.getCont >>= XP.liftMaybe "dateTime expects text" . XN.getText >>= parseTime } where- fmt = "%0Y-%m-%dT%H:%M:%S%Q"- fmtz = fmt ++ "%Z"+ -- timezone must be 'Z', and MicrosoftS(tm) Azure(tm) will choke when it is ommitted. (error+ -- messages are utterly unhelpful.)+ fmtz = "%Y-%m-%dT%H:%M:%S%QZ" + parseTime dateString = maybe (XP.throwMsg $ "can't parse date " <> dateString) pure+ $ parseTimeM True defaultTimeLocale fmtz dateString++ -- adding '%Q' may be longer than 7 digits, which makes MicrosoftS(tm) Azure(tm) choke.+ tweakTimeString :: String -> String+ tweakTimeString s = case elemIndex '.' s of+ Nothing -> s+ Just i -> case splitAt i s of+ (t, u) -> case splitAt 8 u of+ (_, "") -> t ++ u+ (v, _) -> t ++ v ++ "Z"+ -- |§3.2.16 type Base64Binary = BS.ByteString @@ -96,7 +111,7 @@ type AnyURI = URI.URI xpAnyURI :: XP.PU AnyURI-xpAnyURI = XP.xpWrapEither +xpAnyURI = XP.xpWrapEither ( maybe (Left "invalid anyURI") Right . URI.parseURIReference , \u -> URI.uriToString id u "") $ XP.xpText0DT $ XPS.scDTxsd XSD.xsd_anyURI []@@ -173,4 +188,3 @@ ( \x -> if x > 0 then Right x else Left "0 is not positive" , id ) $ XP.xpPrim{ XP.theSchema = XPS.scDTxsd XSD.xsd_positiveInteger [] }-
SAML2/XML/Signature.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE ViewPatterns #-} -- | -- XML Signature Syntax and Processing@@ -35,6 +36,7 @@ import qualified Text.XML.HXT.Core as HXT import qualified Text.XML.HXT.DOM.ShowXml as DOM import qualified Text.XML.HXT.DOM.XmlNode as DOM+import qualified Text.XML.HXT.DOM.QualifiedName as DOM import SAML2.XML import SAML2.XML.Canonical@@ -48,12 +50,12 @@ getID = HXT.deep . HXT.hasAttrValue "ID" . (==) applyCanonicalization :: CanonicalizationMethod -> Maybe String -> HXT.XmlTree -> IO BS.ByteString-applyCanonicalization (CanonicalizationMethod (Identified a) ins []) = canonicalize a ins-applyCanonicalization m = fail $ "applyCanonicalization: unsupported " ++ show m+applyCanonicalization (CanonicalizationMethod (Identified a) ins []) x y = canonicalize a ins x y+applyCanonicalization m _ _ = fail $ "applyCanonicalization: unsupported " ++ show m applyTransformsBytes :: [Transform] -> BSL.ByteString -> IO BSL.ByteString-applyTransformsBytes [] = return-applyTransformsBytes (t : _) = fail ("applyTransforms: unsupported Signature " ++ show t)+applyTransformsBytes [] v = return v+applyTransformsBytes (t : _) _ = fail ("applyTransforms: unsupported Signature " ++ show t) applyTransformsXML :: [Transform] -> HXT.XmlTree -> IO BSL.ByteString applyTransformsXML (Transform (Identified (TransformCanonicalization a)) ins x : tl) =@@ -104,6 +106,11 @@ , publicKeyRSA :: Maybe RSA.PublicKey } deriving (Eq, Show) +#if MIN_VERSION_base(4,11,0)+instance Semigroup PublicKeys where+ PublicKeys dsa1 rsa1 <> PublicKeys dsa2 rsa2 =+ PublicKeys (dsa1 <|> dsa2) (rsa1 <|> rsa2)+#endif instance Monoid PublicKeys where mempty = PublicKeys Nothing Nothing PublicKeys dsa1 rsa1 `mappend` PublicKeys dsa2 rsa2 =@@ -149,6 +156,7 @@ signBytes (SigningKeyRSA k) b = either (fail . show) return =<< RSA.signSafer (Just SHA1) (RSA.toPrivateKey k) b +-- | indicate verification result; return 'Nothing' if no matching key/alg pair is found verifyBytes :: PublicKeys -> IdentifiedURI SignatureAlgorithm -> BS.ByteString -> BS.ByteString -> Maybe Bool verifyBytes PublicKeys{ publicKeyDSA = Just k } (Identified SignatureDSA_SHA1) sig m = Just $ BS.length sig == 40 &&@@ -156,6 +164,8 @@ where (r, s) = BS.splitAt 20 sig verifyBytes PublicKeys{ publicKeyRSA = Just k } (Identified SignatureRSA_SHA1) sig m = Just $ RSA.verify (Just SHA1) k m sig+verifyBytes PublicKeys{ publicKeyRSA = Just k } (Identified SignatureRSA_SHA256) sig m = Just $+ RSA.verify (Just SHA256) k m sig verifyBytes _ _ _ _ = Nothing signBase64 :: SigningKey -> BS.ByteString -> IO BS.ByteString@@ -177,9 +187,14 @@ , signatureObject = [] } +-- Exception in IO: something is syntactically wrong with the input+-- Nothing: no matching key/alg pairs found+-- Just False: signature verification failed || dangling refs || explicit ref is not among the signed ones+-- Just True: everything is ok! verifySignature :: PublicKeys -> String -> HXT.XmlTree -> IO (Maybe Bool) verifySignature pks xid doc = do- x <- case HXT.runLA (getID xid) doc of+ let namespaces = DOM.toNsEnv $ HXT.runLA HXT.collectNamespaceDecl doc+ x <- case HXT.runLA (getID xid HXT.>>> HXT.attachNsEnv namespaces) doc of [x] -> return x _ -> fail "verifySignature: element not found" sx <- case child "Signature" x of@@ -189,8 +204,11 @@ six <- applyCanonicalization (signedInfoCanonicalizationMethod si) (Just xpath) $ DOM.mkRoot [] [x] rl <- mapM (`verifyReference` x) (signedInfoReference si) let keys = pks <> foldMap (foldMap keyinfo . keyInfoElements) (signatureKeyInfo s)- return $ ((any (Just xid ==) rl && all isJust rl) &&)- <$> verifyBytes keys (signatureMethodAlgorithm $ signedInfoSignatureMethod si) (signatureValue $ signatureSignatureValue s) six+ verified :: Maybe Bool+ verified = verifyBytes keys (signatureMethodAlgorithm $ signedInfoSignatureMethod si) (signatureValue $ signatureSignatureValue s) six+ valid :: Bool+ valid = elem (Just xid) rl && all isJust rl+ return $ (valid &&) <$> verified where child n = HXT.runLA $ HXT.getChildren HXT.>>> isDSElem n HXT.>>> HXT.cleanupNamespaces HXT.collectPrefixUriPairs keyinfo (KeyInfoKeyValue kv) = publicKeyValues kv
hsaml2.cabal view
@@ -1,5 +1,5 @@ name: hsaml2-version: 0.1+version: 0.1.1 synopsis: OASIS Security Assertion Markup Language (SAML) V2.0 description: Direct implementation of the SAML XML standard (https://www.oasis-open.org/standards#samlv2.0), along with some related dependencies. This is currently partial, as the standard is quite extensive, but is sufficient to build a functioning SP and fully validate responses. The module layout basically follows the standard definition documentation. Its use still requires a fairly extensive understanding of SAML. license: Apache-2.0@@ -10,11 +10,22 @@ category: Security, Network, Web build-type: Simple cabal-version: >=1.10-tested-with: GHC == 7.10.3+tested-with: GHC == 8.0.2 || == 8.2.2 || == 8.4.4 || == 8.6.5 || == 8.8.3 extra-source-files:- test/XML/signature-example.xml+ test/Metadata/metadata-idp.xml+ test/Metadata/metadata-nyu.xml+ test/Metadata/metadata-osf.xml+ test/Metadata/metadata-sp.xml test/XML/encryption-example.xml+ test/XML/noncanonical1.xml+ test/XML/noncanonical2.xml+ test/XML/noncanonical3.xml+ test/XML/noncanonical4.xml+ test/XML/noncanonical5.xml+ test/XML/noncanonical6.xml+ test/XML/signature-example.xml+ test/XML/world.txt source-repository head type: git@@ -55,7 +66,7 @@ SAML2.Bindings.Internal c-sources: SAML2/XML/libxml2_stub.c- build-depends: + build-depends: asn1-encoding, asn1-types >= 0.2, base >=4.8 && <5,@@ -77,6 +88,7 @@ semigroups, template-haskell, time,+ utf8-string, x509, zlib pkgconfig-depends: libxml-2.0@@ -98,12 +110,15 @@ ghc-options: -Wall build-depends: base,+ base64-bytestring, bytestring,+ cryptonite, hsaml2, hxt, hxt-http, network-uri, semigroups,+ string-conversions, time, x509, HUnit
test/Bindings/HTTPRedirect.hs view
@@ -30,7 +30,7 @@ Nothing Nothing (NotEncrypted $ IdentifierName $ simpleNameID NameIDFormatPersistent "005a06e0-ad82-110d-a556-004005b13a2b")- (Just "1"))+ ["1"]) =<< decodeURI mempty (uri "https://ServiceProvider.com/SAML/SLO/Browser?SAMLRequest=fVFdS8MwFH0f7D%2BUvGdNsq62oSsIQyhMESc%2B%2BJYlmRbWpObeyvz3puv2IMjyFM7HPedyK1DdsZdb%2F%2BEHfLFfgwVMTt3RgTwzazIEJ72CFqRTnQWJWu7uH7dSLJjsg0ev%2FZFMlttiBWADtt6R%2BSyJr9msiRH7O70sCm31Mj%2Bo%2BC%2B1KA5GlEWeZaogSQMw2MYBKodrIhjLKONU8FdeSsZkVr6T5M0GiHMjvWCknqZXZ2OoPxF7kGnaGOuwxZ%2Fn4L9bY8NC%2By4du1XpRXnxPcXizSZ58KFTeHujEWkNPZylsh9bAMYYUjO2Uiy3jCpTCMo5M1StVjmN9SO150sl9lU6RV2Dp0vsLIy7NM7YU82r9B90PrvCf85W%2FwL8zSVQzAEAAA%3D%3D&RelayState=0043bfc1bc45110dae17004005b13a2b") , U.TestCase $ U.assertEqual "response" (LogoutResponse $ StatusResponseType
+ test/Metadata/metadata-idp.xml view
@@ -0,0 +1,86 @@+<EntityDescriptor xmlns="urn:oasis:names:tc:SAML:2.0:metadata"+xmlns:saml="urn:oasis:names:tc:SAML:2.0:assertion"+xmlns:ds="http://www.w3.org/2000/09/xmldsig#"+entityID="https://IdentityProvider.com/SAML"+cacheDuration="P1Y2DT4M7.8S">+ <IDPSSODescriptor WantAuthnRequestsSigned="true"+protocolSupportEnumeration="urn:oasis:names:tc:SAML:2.0:protocol">+ <KeyDescriptor use="signing">+ <ds:KeyInfo>+ <ds:KeyName>IdentityProvider.com SSO Key</ds:KeyName>+ </ds:KeyInfo>+ </KeyDescriptor>+ <ArtifactResolutionService isDefault="true" index="0"+Binding="urn:oasis:names:tc:SAML:2.0:bindings:SOAP"+Location="https://IdentityProvider.com/SAML/Artifact"/>+ <SingleLogoutService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:SOAP"+Location="https://IdentityProvider.com/SAML/SLO/SOAP"/>+ <SingleLogoutService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect"+Location="https://IdentityProvider.com/SAML/SLO/Browser"+ResponseLocation="https://IdentityProvider.com/SAML/SLO/Response"/>+ <NameIDFormat>urn:oasis:names:tc:SAML:1.1:nameid-format:X509SubjectName</NameIDFormat>+ <NameIDFormat>urn:oasis:names:tc:SAML:2.0:nameid-format:persistent</NameIDFormat>+ <NameIDFormat>urn:oasis:names:tc:SAML:2.0:nameid-format:transient</NameIDFormat>+ <SingleSignOnService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect"+Location="https://IdentityProvider.com/SAML/SSO/Browser"/>+ <SingleSignOnService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST"+Location="https://IdentityProvider.com/SAML/SSO/Browser"/>+ <saml:Attribute+NameFormat="urn:oasis:names:tc:SAML:2.0:attrname-format:uri"+Name="urn:oid:1.3.6.1.4.1.5923.1.1.1.6"+FriendlyName="eduPersonPrincipalName">+ </saml:Attribute>+ <saml:Attribute+NameFormat="urn:oasis:names:tc:SAML:2.0:attrname-format:uri"+Name="urn:oid:1.3.6.1.4.1.5923.1.1.1.1"+FriendlyName="eduPersonAffiliation">+ <saml:AttributeValue>member</saml:AttributeValue>+ <saml:AttributeValue>student</saml:AttributeValue>+ <saml:AttributeValue>faculty</saml:AttributeValue>+ <saml:AttributeValue>employee</saml:AttributeValue>+ <saml:AttributeValue>staff</saml:AttributeValue>+ </saml:Attribute>+ </IDPSSODescriptor>+ <AttributeAuthorityDescriptor+protocolSupportEnumeration="urn:oasis:names:tc:SAML:2.0:protocol">+ <KeyDescriptor use="signing">+ <ds:KeyInfo>+ <ds:KeyName>IdentityProvider.com AA Key</ds:KeyName>+ </ds:KeyInfo> + </KeyDescriptor>+ <AttributeService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:SOAP"+Location="https://IdentityProvider.com/SAML/AA/SOAP"/>+ <AssertionIDRequestService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:URI"+Location="https://IdentityProvider.com/SAML/AA/URI"/>+ <NameIDFormat>urn:oasis:names:tc:SAML:1.1:nameid-format:X509SubjectName</NameIDFormat>+ <NameIDFormat>urn:oasis:names:tc:SAML:2.0:nameid-format:persistent</NameIDFormat>+ <NameIDFormat>urn:oasis:names:tc:SAML:2.0:nameid-format:transient</NameIDFormat>+ <saml:Attribute+NameFormat="urn:oasis:names:tc:SAML:2.0:attrname-format:uri"+Name="urn:oid:1.3.6.1.4.1.5923.1.1.1.6"+FriendlyName="eduPersonPrincipalName">+ </saml:Attribute>+ <saml:Attribute+NameFormat="urn:oasis:names:tc:SAML:2.0:attrname-format:uri"+Name="urn:oid:1.3.6.1.4.1.5923.1.1.1.1"+FriendlyName="eduPersonAffiliation">+ <saml:AttributeValue>member</saml:AttributeValue>+ <saml:AttributeValue>student</saml:AttributeValue>+ <saml:AttributeValue>faculty</saml:AttributeValue>+ <saml:AttributeValue>employee</saml:AttributeValue>+ <saml:AttributeValue>staff</saml:AttributeValue>+ </saml:Attribute>+ </AttributeAuthorityDescriptor>+ <Organization>+ <OrganizationName xml:lang="en">Identity Providers R US</OrganizationName>+ <OrganizationDisplayName xml:lang="en">Identity Providers R US, a Division of Lerxst Corp.</OrganizationDisplayName>+ <OrganizationURL +xml:lang="en">https://IdentityProvider.com</OrganizationURL>+ </Organization>+</EntityDescriptor>
+ test/Metadata/metadata-nyu.xml view
@@ -0,0 +1,114 @@+<EntityDescriptor entityID="urn:mace:incommon:nyu.edu"+ xmlns="urn:oasis:names:tc:SAML:2.0:metadata" xmlns:ds="http://www.w3.org/2000/09/xmldsig#"+ xmlns:shibmd="urn:mace:shibboleth:metadata:1.0" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance">+ <IDPSSODescriptor+ protocolSupportEnumeration="urn:mace:shibboleth:1.0 urn:oasis:names:tc:SAML:1.1:protocol urn:oasis:names:tc:SAML:2.0:protocol">+ <Extensions>+ <shibmd:Scope regexp="false">nyu.edu</shibmd:Scope>+ </Extensions>+ <KeyDescriptor use="signing">+ <ds:KeyInfo>+ <ds:X509Data>+ <!-- Serial No. 124, expires on Wed Jan 16 23:23:03 2008 GMT -->+ <ds:X509Certificate>+ MIIGTTCCBTWgAwIBAgIBfDANBgkqhkiG9w0BAQUFADBWMQswCQYDVQQGEwJVUzEc+ MBoGA1UEChMTSW5Db21tb24gRmVkZXJhdGlvbjEpMCcGA1UEAxMgSW5Db21tb24g+ Q2VydGlmaWNhdGlvbiBBdXRob3JpdHkwHhcNMDcwMTE2MjMyMzAzWhcNMDgwMTE2+ MjMyMzAzWjA4MQswCQYDVQQGEwJVUzEMMAoGA1UEChMDTllVMRswGQYDVQQDExJz+ aGliYm9sZXRoLm55dS5lZHUwggG4MIIBLAYHKoZIzjgEATCCAR8CgYEA/X9TgR11+ EilS30qcLuzk5/YRt1I870QAwx4/gLZRJmlFXUAiUftZPY1Y+r/F9bow9subVWzX+ gTuAHTRv8mZgt2uZUKWkn5/oBHsQIsJPu6nX/rfGG/g7V+fGqKYVDwT7g/bTxR7D+ AjVUE1oWkTL2dfOuK2HXKu/yIgMZndFIAccCFQCXYFCPFSMLzLKSuYKi64QL8Fgc+ 9QKBgQD34aCF1ps93su8q1w2uFe5eZSvu/o66oL5V0wLPQeCZ1FZV4661FlP5nEH+ EIGAtEkWcSPoTCgWE7fPCTKMyKbhPBZ6i1R8jSjgo64eK7OmdZFuo38L+iE1YvH7+ YnoBJDvMpPG+qFGQiaiD3+Fa5Z8GkotmXoB7VSVkAUw7/s9JKgOBhQACgYEA5GK++ eV3YuyfbTeJXnqV4jT+Ocz7XCL4TmeYApcuA/tG7vRRKl2Oyo93VCe7GxwOAFyp2+ ajqxdzB/yB/Mcz80GELz/UE6vkA9CW315gHQ+zWImUbPxdp5vfoe1wZ7WmXDRN5++ 4SDptlKBPsZBatAJhBjJOkWL/z09dyRdg+YYXcGjggKsMIICqDAOBgNVHQ8BAf8E+ BAMCBaAwDAYDVR0TAQH/BAIwADAdBgNVHSUEFjAUBggrBgEFBQcDAQYIKwYBBQUH+ AwIwHQYDVR0OBBYEFInR3E2yLHtThH/xcXn8RjPAFno4MH4GA1UdIwR3MHWAFJMt+ yGEYrWPjm2Wznd2Nk7rnymNFoVqkWDBWMQswCQYDVQQGEwJVUzEcMBoGA1UEChMT+ SW5Db21tb24gRmVkZXJhdGlvbjEpMCcGA1UEAxMgSW5Db21tb24gQ2VydGlmaWNh+ dGlvbiBBdXRob3JpdHmCAQAwgboGCCsGAQUFBwEBBIGtMIGqMIGnBggrBgEFBQcw+ AoaBmmh0dHA6Ly9pbmNvbW1vbmNhMS5pbmNvbW1vbmZlZGVyYXRpb24ub3JnL2Jy+ aWRnZS9jZXJ0cy9jYS1jZXJ0cy5wN2IKCQlDQSBJc3N1ZXJzIC0gVVJJOmh0dHA6+ Ly9pbmNvbW1vbmNhMi5pbmNvbW1vbmZlZGVyYXRpb24ub3JnL2JyaWRnZS9jZXJ0+ cy9jYS1jZXJ0cy5wN2IwgY0GA1UdHwSBhTCBgjA/oD2gO4Y5aHR0cDovL2luY29t+ bW9uY3JsMS5pbmNvbW1vbmZlZGVyYXRpb24ub3JnL2NybC9lZWNybHMuY3JsMD+g+ PaA7hjlodHRwOi8vaW5jb21tb25jcmwyLmluY29tbW9uZmVkZXJhdGlvbi5vcmcv+ Y3JsL2VlY3Jscy5jcmwwXgYDVR0gBFcwVTBTBgsrBgEEAa4jAQQBATBEMEIGCCsG+ AQUFBwIBFjZodHRwOi8vaW5jb21tb25jYS5pbmNvbW1vbmZlZGVyYXRpb24ub3Jn+ L3ByYWN0aWNlcy5wZGYwHQYDVR0RBBYwFIISc2hpYmJvbGV0aC5ueXUuZWR1MA0G+ CSqGSIb3DQEBBQUAA4IBAQCtTu3zFQro8ocJP9jfnJe7LQwvC+8W0n/AxJnkoadA+ WXvL6sWU/FoTg48ppe6A4LFmZ8SZIq/7Neo6SfvUkhT+O9mArnjZJ6XAu/cH0fD/+ KBAkUhkEQlltSy1PT2Apor/ti20IV6ycXJPc4AVBh7X/mKpZ646CWnHvoiPUqPAi+ zjxkx0TmosaL+2IVA8/Vd2FXp+cJLJgoXMSDeTs2nfj90+hNE5GE9shRf6lJlpdV+ 4nVc74u6E0RwoCe/76Uruk9VzciLSiJwEj/kuFPfg93s1K5w1xyslmtdxYd6HbEx+ NGqVSO5aqZjOpoF5O/Kp39NX1iv08yjLUGus10UlK5Bx+ </ds:X509Certificate>+ </ds:X509Data>+ </ds:KeyInfo>+ </KeyDescriptor>+ <KeyDescriptor use="signing">+ <ds:KeyInfo>+ <ds:X509Data>+ <!-- Serial No. 10202320263211693109, expires on Mon Aug 8 21:35:16 + 2022 GMT -->+ <ds:X509Certificate>+ MIIE6DCCA9CgAwIBAgIJAI2V7DmlgLQ1MA0GCSqGSIb3DQEBBQUAMIGoMQswCQYD+ VQQGEwJVUzERMA8GA1UECBMITmV3IFlvcmsxETAPBgNVBAcTCE5ldyBZb3JrMRww+ GgYDVQQKExNOZXcgWW9yayBVbml2ZXJzaXR5MQwwCgYDVQQLEwNJVFMxIjAgBgNV+ BAMTGXVybjptYWNlOmluY29tbW9uOm55dS5lZHUxIzAhBgkqhkiG9w0BCQEWFGlk+ bS5zZXJ2aWNlc0BueXUuZWR1MB4XDTEyMDgxMDIxMzUxNloXDTIyMDgwODIxMzUx+ NlowgagxCzAJBgNVBAYTAlVTMREwDwYDVQQIEwhOZXcgWW9yazERMA8GA1UEBxMI+ TmV3IFlvcmsxHDAaBgNVBAoTE05ldyBZb3JrIFVuaXZlcnNpdHkxDDAKBgNVBAsT+ A0lUUzEiMCAGA1UEAxMZdXJuOm1hY2U6aW5jb21tb246bnl1LmVkdTEjMCEGCSqG+ SIb3DQEJARYUaWRtLnNlcnZpY2VzQG55dS5lZHUwggEiMA0GCSqGSIb3DQEBAQUA+ A4IBDwAwggEKAoIBAQDfb4botPJTcMPCLDenzHqWAOJFenUGEAL33ROzA687b73F+ g72Fnlh2Pp7HNhbB3+cQjsQODitjFdUVQgX8EAP3xMZAGKU2M/0ZGfnGokj5oiU0+ 80ii6zOzEDUCkulR5CW6p+mgdoCYXs3b9riwm1X5pqi/4ZbCKP+K6TiSBOGWxtCs+ Bp7mWFdJlWUT6a3VRdoYmUUQEOJfrTyT8CW0dk0DGToWe2j3taxGT89E3VA6w5Gk+ tQK5sxllEAVQ23fiMdouDAtr4gDNvOSwtYUuDwh/Ppl/lAMwjU+dv08pNuJR9drF+ jYM0jKoiPsG9AdEwkFSGQb0IB1wt8+wAeTCXIKMrAgMBAAGjggERMIIBDTAdBgNV+ HQ4EFgQUleQurEqBxsOHqhL90hCiWMKIvx0wgd0GA1UdIwSB1TCB0oAUleQurEqB+ xsOHqhL90hCiWMKIvx2hga6kgaswgagxCzAJBgNVBAYTAlVTMREwDwYDVQQIEwhO+ ZXcgWW9yazERMA8GA1UEBxMITmV3IFlvcmsxHDAaBgNVBAoTE05ldyBZb3JrIFVu+ aXZlcnNpdHkxDDAKBgNVBAsTA0lUUzEiMCAGA1UEAxMZdXJuOm1hY2U6aW5jb21t+ b246bnl1LmVkdTEjMCEGCSqGSIb3DQEJARYUaWRtLnNlcnZpY2VzQG55dS5lZHWC+ CQCNlew5pYC0NTAMBgNVHRMEBTADAQH/MA0GCSqGSIb3DQEBBQUAA4IBAQDC7w4Z+ zk/qgpNhmee03UxGOixlFn+UaY6QEdjBIO3O3m20hEWLp4Pa+TBvsSlsFWQh1Wlf+ ngZfgK/MjZykdg0+bGwRT9JMcZbg9xeuznOCEenuTMJtDriquzTlN6ms2emelgBe+ fiQOpDC/hsX3Hr0miTgVq6xb3mRxUpMSRFAQqgkmV403fQ+kd8FcsSy1jjS5XLwX+ iB30XNuA1VE0HlWs4l4DV1G/24Jc1Hr7iUyiZMfZlZkEuju7POrmxtU0RZ00Dyis+ tzuHg2kl7HlTBftOs8FDxM3sqityZScutQmvMe6NCy/3nSFyHCQFPfu66bycssYG+ R+4YvtjCZRUas5kS+ </ds:X509Certificate>+ </ds:X509Data>+ </ds:KeyInfo>+ </KeyDescriptor>+ <SingleSignOnService Binding="urn:mace:shibboleth:1.0:profiles:AuthnRequest"+ Location="https://shibboleth.nyu.edu/idp/profile/Shibboleth/SSO" />+ <SingleSignOnService+ Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect"+ Location="https://shibboleth.nyu.edu/idp/profile/SAML2/Redirect/SSO" />+ <SingleSignOnService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST"+ Location="https://shibboleth.nyu.edu/idp/profile/SAML2/POST/SSO" />+ </IDPSSODescriptor>+ <Organization>+ <OrganizationName xml:lang="en">New York University</OrganizationName>+ <OrganizationDisplayName xml:lang="en">New York University</OrganizationDisplayName>+ <OrganizationURL xml:lang="en">http://www.nyu.edu/</OrganizationURL>+ </Organization>+ <ContactPerson contactType="technical">+ <GivenName>Yavor Yanakiev</GivenName>+ <EmailAddress>yy27@nyu.edu</EmailAddress>+ </ContactPerson>+ <ContactPerson contactType="technical">+ <GivenName>Tracy Edappara</GivenName>+ <EmailAddress>tte3@nyu.edu</EmailAddress>+ </ContactPerson>+ <ContactPerson contactType="administrative">+ <GivenName>Gary Chapman</GivenName>+ <EmailAddress>gwc1@nyu.edu</EmailAddress>+ </ContactPerson>+</EntityDescriptor>
+ test/Metadata/metadata-osf.xml view
@@ -0,0 +1,73 @@+<md:EntityDescriptor xmlns:md="urn:oasis:names:tc:SAML:2.0:metadata" ID="_d1a16315f5a36fc0a7d997a1a71a77edd110a396" entityID="https://accounts.osf.io/shibboleth">++ <md:Extensions xmlns:alg="urn:oasis:names:tc:SAML:metadata:algsupport">+ <alg:DigestMethod Algorithm="http://www.w3.org/2001/04/xmlenc#sha512"/>+ <alg:DigestMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#sha384"/>+ <alg:DigestMethod Algorithm="http://www.w3.org/2001/04/xmlenc#sha256"/>+ <alg:DigestMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#sha224"/>+ <alg:DigestMethod Algorithm="http://www.w3.org/2000/09/xmldsig#sha1"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha512"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha384"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha256"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha224"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#rsa-sha512"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#rsa-sha384"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#rsa-sha256"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2009/xmldsig11#dsa-sha256"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2001/04/xmldsig-more#ecdsa-sha1"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2000/09/xmldsig#rsa-sha1"/>+ <alg:SigningMethod Algorithm="http://www.w3.org/2000/09/xmldsig#dsa-sha1"/>+ </md:Extensions>++ <md:SPSSODescriptor protocolSupportEnumeration="urn:oasis:names:tc:SAML:2.0:protocol urn:oasis:names:tc:SAML:1.1:protocol urn:oasis:names:tc:SAML:1.0:protocol">+ <md:Extensions>+ <init:RequestInitiator xmlns:init="urn:oasis:names:tc:SAML:profiles:SSO:request-init" Binding="urn:oasis:names:tc:SAML:profiles:SSO:request-init" Location="https://accounts.osf.io/Shibboleth.sso/Login"/>+ </md:Extensions>+ <md:KeyDescriptor>+ <ds:KeyInfo xmlns:ds="http://www.w3.org/2000/09/xmldsig#">+ <ds:KeyName>f04f8d134cd2</ds:KeyName>+ <ds:X509Data>+ <ds:X509SubjectName>CN=f04f8d134cd2</ds:X509SubjectName>+ <ds:X509Certificate>MIIC6zCCAdOgAwIBAgIJAJqEq0DermlRMA0GCSqGSIb3DQEBBQUAMBcxFTATBgNV+BAMTDGYwNGY4ZDEzNGNkMjAeFw0xNTEyMjkwMDExMzdaFw0yNTEyMjYwMDExMzda+MBcxFTATBgNVBAMTDGYwNGY4ZDEzNGNkMjCCASIwDQYJKoZIhvcNAQEBBQADggEP+ADCCAQoCggEBAN17GPq0XqNYq3WjK9YvoNxXJTikT6adN0iL8t2ZlK2K4p9un7Al+flqzkImW2p/hdO+r/ya3NarnkzdXF1urK+OTkPKaKWh2eAaenuW7nUh8e2c+WaZ0+SugrpVz7+tqxgYH0GHgNCN/1tmuXBUUseHrn0ikblj2G8X6rXaODUj810gP1nf2D+aphxwSjD9P665RiIrq3OQn134zmmX3GwSsEN2+O//w8PJDKZv+egZglibmkfbim3+DVZLRt24FkJI2LI47DlkMx57AlFLF2H06j9iSrLPbjrLperL1fOfTfHCyERcVkCM+k7q+gtoId2JlhF7g2fdO8Vp3xYbqggW3kUcCAwEAAaM6MDgwFwYDVR0RBBAwDoIM+ZjA0ZjhkMTM0Y2QyMB0GA1UdDgQWBBRtejOAWosMsz65hjHV+kql6fvLeDANBgkq+hkiG9w0BAQUFAAOCAQEAIyKvvoo57Xxah0ydoDfzivOv8eRVaeTfMSAWvKrAmy26+N936px6OPcHaaOB49kw2mzhmsHLZODzDJhM4QZX3nXmchHjgXxMgICZt0IsINuAa+TEj+2s8fMgQPD2fsKrv0Xl5GU8bLQ7OdZgsPgSWUKRLTq8jt7XkbhGP/EJkFupl++KIT/H23IfmqZaDHPiq35KezfrWY1tDpIA5Ce1BeXCIVm0AWyWxSD6OV9AAxBUGYD+MnxGWMQdml9GBA7JMrHfuqYFZI2r6QBVSGTJU4AEfPYZjE/KPGZMXHi3aPZv5qYC+cmpdxFpehCnOOGV8KyxUzNv7O55UOBMGxRG+ontZ+g==+</ds:X509Certificate>+ </ds:X509Data>+ </ds:KeyInfo>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2009/xmlenc11#aes128-gcm"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2009/xmlenc11#aes192-gcm"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2009/xmlenc11#aes256-gcm"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2001/04/xmlenc#aes128-cbc"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2001/04/xmlenc#aes192-cbc"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2001/04/xmlenc#aes256-cbc"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2001/04/xmlenc#tripledes-cbc"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2009/xmlenc11#rsa-oaep"/>+ <md:EncryptionMethod Algorithm="http://www.w3.org/2001/04/xmlenc#rsa-oaep-mgf1p"/>+ </md:KeyDescriptor>+ <md:ArtifactResolutionService Binding="urn:oasis:names:tc:SAML:2.0:bindings:SOAP" Location="https://accounts.osf.io/Shibboleth.sso/Artifact/SOAP" index="1"/>+ <md:SingleLogoutService Binding="urn:oasis:names:tc:SAML:2.0:bindings:SOAP" Location="https://accounts.osf.io/Shibboleth.sso/SLO/SOAP"/>+ <md:SingleLogoutService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect" Location="https://accounts.osf.io/Shibboleth.sso/SLO/Redirect"/>+ <md:SingleLogoutService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST" Location="https://accounts.osf.io/Shibboleth.sso/SLO/POST"/>+ <md:SingleLogoutService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Artifact" Location="https://accounts.osf.io/Shibboleth.sso/SLO/Artifact"/>+ <md:AssertionConsumerService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST" Location="https://accounts.osf.io/Shibboleth.sso/SAML2/POST" index="1"/>+ <md:AssertionConsumerService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST-SimpleSign" Location="https://accounts.osf.io/Shibboleth.sso/SAML2/POST-SimpleSign" index="2"/>+ <md:AssertionConsumerService Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Artifact" Location="https://accounts.osf.io/Shibboleth.sso/SAML2/Artifact" index="3"/>+ <md:AssertionConsumerService Binding="urn:oasis:names:tc:SAML:2.0:bindings:PAOS" Location="https://accounts.osf.io/Shibboleth.sso/SAML2/ECP" index="4"/>+ <md:AssertionConsumerService Binding="urn:oasis:names:tc:SAML:1.0:profiles:browser-post" Location="https://accounts.osf.io/Shibboleth.sso/SAML/POST" index="5"/>+ <md:AssertionConsumerService Binding="urn:oasis:names:tc:SAML:1.0:profiles:artifact-01" Location="https://accounts.osf.io/Shibboleth.sso/SAML/Artifact" index="6"/>+ </md:SPSSODescriptor>++</md:EntityDescriptor>
+ test/Metadata/metadata-sp.xml view
@@ -0,0 +1,48 @@+<EntityDescriptor xmlns="urn:oasis:names:tc:SAML:2.0:metadata"+xmlns:saml="urn:oasis:names:tc:SAML:2.0:assertion"+xmlns:ds="http://www.w3.org/2000/09/xmldsig#"+entityID="https://ServiceProvider.com/SAML">+ <SPSSODescriptor AuthnRequestsSigned="true"+protocolSupportEnumeration="urn:oasis:names:tc:SAML:2.0:protocol">+ <KeyDescriptor use="signing">+ <ds:KeyInfo>+ <ds:KeyName>ServiceProvider.com SSO Key</ds:KeyName>+ </ds:KeyInfo>+ </KeyDescriptor>+ <KeyDescriptor use="encryption">+ <ds:KeyInfo>+ <ds:KeyName>ServiceProvider.com Encrypt Key</ds:KeyName>+ </ds:KeyInfo>+ <EncryptionMethod Algorithm="http://www.w3.org/2001/04/xmlenc#rsa-1_5"/>+ </KeyDescriptor>+ <SingleLogoutService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:SOAP"+Location="https://ServiceProvider.com/SAML/SLO/SOAP"/>+ <SingleLogoutService+Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Redirect"+Location="https://ServiceProvider.com/SAML/SLO/Browser"+ResponseLocation="https://ServiceProvider.com/SAML/SLO/Response"/>+ <NameIDFormat>urn:oasis:names:tc:SAML:2.0:nameid-format:transient</NameIDFormat>+ <AssertionConsumerService isDefault="true" index="0"+Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-Artifact"+Location="https://ServiceProvider.com/SAML/SSO/Artifact"/>+ <AssertionConsumerService index="1"+Binding="urn:oasis:names:tc:SAML:2.0:bindings:HTTP-POST"+Location="https://ServiceProvider.com/SAML/SSO/POST"/>+ <AttributeConsumingService index="0">+ <ServiceName xml:lang="en">Academic Journals R US</ServiceName>+ <RequestedAttribute+NameFormat="urn:oasis:names:tc:SAML:2.0:attrname-format:uri"+Name="urn:oid:1.3.6.1.4.1.5923.1.1.1.7"+FriendlyName="eduPersonEntitlement">+ <saml:AttributeValue>https://ServiceProvider.com/entitlements/123456789</saml:AttributeValue>+ </RequestedAttribute>+ </AttributeConsumingService>+ </SPSSODescriptor>+ <Organization>+ <OrganizationName xml:lang="en">Academic Journals R US</OrganizationName>+ <OrganizationDisplayName xml:lang="en">Academic Journals R US, a Division of Dirk Corp.</OrganizationDisplayName>+ <OrganizationURL +xml:lang="en">https://ServiceProvider.com</OrganizationURL>+ </Organization>+</EntityDescriptor>
test/XML/Signature.hs view
@@ -1,20 +1,46 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} module XML.Signature (tests) where +import Control.Exception (SomeException, try)+import Data.ByteString.Base64+import Data.Either (isLeft)+import qualified Crypto.PubKey.DSA as DSA import Data.List.NonEmpty (NonEmpty(..))+import Data.String.Conversions+import Data.Time import qualified Data.X509 as X509+import GHC.Stack+import System.IO.Unsafe (unsafePerformIO)++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified SAML2.XML as HS import qualified Test.HUnit as U import qualified Text.XML.HXT.DOM.QualifiedName as HXT import qualified Text.XML.HXT.DOM.XmlNode as HXT +import SAML2.Core.Protocols+import SAML2.Core.Versioning+import SAML2.Core.Signature+import SAML2.Core.Identifiers import SAML2.XML-import SAML2.XML.Signature import SAML2.XML.Canonical+import SAML2.XML.Signature +import Data.Tree.NTree.TypeDefs+import Text.XML.HXT.DOM.TypeDefs import XML tests :: U.Test-tests = U.test+tests = U.test [serializationTests, signVerifyTests, counterExamples]+++----------------------------------------------------------------------+-- serialization roundtrips++serializationTests :: U.Test+serializationTests = U.test [ testXML "test/XML/signature-example.xml" $ Signature (Just "MyFirstSignature") (SignedInfo Nothing@@ -78,11 +104,11 @@ , testXML "http://www.w3.org/TR/2002/REC-xmldsig-core-20020212/signature-example-rsa.xml" $ Signature Nothing (SignedInfo Nothing- (CanonicalizationMethod + (CanonicalizationMethod (Identified (CanonicalXML10 False)) Nothing [])- (SignatureMethod + (SignatureMethod (Identified SignatureRSA_SHA1) Nothing [])@@ -90,7 +116,7 @@ (Just $ uri "http://www.w3.org/TR/xml-stylesheet") Nothing Nothing- (DigestMethod + (DigestMethod (Identified DigestSHA1) []) "\235Cof\251]L\US\187RyK\167\241\246\226\158\225\225\187"@@ -101,9 +127,9 @@ KeyInfoKeyValue (RSAKeyValue 129320787110389946406925163824095500161767249273623083115363317842079233133623467127773858023148958966585889333894288698085674111884585270272937137414571531865090153762072690670922714784242933462808045060688046441910524319219807614054721975863956765214954333806674482022007523948700289932875920496009317903247 65537)- :| X509Data + :| X509Data (X509SubjectName "\n CN=Merlin Hughes,O=Baltimore Technologies\\, Ltd.,ST=Dublin,C=IE\n "- :| X509IssuerSerial + :| X509IssuerSerial "\n CN=Test RSA CA,O=Baltimore Technologies\\, Ltd.,ST=Dublin,C=IE\n " 970849928 : X509Certificate (either error id $ X509.decodeSignedObject@@ -115,7 +141,7 @@ , testXML "http://www.w3.org/TR/2002/REC-xmldsig-core-20020212/signature-example-dsa.xml" $ Signature Nothing (SignedInfo Nothing- (CanonicalizationMethod + (CanonicalizationMethod (Identified (CanonicalXML10 False)) Nothing [])@@ -135,7 +161,7 @@ (SignatureValue Nothing "\169@\ETX\f\193\217\147'\155\189\ETBK\179\238\131\191\180o\128\194\209\149F\131\a\132=\202\DELW\160\144;\245\173\188\243g\223N") (Just $ KeyInfo Nothing $- KeyInfoKeyValue (DSAKeyValue + KeyInfoKeyValue (DSAKeyValue (Just (153189639877411708224318232157362603672344144516811966787300053511761023886224186320604641484819218412604307502181416378142369715493548254902826913797675909798516465379299499179683104783603344189053156355893057246996756239330536459114483648506158907550755189559705056134296533730500485771224694549017281352213, 1393672757286116725466646726891466679477132949611)) (Just 35729760834794135337622213068423837828001418115741637960451705317746718553830652249599411519579460551833355506946575671195284376652749132624400687252979877843978133909425395446287975790304889073526084815938167334643701873370635770822329121239717107729346766305695485960113338821879352438123181471401687525574) 80624726256040348115552042320696813500187275370942441977258669395023235020055564647117594451929708788598704081077890850726227289270230377442285367559774800853404089092381420228663316324808605521697655145608801533888071381819208887705771753016938104409283940243801509765453542091716518238707344493641683483917@@ -143,7 +169,7 @@ Nothing) :| X509Data (X509SubjectName "\n CN=Merlin Hughes,O=Baltimore Technologies\\, Ltd.,ST=Dublin,C=IE\n "- :| X509IssuerSerial + :| X509IssuerSerial "\n CN=Test DSA CA,O=Baltimore Technologies\\, Ltd.,ST=Dublin,C=IE\n " 970849936 : X509Certificate (either error id $ X509.decodeSignedObject@@ -152,3 +178,116 @@ : []) [] ]+++----------------------------------------------------------------------+-- signing / verification++signVerifyTests :: U.Test+signVerifyTests = U.test+ [ U.TestCase $ do+ let req = somereq+ req' <- signSAMLProtocol privkey1 req+ let reqlbs = samlToXML req'+ req'' :: AuthnRequest <- verifySAMLProtocol reqlbs+ U.assertEqual "AuthnRequest with verifySAMLProtocol (no pubkeys)" req' req''++ , U.TestCase $ do+ let req = somereq+ req' <- signSAMLProtocol privkey1 req+ let reqdoc = samlToDoc req'+ req'' :: AuthnRequest <- verifySAMLProtocol' pubkey1 reqdoc+ U.assertEqual "AuthnRequest with verifySAMLProtocol' (matching pubkeys)" req' req''++ , U.TestCase $ do+ let req = somereq+ req' <- signSAMLProtocol privkey1 req+ let reqdoc = samlToDoc req'+ req'' :: Either SomeException AuthnRequest <- try $ verifySAMLProtocol' pubkey2 reqdoc+ U.assertBool "AuthnRequest with verifySAMLProtocol' (bad pubkeys)" $ isLeft req''+ ]++{-# NOINLINE keypair1 #-}+keypair1 :: (SigningKey, PublicKeys)+keypair1 = unsafePerformIO mkkeypair++{-# NOINLINE keypair2 #-}+keypair2 :: (SigningKey, PublicKeys)+keypair2 = unsafePerformIO mkkeypair++privkey1, _privkey2 :: SigningKey+pubkey1, pubkey2 :: PublicKeys+((privkey1, pubkey1), (_privkey2, pubkey2)) = (keypair1, keypair2)++mkkeypair :: IO (SigningKey, PublicKeys)+mkkeypair = do+ privnum <- DSA.generatePrivate params+ let pubnum = DSA.calculatePublic params privnum+ kp = DSA.KeyPair params pubnum privnum+ pure (SigningKeyDSA kp, PublicKeys (Just $ DSA.toPublicKey kp) Nothing)+ where+ params = DSA.Params+ { DSA.params_p = 13232376895198612407547930718267435757728527029623408872245156039757713029036368719146452186041204237350521785240337048752071462798273003935646236777459223+ , DSA.params_q = 857393771208094202104259627990318636601332086981+ , DSA.params_g = 5421644057436475141609648488325705128047428394380474376834667300766108262613900542681289080713724597310673074119355136085795982097390670890367185141189796+ }++somereq :: AuthnRequest+somereq = AuthnRequest+ { authnRequest = RequestAbstractType someprottype+ , authnRequestForceAuthn = False+ , authnRequestIsPassive = False+ , authnRequestAssertionConsumerService = AssertionConsumerServiceURL Nothing Nothing+ , authnRequestAssertionConsumingServiceIndex = Nothing+ , authnRequestProviderName = Nothing+ , authnRequestSubject = Nothing+ , authnRequestNameIDPolicy = Nothing+ , authnRequestConditions = Nothing+ , authnRequestRequestedAuthnContext = Nothing+ , authnRequestScoping = Nothing+ }++someprottype :: ProtocolType+someprottype = ProtocolType+ { protocolID = "wef"+ , protocolVersion = SAML20+ , protocolIssueInstant = someTime+ , protocolDestination = Nothing+ , protocolConsent = Identified ConsentUnspecified+ , protocolIssuer = Nothing+ , protocolSignature = Nothing+ , protocolExtensions = []+ , relayState = Nothing+ }++someTime :: UTCTime+Just someTime = parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%S%QZ" "2013-03-18T03:28:54.1Z"++----------------------------------------------------------------------+-- more counter-examples++counterExamples :: U.Test+counterExamples = U.test+ [ U.TestCase $ do+ (i, o) <- canonicalizeCounterExample "PGE+w6Q8L2E+"+ U.assertEqual "canoncalization broke the input" i o+ ]++canonicalizeCounterExample :: HasCallStack => BS.ByteString -> IO (LBS, LBS)+canonicalizeCounterExample base64input = do+ let inbs :: LBS.ByteString+ inbs = either (error "badcase") cs $ Data.ByteString.Base64.decode base64input++ tree :: XmlTree+ tree = maybe (error "badcase") id $ HS.xmlToDoc inbs++ algo :: CanonicalizationAlgorithm+ algo = CanonicalXMLExcl10 {canonicalWithComments = True}++ outbs :: LBS.ByteString <- cs <$> canonicalize algo Nothing Nothing (NTree (XTag (mkQName "" "" "root") []) [tree])++ -- LBS.putStr ("[" <> inbs <> "]\n")+ -- LBS.putStr ("[" <> outbs <> "]\n")+ -- print $ inbs == outbs++ pure (inbs, outbs)
+ test/XML/noncanonical1.xml view
@@ -0,0 +1,13 @@+<?xml version="1.0"?>++<?xml-stylesheet href="doc.xsl"+ type="text/xsl" ?>+++<doc>Hello, world!<!-- Comment 1 --></doc>++<?pi-without-data ?>++<!-- Comment 2 -->++<!-- Comment 3 -->
+ test/XML/noncanonical2.xml view
@@ -0,0 +1,11 @@+<doc>+ <clean> </clean>+ <dirty> A B </dirty>+ <mixed>+ A+ <clean> </clean>+ B+ <dirty> A B </dirty>+ C+ </mixed>+</doc>
+ test/XML/noncanonical3.xml view
@@ -0,0 +1,18 @@+<!DOCTYPE doc [<!ATTLIST e9 attr CDATA "default">]>+<doc>+ <e1 />+ <e2 ></e2>+ <e3 name = "elem3" id="elem3" />+ <e4 name="elem4" id="elem4" ></e4>+ <e5 a:attr="out" b:attr="sorted" attr2="all" attr="I'm"+ xmlns:b="http://www.ietf.org"+ xmlns:a="http://www.w3.org"+ xmlns="http://example.org"/>+ <e6 xmlns="" xmlns:a="http://www.w3.org">+ <e7 xmlns="http://www.ietf.org">+ <e8 xmlns="" xmlns:a="http://www.w3.org">+ <e9 xmlns="" xmlns:a="http://www.ietf.org"/>+ </e8>+ </e7>+ </e6>+</doc>
+ test/XML/noncanonical4.xml view
@@ -0,0 +1,13 @@+<!DOCTYPE doc [+<!ATTLIST normId id ID #IMPLIED>+<!ATTLIST normNames attr NMTOKENS #IMPLIED>+]>+<doc>+ <text>First line
 Second line</text>+ <value>2</value>+ <compute><![CDATA[value>"0" && value<"10" ?"valid":"error"]]></compute>+ <compute expr='value>"0" && value<"10" ?"valid":"error"'>valid</compute>+ <norm attr=' '   
	 ' '/>+ <normNames attr=' A   
	 B '/>+ <normId id=' '   
	 ' '/>+</doc>
+ test/XML/noncanonical5.xml view
@@ -0,0 +1,12 @@+<!DOCTYPE doc [+<!ATTLIST doc attrExtEnt ENTITY #IMPLIED>+<!ENTITY ent1 "Hello">+<!ENTITY ent2 SYSTEM "world.txt">+<!ENTITY entExt SYSTEM "earth.gif" NDATA gif>+<!NOTATION gif SYSTEM "viewgif.exe">+]>+<doc attrExtEnt="entExt">+ &ent1;, &ent2;!+</doc>++<!-- Let world.txt contain "world" (excluding the quotes) -->
+ test/XML/noncanonical6.xml view
@@ -0,0 +1,2 @@+<?xml version="1.0" encoding="ISO-8859-1"?>+<doc>©</doc>
+ test/XML/world.txt view
@@ -0,0 +1,1 @@+world