packages feed

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 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&#x0d;&#10;Second line</text>+   <value>&#x32;</value>+   <compute><![CDATA[value>"0" && value<"10" ?"valid":"error"]]></compute>+   <compute expr='value>"0" &amp;&amp; value&lt;"10" ?"valid":"error"'>valid</compute>+   <norm attr=' &apos;   &#x20;&#13;&#xa;&#9;   &apos; '/>+   <normNames attr='   A   &#x20;&#13;&#xa;&#9;   B   '/>+   <normId id=' &apos;   &#x20;&#13;&#xa;&#9;   &apos; '/>+</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>&#169;</doc>
+ test/XML/world.txt view
@@ -0,0 +1,1 @@+world