diff --git a/SAML2/Bindings/HTTPRedirect.hs b/SAML2/Bindings/HTTPRedirect.hs --- a/SAML2/Bindings/HTTPRedirect.hs +++ b/SAML2/Bindings/HTTPRedirect.hs @@ -98,8 +98,8 @@ case ql paramSignatureAlgorithm of Just (sav, sas) -> do sigres $ DS.verifyBase64 pk (reidentify $ puri sav) - (snd pq <> foldMap (BSC.cons '&' . snd) rsq <> BSC.cons '&' sas) (foldMap fst $ ql paramSignature) + (snd pq <> foldMap (BSC.cons '&' . snd) rsq <> BSC.cons '&' sas) unless (SAMLP.protocolDestination (p ^. SAMLP.samlProtocol') == Just ru{ uriQuery = "" }) $ fail "Destination incorrect" Nothing -> return () diff --git a/SAML2/XML/Signature.hs b/SAML2/XML/Signature.hs --- a/SAML2/XML/Signature.hs +++ b/SAML2/XML/Signature.hs @@ -172,7 +172,7 @@ signBase64 sk = fmap Base64.encode . signBytes sk verifyBase64 :: PublicKeys -> IdentifiedURI SignatureAlgorithm -> BS.ByteString -> BS.ByteString -> Maybe Bool -verifyBase64 pk alg m = either (const $ Just False) (verifyBytes pk alg m) . Base64.decode where +verifyBase64 pk alg sig m = either (const $ Just False) (\s -> verifyBytes pk alg s m) $ Base64.decode sig generateSignature :: SigningKey -> SignedInfo -> IO Signature generateSignature sk si = do @@ -203,9 +203,8 @@ s@Signature{ signatureSignedInfo = si } <- either fail return $ docToSAML sx six <- applyCanonicalization (signedInfoCanonicalizationMethod si) (Just xpath) $ DOM.mkRoot [] [x] rl <- mapM (`verifyReference` x) (signedInfoReference si) - let keys = pks <> foldMap (foldMap keyinfo . keyInfoElements) (signatureKeyInfo s) - verified :: Maybe Bool - verified = verifyBytes keys (signatureMethodAlgorithm $ signedInfoSignatureMethod si) (signatureValue $ signatureSignatureValue s) six + let verified :: Maybe Bool + verified = verifyBytes pks (signatureMethodAlgorithm $ signedInfoSignatureMethod si) (signatureValue $ signatureSignatureValue s) six valid :: Bool valid = elem (Just xid) rl && all isJust rl return $ (valid &&) <$> verified diff --git a/hsaml2.cabal b/hsaml2.cabal --- a/hsaml2.cabal +++ b/hsaml2.cabal @@ -1,5 +1,5 @@ name: hsaml2 -version: 0.1.1 +version: 0.1.2 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 @@ -104,6 +104,7 @@ Metadata.Metadata XML XML.Canonical + XML.Keys XML.Encryption XML.Signature default-language: Haskell2010 @@ -116,6 +117,7 @@ hsaml2, hxt, hxt-http, + http-types, network-uri, semigroups, string-conversions, diff --git a/test/Bindings/HTTPRedirect.hs b/test/Bindings/HTTPRedirect.hs --- a/test/Bindings/HTTPRedirect.hs +++ b/test/Bindings/HTTPRedirect.hs @@ -3,6 +3,8 @@ import qualified Data.ByteString.Char8 as BSC import Data.Time (UTCTime(..), fromGregorian) import qualified Test.HUnit as U +import Data.ByteString.Char8 (unpack) +import Network.HTTP.Types.URI (renderQuery) import SAML2.XML import SAML2.Core.Versioning @@ -12,39 +14,47 @@ import SAML2.Bindings.HTTPRedirect import XML +import XML.Keys tests :: U.Test tests = U.test - [ U.TestCase $ U.assertEqual "request" - (RequestLogoutRequest $ LogoutRequest - (RequestAbstractType $ ProtocolType - "d2b7c388cec36fa7c39c28fd298644a8" - SAML20 - (UTCTime (fromGregorian 2004 1 21) (19*60*60+49)) - Nothing - (Identified ConsentUnspecified) - (Just $ Issuer $ simpleNameID NameIDFormatEntity "https://IdentityProvider.com/SAML") - Nothing - [] - (Just $ BSC.pack "0043bfc1bc45110dae17004005b13a2b")) - Nothing - Nothing - (NotEncrypted $ IdentifierName $ simpleNameID NameIDFormatPersistent "005a06e0-ad82-110d-a556-004005b13a2b") - ["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 - (ProtocolType - "b0730d21b628110d8b7e004005b13a2b" - SAML20 - (UTCTime (fromGregorian 2004 1 21) (19*60*60+49)) - Nothing - (Identified ConsentUnspecified) - (Just $ Issuer $ simpleNameID NameIDFormatEntity "https://ServiceProvider.com/SAML") - Nothing - [] - (Just $ BSC.pack "0043bfc1bc45110dae17004005b13a2b")) - (Just "d2b7c388cec36fa7c39c28fd298644a8") - successStatus) - =<< decodeURI mempty (uri "https://IdentityProvider.com/SAML/SLO/Response?SAMLResponse=fVFNa4QwEL0X%2Bh8k912TaDUGFUp7EbZQ6rKH3mKcbQVNJBOX%2FvxaXQ9tYec0vHlv3nzkqIZ%2BlAf7YSf%2FBjhagxB8Db1BuZQKMjkjrcIOpVEDoPRa1o8vB8n3VI7OeqttT1bJbbJCBOc7a8j9XTBH9VyQhqYRbTlrEi4Yo61oUqA0pvShYZHiDQkqs411tAVpeZPqSAgNOkrOas4zzcW55ZlI4liJrTXiBJVBr4wvCJ877ijbcXZkmaRUxtk7CU7gcB5mLu8pKVddvghd%2Ben9iDIMa3CXTsOrs5euBbfXdgh%2F9snDK%2FEqW69Ye%2BUnvGL%2F8CfbQnBS%2FQS3z4QLW9aT1oBIws0j%2FGOyAb9%2FV34Dw5k779IBAAA%3D&RelayState=0043bfc1bc45110dae17004005b13a2b") + [ U.TestCase $ do + let baseURI = "https://ServiceProvider.com/SAML/SLO/Browser" + request = + (RequestLogoutRequest $ LogoutRequest + (RequestAbstractType $ ProtocolType + "d2b7c388cec36fa7c39c28fd298644a8" + SAML20 + (UTCTime (fromGregorian 2004 1 21) (19*60*60+49)) + (Just $ uri baseURI) + (Identified ConsentUnspecified) + (Just $ Issuer $ simpleNameID NameIDFormatEntity "https://IdentityProvider.com/SAML") + Nothing + [] + (Just $ BSC.pack "0043bfc1bc45110dae17004005b13a2b")) + Nothing + Nothing + (NotEncrypted $ IdentifierName $ simpleNameID NameIDFormatPersistent "005a06e0-ad82-110d-a556-004005b13a2b") + ["1"]) + query <- unpack . renderQuery True <$> encodeQuery (Just privkey1) request + decodedRequest <- decodeURI pubkey1 (uri $ baseURI ++ query) + U.assertEqual "request" request decodedRequest + , U.TestCase $ do + let baseURI = "https://IdentityProvider.com/SAML" + resp = (LogoutResponse $ StatusResponseType + (ProtocolType + "b0730d21b628110d8b7e004005b13a2b" + SAML20 + (UTCTime (fromGregorian 2004 1 21) (19*60*60+49)) + (Just $ uri baseURI) + (Identified ConsentUnspecified) + (Just $ Issuer $ simpleNameID NameIDFormatEntity "https://ServiceProvider.com/SAML") + Nothing + [] + (Just $ BSC.pack "0043bfc1bc45110dae17004005b13a2b")) + (Just "d2b7c388cec36fa7c39c28fd298644a8") + successStatus) + query <- unpack . renderQuery True <$> encodeQuery (Just privkey1) resp + decodedResponse <- decodeURI pubkey1 (uri $ baseURI ++ query) + U.assertEqual "response" resp decodedResponse ] diff --git a/test/XML/Keys.hs b/test/XML/Keys.hs new file mode 100644 --- /dev/null +++ b/test/XML/Keys.hs @@ -0,0 +1,47 @@ +module XML.Keys (privkey1, pubkey1, pubkey2, privkeyRsa, dummyPubkeyRSA) where + +import SAML2.XML.Signature +import qualified Crypto.PubKey.RSA as RSA +import qualified Crypto.PubKey.RSA.Types as RSA +import qualified Crypto.PubKey.DSA as DSA +import System.IO.Unsafe (unsafePerformIO) + +{-# 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 + } + +privkeyRsa :: SigningKey +_pubkeyRsa :: PublicKeys +(privkeyRsa, _pubkeyRsa) = unsafePerformIO mkRsaKeypair + +_dummyPrivkeyRSA :: SigningKey +dummyPubkeyRSA :: PublicKeys +(_dummyPrivkeyRSA, dummyPubkeyRSA) = unsafePerformIO mkRsaKeypair + +mkRsaKeypair :: IO (SigningKey, PublicKeys) +mkRsaKeypair = do + let rsaexp = 17 + size = 96 + (pubkey, privkey) <- RSA.generate size rsaexp + pure (SigningKeyRSA (RSA.KeyPair privkey), PublicKeys Nothing (Just pubkey)) diff --git a/test/XML/Signature.hs b/test/XML/Signature.hs --- a/test/XML/Signature.hs +++ b/test/XML/Signature.hs @@ -5,13 +5,12 @@ import Control.Exception (SomeException, try) import Data.ByteString.Base64 import Data.Either (isLeft) -import qualified Crypto.PubKey.DSA as DSA +import Data.List (isInfixOf) 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 @@ -31,6 +30,7 @@ import Data.Tree.NTree.TypeDefs import Text.XML.HXT.DOM.TypeDefs import XML +import XML.Keys tests :: U.Test tests = U.test [serializationTests, signVerifyTests, counterExamples] @@ -188,49 +188,37 @@ [ 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'' + 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 + req' <- signSAMLProtocol privkeyRsa req let reqdoc = samlToDoc req' - req'' :: AuthnRequest <- verifySAMLProtocol' pubkey1 reqdoc - U.assertEqual "AuthnRequest with verifySAMLProtocol' (matching pubkeys)" req' req'' + req'' :: Either SomeException AuthnRequest <- try $ verifySAMLProtocol' pubkey1 reqdoc + U.assertBool "AuthnRequest with verifySAMLProtocol' (bad pubkeys): isLeft" + $ isLeft req'' + U.assertBool "AuthnRequest with verifySAMLProtocol' (bad pubkeys): error message matches" + $ "Left user error (signature verification failed: no matching key/alg pair.)" `isInfixOf` show req'' , U.TestCase $ do let req = somereq + req' <- signSAMLProtocol privkeyRsa req + let reqdoc = samlToDoc req' + req'' :: Either SomeException AuthnRequest <- try $ verifySAMLProtocol' (pubkey1 <> dummyPubkeyRSA) reqdoc + U.assertBool "AuthnRequest with verifySAMLProtocol' (bad pubkeys): isLeft" + $ isLeft req'' + U.assertBool "AuthnRequest with verifySAMLProtocol' (bad pubkeys): error message matches" + $ "Left user error (signature verification failed: verification failed.)" `isInfixOf` show 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