wai-saml2-0.2.1.1: test/Spec.hs

--------------------------------------------------------------------------------
-- 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"

--------------------------------------------------------------------------------