-------------------------------------------------------------------------------- -- SAML2 Middleware for WAI -- -------------------------------------------------------------------------------- -- This source code is licensed under the MIT license found in the LICENSE -- -- file in the root directory of this source tree. -- -------------------------------------------------------------------------------- module Main ( main ) where -------------------------------------------------------------------------------- import Control.Concurrent import Control.Monad.IO.Class import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.Vault.Lazy as V import Data.X509 import Data.X509.File import Network.HTTP.Types.Status import Network.Wai import Network.Wai.Test import Network.Wai.Handler.Warp import Network.Wai.SAML2 -------------------------------------------------------------------------------- -- | 'tests' implements the tests. tests :: Session () tests = do samlResponse <- liftIO $ BS.readFile "test-data/sample-response" let req = (setPath defaultRequest "/sso/assert"){ requestMethod = "POST", requestHeaders = [("Content-Type","application/x-www-form-urlencoded")] } res <- srequest $ SRequest req (LBS.fromStrict samlResponse) samlResponseWithRs <- liftIO $ BS.readFile "test-data/sample-response-with-rs" res <- srequest $ SRequest req (LBS.fromStrict samlResponseWithRs) assertStatus 200 res -- | 'main' is the main entry point for the test suite. main :: IO () main = do -- load private and public keys for the SP and IdP respectively [privKey] <- liftIO $ readKeyFile "test-data/sp.pem" [pubKey] <- liftIO $ readSignedObject "test-data/idp.pem" let (PrivKeyRSA privateKey) = privKey let (PubKeyRSA publicKey) = certPubKey $ signedObject $ getSigned pubKey -- construct a configuration for the SAML2 middleware; we disable -- time validation since it would require us to issue new responses -- every time we run the tests let config = (saml2Config privateKey publicKey){ saml2DisableTimeValidation = True } -- run the middleware with a basic application on top and execute the -- tests against it runSession tests $ saml2Vault config $ \req respond -> do print $ V.lookup relayStateKey (vault req) respond $ case V.lookup errorKey (vault req) of Just err -> do responseLBS status400 [] "Invalid request" Nothing -> responseLBS status200 [] "Hello World" --------------------------------------------------------------------------------