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

-- | Configuration types and smart constructors for the SAML2 middleware.
module Network.Wai.SAML2.Config (
    SAML2Config(..),
    saml2Config
) where 

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

import qualified Data.ByteString as BS
import qualified Data.Text as T
import Crypto.PubKey.RSA

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

-- | Represents configurations for the SAML2 middleware.
data SAML2Config = SAML2Config {
    -- | The path relative to the root of the web application at which the
    -- middleware should listen for SAML2 assertions (e.g. /sso/assert).
    SAML2Config -> ByteString
saml2AssertionPath :: !BS.ByteString,
    -- | The service provider's private key, used to decrypt data from 
    -- the identity provider.
    SAML2Config -> PrivateKey
saml2PrivateKey :: !PrivateKey,
    -- | The identity provider's public key, used to validate
    -- signatures.
    SAML2Config -> PublicKey
saml2PublicKey :: !PublicKey,
    -- | The name of the entity we expect assertions from. If this is set
    -- to 'Nothing', the issuer name is not validated.
    SAML2Config -> Maybe Text
saml2ExpectedIssuer :: !(Maybe T.Text),
    -- | The URL we expect the SAML2 response to contain as destination.
    SAML2Config -> Maybe Text
saml2ExpectedDestination :: !(Maybe T.Text),
    -- | A value indicating whether to disable time validity checks. This
    -- should not be set to 'True' in a production environment, but may
    -- be useful for testing purposes.
    SAML2Config -> Bool
saml2DisableTimeValidation :: !Bool
}

-- | 'saml2Config' @privateKey publicKey@ constructs a 'SAML2Config' value
-- with the most basic set of options possible using @privateKey@ as the 
-- SP's private key and @publicKey@ as the IdP's public key. You should 
-- almost certainly change the resulting settings.
saml2Config :: PrivateKey -> PublicKey -> SAML2Config
saml2Config :: PrivateKey -> PublicKey -> SAML2Config
saml2Config PrivateKey
privKey PublicKey
pubKey = SAML2Config :: ByteString
-> PrivateKey
-> PublicKey
-> Maybe Text
-> Maybe Text
-> Bool
-> SAML2Config
SAML2Config{
    saml2AssertionPath :: ByteString
saml2AssertionPath = ByteString
"/sso/assert",
    saml2PrivateKey :: PrivateKey
saml2PrivateKey = PrivateKey
privKey,
    saml2PublicKey :: PublicKey
saml2PublicKey = PublicKey
pubKey,
    saml2ExpectedIssuer :: Maybe Text
saml2ExpectedIssuer = Maybe Text
forall a. Maybe a
Nothing,
    saml2ExpectedDestination :: Maybe Text
saml2ExpectedDestination = Maybe Text
forall a. Maybe a
Nothing,
    saml2DisableTimeValidation :: Bool
saml2DisableTimeValidation = Bool
False
}

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