wai-saml2 (empty) → 0.1.0.0
raw patch · 15 files changed
+1517/−0 lines, 15 filesdep +basedep +base64-bytestringdep +bytestring
Dependencies added: base, base64-bytestring, bytestring, c14n, cryptonite, data-default-class, http-types, mtl, text, time, vault, wai, wai-extra, x509, x509-store, xml-conduit
Files
- CHANGELOG.md +3/−0
- LICENSE +21/−0
- src/Network/Wai/SAML2.hs +190/−0
- src/Network/Wai/SAML2/Assertion.hs +232/−0
- src/Network/Wai/SAML2/C14N.hs +44/−0
- src/Network/Wai/SAML2/Config.hs +58/−0
- src/Network/Wai/SAML2/Error.hs +64/−0
- src/Network/Wai/SAML2/KeyInfo.hs +40/−0
- src/Network/Wai/SAML2/Response.hs +115/−0
- src/Network/Wai/SAML2/Signature.hs +159/−0
- src/Network/Wai/SAML2/StatusCode.hs +43/−0
- src/Network/Wai/SAML2/Validation.hs +259/−0
- src/Network/Wai/SAML2/XML.hs +85/−0
- src/Network/Wai/SAML2/XML/Encrypted.hs +138/−0
- wai-saml2.cabal +66/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+# 0.1.0++* Initial release
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2020 Michael B. Gale++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ src/Network/Wai/SAML2.hs view
@@ -0,0 +1,190 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | Implements WAI 'Middleware' for SAML2 service providers. Two different+-- interfaces are supported (with equivalent functionality): one which simply+-- stores the outcome of the validation process in the request vault and one+-- which passes the outcome to a callback.+module Network.Wai.SAML2 ( + -- * Callback-based middleware+ --+ -- $callbackBasedMiddleware+ saml2Callback,++ -- * Vault-based middleware+ -- + -- $vaultBasedMiddleware+ assertionKey,+ errorKey,+ saml2Vault,++ -- * Re-exports+ module Network.Wai.SAML2.Config,+ module Network.Wai.SAML2.Error,+ module Network.Wai.SAML2.Assertion+) where ++--------------------------------------------------------------------------------++import qualified Data.Vault.Lazy as V++import Network.Wai +import Network.Wai.Parse+import Network.Wai.SAML2.Config+import Network.Wai.SAML2.Validation+import Network.Wai.SAML2.Assertion+import Network.Wai.SAML2.Error++import System.IO.Unsafe (unsafePerformIO)++--------------------------------------------------------------------------------++-- | Checks whether the request method of @request@ is @"POST"@.+isPOST :: Request -> Bool +isPOST = (=="POST") . requestMethod++--------------------------------------------------------------------------------++-- $callbackBasedMiddleware+--+-- This 'Middleware' provides a SAML2 service provider (SP) implementation+-- that can be wrapped around an existing WAI 'Application'. The middleware is+-- parameterised over the SAML2 configuration and a callback. If the middleware+-- intercepts a request made to the endpoint given by the SAML2 configuration,+-- the result of validating the SAML2 response contained in the request body+-- will be passed to the callback.+--+-- > saml2Callback cfg callback mainApp+-- > where callback (Left err) app req sendResponse = do+-- > -- a POST request was made to the assertion endpoint, but+-- > -- something went wrong, details of which are provided by+-- > -- the error: this should probably be logged as it may+-- > -- indicate that an attack was attempted against the +-- > -- endpoint, but you *must* not show the error+-- > -- to the client as it would severely compromise+-- > -- system security+-- > -- +-- > -- you may also want to return e.g. a HTTP 400 or 401 status+-- >+-- > callback (Right assertion) app req sendResponse = do +-- > -- a POST request was made to the assertion endpoint and the+-- > -- SAML2 response was successfully validated: +-- > -- you *must* check that you have not encountered the +-- > -- assertion ID before; we assume that there is a+-- > -- computation tryRetrieveAssertion which looks up+-- > -- assertions by ID in e.g. a database+-- > result <- tryRetrieveAssertion (assertionId assertion)+-- > +-- > case result of +-- > Just something -> -- a replay attack has occurred+-- > Nothing -> do+-- > -- store the assertion id somewhere+-- > storeAssertion (assertionId assertion)+-- > +-- > -- the assertion is valid and you can now e.g.+-- > -- retrieve user data from your database+-- > -- before proceeding with the request by e.g.+-- > -- redirecting them to the main view++-- | 'saml2Callback' @config callback@ produces SAML2 'Middleware' for+-- the given @config@. If the middleware intercepts a request to the +-- endpoint given by @config@, the result will be passed to @callback@.+saml2Callback :: SAML2Config + -> (Either SAML2Error Assertion -> Middleware) + -> Middleware+saml2Callback cfg callback app req sendResponse = do + let path = rawPathInfo req ++ -- check if we need to handle this request+ if | path == saml2AssertionPath cfg && isPOST req -> do + -- default request parse options, but do not allow files;+ -- we are not expecting any+ let bodyOpts = setMaxRequestNumFiles 0+ $ setMaxRequestFileSize 0+ $ defaultParseRequestBodyOptions++ -- parse the request+ (body, _) <- parseRequestBodyEx bodyOpts lbsBackEnd req ++ case body of + -- extract the SAML response from the request body+ [("SAMLResponse",val)] -> do + result <- validateResponse cfg val++ -- call the callback+ callback result app req sendResponse + + -- the request does not contain the expected payload+ _ -> callback (Left InvalidRequest) app req sendResponse+ -- not one of the paths we need to handle, pass the request on to the+ -- inner application+ | otherwise -> app req sendResponse++--------------------------------------------------------------------------------++-- $vaultBasedMiddleware+--+-- This is a simpler-to-use 'Middleware' which stores the outcome of a request+-- made to the assertation endpoint in the request vault. The inner WAI+-- application can then check of the presence of an assertion or an error with +-- 'V.lookup' and 'assertionKey' or 'errorKey' respectively. At most one of +-- the two locations will be populated for a given request, i.e. it is not+-- possible for an assertion to be validated and an error to occur.+--+-- > saml2Vault cfg $ \app req sendResponse -> do +-- > case V.lookup errorKey (vault req) of +-- > Just err -> +-- > -- log the error, but you *must* not show the error+-- > -- to the client as it would severely compromise+-- > -- system security+-- > Nothing -> pure () -- carry on+-- >+-- > case V.lookup assertionKey (vault req) of+-- > Nothing -> pure () -- carry on+-- > Just assertion -> do +-- > -- a valid assertion was processed by the middleware,+-- > -- you *must* check that you have not encountered the +-- > -- assertion ID before; we assume that there is a+-- > -- computation tryRetrieveAssertion which looks up+-- > -- assertions by ID in e.g. a database+-- > result <- tryRetrieveAssertion (assertionId assertion)+-- > +-- > case result of +-- > Just something -> -- a replay attack has occurred+-- > Nothing -> do+-- > -- store the assertion id somewhere+-- > storeAssertion (assertionId assertion)+-- > +-- > -- the assertion is valid++-- | 'assertionKey' is a vault key for retrieving assertions from+-- request vaults if the 'saml2Vault' 'Middleware' is used.+assertionKey :: V.Key Assertion+assertionKey = unsafePerformIO V.newKey++-- | 'errorKey' is a vault key for retrieving SAML2 errors from request vaults+-- if the 'saml2Vault' 'Middleware' is used.+errorKey :: V.Key SAML2Error+errorKey = unsafePerformIO V.newKey++-- | 'saml2Vault' @config@ produces SAML2 'Middleware' for the given @config@.+saml2Vault :: SAML2Config -> Middleware+saml2Vault cfg = saml2Callback cfg callback + -- if the middleware intercepts a request containing a SAML2 response at + -- the configured endpoint, the outcome of processing response will be+ -- passed to this callback: we store the result in the corresponding+ -- entry in the request vault+ where callback (Left err) app req sendResponse = do+ app req{+ vault = V.insert errorKey err (vault req)+ } sendResponse + callback (Right assertion) app req sendResponse = do + app req{ + vault = V.insert assertionKey assertion (vault req) + } sendResponse++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/Assertion.hs view
@@ -0,0 +1,232 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | Types to represent SAML2 assertions and functions to parse them from XML.+module Network.Wai.SAML2.Assertion (+ SubjectConfirmationMethod(..),+ SubjectConfirmation(..),+ Subject(..),+ Conditions(..),+ AuthnStatement(..),+ AssertionAttribute(..),+ AttributeStatement,+ parseAttributeStatement,+ Assertion(..)+) where ++--------------------------------------------------------------------------------++import Control.Monad++import qualified Data.Text as T+import Data.Time++import Text.XML.Cursor++import Network.Wai.SAML2.XML++--------------------------------------------------------------------------------++-- | Enumerates different subject confirmation methods.+-- See http://docs.oasis-open.org/security/saml/Post2.0/sstc-saml-tech-overview-2.0-cd-02.html#4.2.1.Subject%20Confirmation%20|outline+data SubjectConfirmationMethod+ = HolderOfKey -- ^ urn:oasis:names:tc:SAML:2.0:cm:holder-of-key+ | SenderVouches -- ^ urn:oasis:names:tc:SAML:2.0:cm:sender-vouches+ | Bearer -- ^ urn:oasis:names:tc:SAML:2.0:cm:bearer+ deriving (Eq, Show)++instance FromXML SubjectConfirmationMethod where + parseXML cursor = case T.concat $ attribute "Method" cursor of + "urn:oasis:names:tc:SAML:2.0:cm:holder-of-key" -> pure HolderOfKey+ "urn:oasis:names:tc:SAML:2.0:cm:sender-vouches" -> pure SenderVouches+ "urn:oasis:names:tc:SAML:2.0:cm:bearer" -> pure Bearer+ _ -> fail "Not a valid SubjectConfirmationMethod."++--------------------------------------------------------------------------------++-- | Represents a subject confirmation record.+data SubjectConfirmation = SubjectConfirmation {+ -- | The subject confirmation method used.+ subjectConfirmationMethod :: !SubjectConfirmationMethod,+ -- | The address of the subject.+ subjectConfirmationAddress :: !T.Text,+ -- | A timestamp.+ subjectConfirmationNotOnOrAfter :: !UTCTime,+ -- | The recipient.+ subjectConfirmationRecipient :: !T.Text+} deriving (Eq, Show)++instance FromXML SubjectConfirmation where + parseXML cursor = do + method <- parseXML cursor++ notOnOrAfter <- parseUTCTime $ T.concat $+ cursor $/ element (saml2Name "SubjectConfirmationData") + >=> attribute "NotOnOrAfter"++ pure SubjectConfirmation{+ subjectConfirmationMethod = method,+ subjectConfirmationAddress = T.concat $+ cursor $/ element (saml2Name "SubjectConfirmationData")+ >=> attribute "Address",+ subjectConfirmationNotOnOrAfter = notOnOrAfter,+ subjectConfirmationRecipient = T.concat $+ cursor $/ element (saml2Name "SubjectConfirmationData")+ >=> attribute "Recipient"+ }++-- | The subject of the assertion.+data Subject = Subject {+ -- | The list of subject confirmation elements, if any.+ subjectConfirmations :: ![SubjectConfirmation]+} deriving (Eq, Show)++instance FromXML Subject where + parseXML cursor = do + confirmations <- sequence $ + cursor $/ element (saml2Name "SubjectConfirmation") &| parseXML++ pure Subject{+ subjectConfirmations = confirmations+ }++--------------------------------------------------------------------------------++-- | Conditions under which a SAML assertion is issued.+data Conditions = Conditions {+ -- | The time when the assertion is valid from (inclusive).+ conditionsNotBefore :: !UTCTime,+ -- | The time the assertion is valid to (not inclusive).+ conditionsNotOnOrAfter :: !UTCTime,+ -- | The intended audience of the assertion.+ conditionsAudience :: !T.Text+} deriving (Eq, Show)++instance FromXML Conditions where+ parseXML cursor = do + notBefore <- parseUTCTime $ + T.concat $ attribute "NotBefore" cursor+ notOnOrAfter <- parseUTCTime $ + T.concat $ attribute "NotOnOrAfter" cursor++ pure Conditions{+ conditionsNotBefore = notBefore,+ conditionsNotOnOrAfter = notOnOrAfter,+ conditionsAudience = T.concat $ + cursor $/ element (saml2Name "AudienceRestriction")+ &/ element (saml2Name "Audience")+ &/ content+ }++--------------------------------------------------------------------------------++-- | SAML2 authentication statements.+data AuthnStatement = AuthnStatement {+ -- | The timestamp when the assertion was issued.+ authnStatementInstant :: !UTCTime,+ -- | The session index.+ authnStatementSessionIndex :: !T.Text,+ -- | The statement locality.+ authnStatementLocality :: !T.Text+} deriving (Eq, Show)++instance FromXML AuthnStatement where+ parseXML cursor = do + issueInstant <- parseUTCTime $ + T.concat $ attribute "AuthnInstant" cursor++ pure AuthnStatement{+ authnStatementInstant = issueInstant,+ authnStatementSessionIndex = T.concat $ + attribute "SessionIndex" cursor, + authnStatementLocality = T.concat $ + cursor $/ element (saml2Name "SubjectLocality") + >=> attribute "Address"+ }++--------------------------------------------------------------------------------++-- | SAML2 assertion attributes.+data AssertionAttribute = AssertionAttribute {+ -- | The name of the attribute.+ attributeName :: !T.Text,+ -- | A friendly attribute name, if it exists.+ attributeFriendlyName :: !(Maybe T.Text),+ -- | The name format.+ attributeNameFormat :: !T.Text,+ -- | The value of the attribute.+ attributeValue :: !T.Text+} deriving (Eq, Show)++instance FromXML AssertionAttribute where+ parseXML cursor = do + pure AssertionAttribute{+ attributeName = T.concat $ attribute "Name" cursor,+ attributeFriendlyName = + toMaybeText $ attribute "FriendlyName" cursor,+ attributeNameFormat = T.concat $ attribute "NameFormat" cursor,+ attributeValue = T.concat $ + cursor $/ element (saml2Name "AttributeValue") &/ content+ }++-- | SAML2 assertion statements (collections of assertion attributes).+type AttributeStatement = [AssertionAttribute]++-- | 'parseAttributeStatement' @cursor@ parses an 'AttributeStatement'.+parseAttributeStatement :: Cursor -> AttributeStatement+parseAttributeStatement cursor = + cursor $/ element (saml2Name "Attribute") >=> parseXML++--------------------------------------------------------------------------------++-- | Represents a SAML2 assertion.+data Assertion = Assertion {+ -- | The unique ID of this assertion. It is important to keep track of+ -- these in order to avoid replay attacks. + assertionId :: !T.Text,+ -- | The date and time when the assertion was issued.+ assertionIssued :: !UTCTime,+ -- | The name of the entity that issued this assertion.+ assertionIssuer :: !T.Text,+ -- | The subject of the assertion.+ assertionSubject :: !Subject,+ -- | The conditions under which the assertion is issued.+ assertionConditions :: !Conditions,+ -- | The authentication statement included in the assertion.+ assertionAuthnStatement :: !AuthnStatement,+ -- | The assertion's attribute statement.+ assertionAttributeStatement :: !AttributeStatement+} deriving (Eq, Show)++instance FromXML Assertion where + parseXML cursor = do + issueInstant <- parseUTCTime $ + T.concat $ attribute "IssueInstant" cursor++ subject <- oneOrFail "Subject is required" $+ cursor $/ element (saml2Name "Subject") >=> parseXML++ conditions <- oneOrFail "Conditions are required" $+ cursor $/ element (saml2Name "Conditions") >=> parseXML++ authnStatement <- oneOrFail "AuthnStatement is required" $ + cursor $/ element (saml2Name "AuthnStatement") >=> parseXML++ pure Assertion{+ assertionId = T.concat $ attribute "ID" cursor,+ assertionIssued = issueInstant,+ assertionIssuer = T.concat $ + cursor $/ element (saml2Name "Issuer") &/ content,+ assertionSubject = subject,+ assertionConditions = conditions,+ assertionAuthnStatement = authnStatement,+ assertionAttributeStatement = + cursor $/ element (saml2Name "AttributeStatement") + >=> parseAttributeStatement + }++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/C14N.hs view
@@ -0,0 +1,44 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | A high-level interface to XML canonicalisation for the purpose of +-- SAML2 signature validation.+module Network.Wai.SAML2.C14N (+ canonicalise+) where ++--------------------------------------------------------------------------------++import qualified Data.ByteString as BS++import Foreign.C.Types++import Text.XML.C14N++--------------------------------------------------------------------------------++-- | 'canonicalise' @xml@ produces a canonical representation of @xml@.+canonicalise :: BS.ByteString -> IO BS.ByteString+canonicalise xml = c14n c14nOpts c14n_exclusive_1_0 [] False Nothing xml++-- | The options we want to use for canonicalisation of XML documents.+c14nOpts :: [CInt]+c14nOpts = + [ xml_opt_noent + , xml_opt_dtdload+ , xml_opt_dtdattr+ -- disable network access+ , xml_opt_nonet+ -- compact small text nodes, this has no effect on the rendered output+ , xml_opt_compact+ -- suppress standard output; the function will still fail if+ -- something goes wrong, but the reason won't be reported+ , xml_opt_noerror+ , xml_opt_nowarning+ ]++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/Config.hs view
@@ -0,0 +1,58 @@+--------------------------------------------------------------------------------+-- 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).+ saml2AssertionPath :: !BS.ByteString,+ -- | The service provider's private key, used to decrypt data from + -- the identity provider.+ saml2PrivateKey :: !PrivateKey,+ -- | The identity provider's public key, used to validate+ -- signatures.+ saml2PublicKey :: !PublicKey,+ -- | The name of the entity we expect assertions from. If this is set+ -- to 'Nothing', the issuer name is not validated.+ saml2ExpectedIssuer :: !(Maybe T.Text),+ -- | The URL we expect the SAML2 response to contain as destination.+ 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.+ 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 privKey pubKey = SAML2Config{+ saml2AssertionPath = "/sso/assert",+ saml2PrivateKey = privKey,+ saml2PublicKey = pubKey,+ saml2ExpectedIssuer = Nothing,+ saml2ExpectedDestination = Nothing,+ saml2DisableTimeValidation = False+}++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/Error.hs view
@@ -0,0 +1,64 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | SAML2-related errors.+module Network.Wai.SAML2.Error (+ SAML2Error(..)+) where ++--------------------------------------------------------------------------------++import Control.Exception++import Crypto.Error+import Crypto.PubKey.RSA.Types as RSA++import qualified Data.Text as T++import Network.Wai.SAML2.StatusCode++--------------------------------------------------------------------------------++-- | Enumerates errors that may arise in the SAML2 middleware.+data SAML2Error + -- | The response received from the client is not valid XML.+ = InvalidResponseXml SomeException + -- | The assertion is not valid XML.+ | InvalidAssertionXml SomeException + -- | The response is not a valid SAML2 response.+ | InvalidResponse IOException + -- | The assertion is not a valid SAML2 assertion.+ | InvalidAssertion IOException+ -- | The issuer is not who we expected.+ | InvalidIssuer T.Text+ -- | The destination is not what we expected.+ | UnexpectedDestination T.Text+ -- | The reference ID is not what we expected.+ | UnexpectedReference T.Text+ -- | The response indicates a stuatus other than 'Success'.+ | Unsuccessful StatusCode+ -- | Failed to canonicalise some XML.+ | CanonicalisationFailure IOException+ -- | Unable to decrypt the AES key.+ | DecryptionFailure RSA.Error + -- | The initialisation vector for a symmetric cipher is invalid.+ | InvalidIV + -- | The padding for a blockcipher is invalid.+ | InvalidPadding + -- | The signature is incorrect.+ | InvalidSignature + -- | The digest is incorrect.+ | InvalidDigest + -- | The assertion is not valid.+ | NotValid + -- | A general crypto error occurred.+ | CryptoError CryptoError + -- | The request made to the configured endpoint is not valid.+ | InvalidRequest+ deriving Show++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/KeyInfo.hs view
@@ -0,0 +1,40 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | Types to represent keys that are contained in SAML2 responses.+module Network.Wai.SAML2.KeyInfo (+ KeyInfo(..)+) where ++--------------------------------------------------------------------------------++import qualified Data.ByteString as BS+import qualified Data.Text as T+import Data.Text.Encoding++import Text.XML.Cursor++import Network.Wai.SAML2.XML++--------------------------------------------------------------------------------++-- | Represents a key.+data KeyInfo = KeyInfo {+ -- | The key data.+ keyInfoCertificate :: BS.ByteString+} deriving (Eq, Show)++instance FromXML KeyInfo where + parseXML cursor = pure KeyInfo{+ keyInfoCertificate = + encodeUtf8 $ T.concat $ cursor+ $/ element (dsName "X509Data")+ &/ element (dsName "X509Certificate")+ &/ content+ }+ +--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/Response.hs view
@@ -0,0 +1,115 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | Types to reprsent SAML2 responses.+module Network.Wai.SAML2.Response (+ -- * SAML2 responses+ Response(..),+ removeSignature,+ extractSignedInfo,++ -- * Re-exports+ module Network.Wai.SAML2.StatusCode,+ module Network.Wai.SAML2.Signature+) where ++--------------------------------------------------------------------------------++import qualified Data.Text as T+import Data.Time++import Text.XML+import Text.XML.Cursor++import Network.Wai.SAML2.XML+import Network.Wai.SAML2.XML.Encrypted+import Network.Wai.SAML2.StatusCode+import Network.Wai.SAML2.Signature++--------------------------------------------------------------------------------++-- | Represents SAML2 responses.+data Response = Response {+ -- | The intended destination of this response.+ responseDestination :: !T.Text,+ -- | The unique ID of the response.+ responseId :: !T.Text,+ -- | The timestamp when the response was issued.+ responseIssueInstant :: !UTCTime,+ -- | The SAML version.+ responseVersion :: !T.Text,+ -- | The name of the issuer.+ responseIssuer :: !T.Text,+ -- | The status of the response.+ responseStatusCode :: !StatusCode,+ -- | The response signature.+ responseSignature :: !Signature,+ -- | The (encrypted) assertion.+ responseEncryptedAssertion :: !EncryptedAssertion+} deriving (Eq, Show)++instance FromXML Response where + parseXML cursor = do+ issueInstant <- parseUTCTime + $ T.concat + $ attribute "IssueInstant" cursor++ statusCode <- case parseXML cursor of+ Nothing -> fail "Invalid status code"+ Just sc -> pure sc++ encAssertion <- oneOrFail "EncryptedAssertion is required" + $ cursor+ $/ element (saml2Name "EncryptedAssertion")+ &/ element (xencName "EncryptedData")+ >=> parseXML++ signature <- oneOrFail "Signature is required" $+ cursor $/ element (dsName "Signature") >=> parseXML++ pure Response{+ responseDestination = T.concat $ attribute "Destination" cursor,+ responseId = T.concat $ attribute "ID" cursor,+ responseIssueInstant = issueInstant,+ responseVersion = T.concat $ attribute "Version" cursor,+ responseIssuer = T.concat $ + cursor $/ element (saml2Name "Issuer") &/ content,+ responseStatusCode = statusCode,+ responseSignature = signature,+ responseEncryptedAssertion = encAssertion+ }+ +--------------------------------------------------------------------------------++-- | Returns 'True' if the argument is not a @<Signature>@ element.+isNotSignature :: Node -> Bool +isNotSignature (NodeElement e) = elementName e /= dsName "Signature" +isNotSignature _ = True++-- | 'removeSignature' @document@ removes all @<Signature>@ elements from+-- @document@ and returns the resulting document.+removeSignature :: Document -> Document+removeSignature (Document prologue root misc) = + let Element n attr ns = root+ in Document prologue (Element n attr (filter isNotSignature ns)) misc+ +-- | Returns all nodes at @cursor@.+nodes :: Cursor -> [Node]+nodes = pure . node ++-- | 'extractSignedInfo' @cursor@ extracts the SignedInfo element from the +-- document reprsented by @cursor@.+extractSignedInfo :: MonadFail m => Cursor -> m Element+extractSignedInfo cursor = do + NodeElement signedInfo <- oneOrFail "SignedInfo is required" + $ cursor + $/ element (dsName "Signature") + &/ element (dsName "SignedInfo") + >=> nodes+ pure signedInfo++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/Signature.hs view
@@ -0,0 +1,159 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | SAML2 signatures.+module Network.Wai.SAML2.Signature (+ CanonicalisationMethod(..),+ SignatureMethod(..),+ DigestMethod(..),+ SignedInfo(..),+ Reference(..),+ Signature(..)+) where ++--------------------------------------------------------------------------------++import qualified Data.ByteString as BS+import qualified Data.Text as T +import Data.Text.Encoding++import Text.XML.Cursor++import Network.Wai.SAML2.XML++--------------------------------------------------------------------------------++-- | Enumerates XML canonicalisation methods.+data CanonicalisationMethod + -- | Original C14N 1.0 specification.+ = C14N_1_0 + -- | Exclusive C14N 1.0 specification.+ | C14N_EXC_1_0+ -- | C14N 1.1 specification.+ | C14N_1_1+ deriving (Eq, Show)++instance FromXML CanonicalisationMethod where + parseXML cursor = + case T.concat $ attribute "Algorithm" cursor of+ "http://www.w3.org/2001/10/xml-exc-c14n#" -> pure C14N_EXC_1_0+ _ -> fail "Not a valid CanonicalisationMethod"++-- | Enumerates signature methods.+data SignatureMethod + -- | RSA with SHA256 digest+ = RSA_SHA256+ deriving (Eq, Show)++instance FromXML SignatureMethod where + parseXML cursor = case T.concat $ attribute "Algorithm" cursor of+ "http://www.w3.org/2001/04/xmldsig-more#rsa-sha256" -> pure RSA_SHA256+ _ -> fail "Not a valid SignatureMethod"++--------------------------------------------------------------------------------++-- | Enumerates digest methods.+data DigestMethod+ -- | SHA256+ = DigestSHA256+ deriving (Eq, Show)++instance FromXML DigestMethod where + parseXML cursor = case T.concat $ attribute "Algorithm" cursor of+ "http://www.w3.org/2001/04/xmlenc#sha256" -> pure DigestSHA256+ _ -> fail "Not a valid DigestMethod"++-- | Represents a reference to some entity along with a digest of it.+data Reference = Reference {+ -- | The URI of the entity that is referenced.+ referenceURI :: !T.Text,+ -- | The method that was used to calculate the digest for the + -- entity that is referenced.+ referenceDigestMethod :: !DigestMethod,+ -- | The digest of the entity that was calculated by the IdP.+ referenceDigestValue :: !BS.ByteString+} deriving (Eq, Show)++instance FromXML Reference where+ parseXML cursor = do + -- the reference starts with a #, drop it+ let uri = T.drop 1 $ T.concat $ attribute "URI" cursor++ digestMethod <- oneOrFail "DigestMethod is required" $+ cursor $/ element (dsName "DigestMethod") + >=> parseXML++ let digestValue = encodeUtf8 $ T.concat $+ cursor $/ element (dsName "DigestValue") &/ content++ pure Reference{+ referenceURI = uri,+ referenceDigestMethod = digestMethod,+ referenceDigestValue = digestValue+ }++--------------------------------------------------------------------------------++-- | Represents references to some entities for which the IdP has calculated+-- digests. The 'SignedInfo' component is then signed by the IdP.+data SignedInfo = SignedInfo {+ -- | The XML canonicalisation method used.+ signedInfoCanonicalisationMethod :: !CanonicalisationMethod,+ -- | The method used to compute the signature for the referenced entity.+ signedInfoSignatureMethod :: !SignatureMethod,+ -- | The reference to some entity, along with a digest.+ signedInfoReference :: !Reference+} deriving (Eq, Show)++instance FromXML SignedInfo where + parseXML cursor = do + canonicalisationMethod <- + oneOrFail "CanonicalizationMethod is required"+ $ cursor + $/ element (dsName "CanonicalizationMethod") + >=> parseXML++ signatureMethod <- + oneOrFail "SignatureMethod is required" + $ cursor + $/ element (dsName "SignatureMethod")+ >=> parseXML++ reference <- + oneOrFail "Reference is required" + $ cursor + $/ element (dsName "Reference")+ >=> parseXML++ pure SignedInfo{+ signedInfoCanonicalisationMethod = canonicalisationMethod,+ signedInfoSignatureMethod = signatureMethod,+ signedInfoReference = reference+ }++-- | Represents response signatures.+data Signature = Signature {+ -- | Information about the data for which the IdP has computed digests.+ signatureInfo :: !SignedInfo,+ -- | The signature of the 'SignedInfo' value.+ signatureValue :: !BS.ByteString+} deriving (Eq, Show)++instance FromXML Signature where + parseXML cursor = do + info <- oneOrFail "SignedInfo is required" $ + cursor $/ element (dsName "SignedInfo") >=> parseXML++ let value = encodeUtf8 $ T.concat $+ cursor $/ element (dsName "SignatureValue") &/ content++ pure Signature{+ signatureInfo = info,+ signatureValue = value+ }++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/StatusCode.hs view
@@ -0,0 +1,43 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | SAML2 status codes.+module Network.Wai.SAML2.StatusCode (+ StatusCode(..)+) where ++--------------------------------------------------------------------------------++import Control.Monad++import qualified Data.Text as T++import Text.XML.Cursor++import Network.Wai.SAML2.XML++--------------------------------------------------------------------------------++-- | Enumerates SAML2 status codes.+data StatusCode+ -- | The response indicates success! + = Success+ deriving (Eq, Show)++instance FromXML StatusCode where + parseXML cursor = + let value = T.concat + $ cursor + $/ element (saml2pName "Status")+ &/ element (saml2pName "StatusCode") + >=> attribute "Value"+ in case value of+ "urn:oasis:names:tc:SAML:2.0:status:Success" -> pure Success+ _ -> fail "Not a valid status code."+ ++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/Validation.hs view
@@ -0,0 +1,259 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | Functions to process and validate SAML2 respones.+module Network.Wai.SAML2.Validation (+ validateResponse,+ ansiX923+) where ++--------------------------------------------------------------------------------++import Control.Exception+import Control.Monad.Except++import Crypto.Error+import Crypto.Hash+import qualified Crypto.PubKey.RSA.OAEP as OAEP+import Crypto.PubKey.RSA.PKCS15 as PKCS15+import Crypto.Cipher.AES+import Crypto.Cipher.Types++import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as BS+import qualified Data.ByteString.Lazy as LBS +import Data.Default.Class+import Data.Time++import Network.Wai.SAML2.XML.Encrypted+import Network.Wai.SAML2.Config+import Network.Wai.SAML2.Error+import Network.Wai.SAML2.XML+import Network.Wai.SAML2.C14N+import Network.Wai.SAML2.Response+import Network.Wai.SAML2.Assertion++import qualified Text.XML as XML+import qualified Text.XML.Cursor as XML++--------------------------------------------------------------------------------++-- | 'validateResponse' @cfg responseData@ validates a SAML2 response contained+-- in Base64-encoded @responseData@. +validateResponse :: SAML2Config + -> BS.ByteString + -> IO (Either SAML2Error Assertion)+validateResponse cfg responseData = runExceptT $ do + -- get the current time+ now <- liftIO $ getCurrentTime ++ -- the response data is Base64-encoded; decode it+ let resXmlDocData = BS.decodeLenient responseData++ -- try to parse the XML document; throw an exception if it is not + -- a valid XML document+ responseXmlDoc <- case XML.parseLBS def (LBS.fromStrict resXmlDocData) of + Left err -> throwError $ InvalidResponseXml err + Right responseXmlDoc -> pure responseXmlDoc++ -- try to parse the XML document into a structured SAML2 response+ resParseResult <- liftIO $ try $ + parseXML (XML.fromDocument responseXmlDoc) + + samlResponse <- case resParseResult of + Left err -> throwError $ InvalidResponse err+ Right samlResponse -> pure samlResponse ++ -- check that the response indicates success+ case responseStatusCode samlResponse of + Success -> pure ()+ status -> throwError $ Unsuccessful status++ -- check that the destination is as expected, if the configuration+ -- expects us to validate this + let destination = responseDestination samlResponse ++ case saml2ExpectedDestination cfg of + Just expectedDestination + | destination /= expectedDestination -> + throwError $ UnexpectedDestination destination+ _ -> pure ()++ -- check that the issuer is as expected, if the configuration+ -- expects us to validate this + let issuer = responseIssuer samlResponse++ case saml2ExpectedIssuer cfg of+ Just expectedIssuer+ | issuer /= expectedIssuer -> throwError $ InvalidIssuer issuer+ _ -> pure ()++ -- ***CORE VALIDATION***+ -- See https://www.w3.org/TR/xmldsig-core1/#sec-CoreValidation+ -- + -- *REFERENCE VALIDATION*+ -- 1. We extract the SignedInfo element from the SAML2 response's + -- Signature element. This element contains + signedInfo <- extractSignedInfo (XML.fromDocument responseXmlDoc)++ -- construct a new XML document from the SignedInfo element and render+ -- it into a textual representation+ let doc = XML.Document (XML.Prologue [] Nothing []) signedInfo []+ let signedInfoXml = XML.renderLBS def doc++ -- canonicalise the textual representation of the SignedInfo element+ signedInfoCanonResult <- liftIO $ try $ + canonicalise (LBS.toStrict signedInfoXml)++ normalisedSignedInfo <- case signedInfoCanonResult of + Left err -> throwError $ CanonicalisationFailure err+ Right result -> pure result ++ -- 2. At this point we should dereference all elements identified by+ -- Reference elements inside the SignedInfo element. However, we do+ -- not currently do that and instead just assume that there is only+ -- one Reference element which targets the overall Response. + -- We sanity check this, just in case we are wrong since we do not+ -- want an attacker to be able to exploit this.+ let documentId = responseId samlResponse+ let referenceId = referenceURI+ $ signedInfoReference+ $ signatureInfo+ $ responseSignature samlResponse++ if documentId /= referenceId + then throwError $ UnexpectedReference referenceId+ else pure ()++ -- Now that we have sanity checked that we should indeed validate+ -- the entire Response, we need to remove the Signature element+ -- from it (since the Response cannot possibly have been hashed with + -- the Signature element present). First remove the Signature element:+ let docMinusSignature = removeSignature responseXmlDoc++ -- then render the resulting document and canonicalise it+ let renderedXml = XML.renderLBS def docMinusSignature+ refCanonResult <- liftIO $ try $ canonicalise (LBS.toStrict renderedXml)++ normalised <- case refCanonResult of + Left err -> throwError $ CanonicalisationFailure err+ Right result -> pure result ++ -- next, compute the hash for the normalised document and extract the+ -- existing hash from the response; both hash values must be the same+ -- or the response has been tampered with; if both hashes are the same,+ -- then the response has not been tampered with, assuming that the+ -- Signature has not been tampered with, which we validate next+ let documentHash = hashWith SHA256 normalised+ let referenceHash = digestFromByteString + $ BS.decodeLenient + $ referenceDigestValue + $ signedInfoReference + $ signatureInfo + $ responseSignature samlResponse++ if Just documentHash /= referenceHash + then throwError InvalidDigest+ else pure ()++ -- *SIGNATURE VALIDATION*+ -- We need to check that the SignedInfo element has not been tampered + -- with, which we do by checking the signature contained in the response;+ -- first: extract the signature data from the response+ let sig = BS.decodeLenient $ signatureValue $ responseSignature samlResponse++ -- using the IdP's public key and the canonicalised SignedInfo element,+ -- check that the signature is correct+ let pubKey = saml2PublicKey cfg++ if PKCS15.verify (Just SHA256) pubKey normalisedSignedInfo sig + then pure ()+ else throwError InvalidSignature ++ -- ***ASSERTION DECRYPTION***+ -- the SAML assertion is AES-encrypted and we need to acquire the key+ -- to decrypt it; the key itself is RSA-encrypted:+ -- get the private key from the configuration and use it to decrypt+ -- the key used to decrypt the assertion+ let pk = saml2PrivateKey cfg+ let encryptedAssertion = responseEncryptedAssertion samlResponse+ + oaepResult <- liftIO $ OAEP.decryptSafer (OAEP.defaultOAEPParams SHA1) pk + $ BS.decodeLenient + $ cipherValue + $ encryptedKeyCipher + $ encryptedAssertionKey + $ encryptedAssertion++ aesKey <- case oaepResult of + Left err -> throwError $ DecryptionFailure err+ Right cipherData -> pure cipherData++ -- next we can decrypt the assertion; initialise AES128 with + -- the key we have just decrypted+ xmlData <- case cipherInit aesKey of + CryptoFailed err -> throwError $ CryptoError err + CryptoPassed aes128 -> do+ -- get the AES ciphertext+ let cipherText = BS.decodeLenient + $ cipherValue + $ encryptedAssertionCipher + $ encryptedAssertion++ -- the IV used for AES is 128bits (16 bytes) prepended+ -- to the ciphertext+ let (ivBytes, xmlBytes) = BS.splitAt 16 cipherText++ -- convert the bytes into the IV+ case makeIV ivBytes of + Nothing -> throwError InvalidIV+ Just iv -> do+ -- run AES to decrypt the assertion+ let plaintext = cbcDecrypt (aes128 :: AES128) iv xmlBytes++ -- remove padding from the plaintext+ case ansiX923 plaintext of + Nothing -> throwError InvalidPadding+ Just xmlData -> pure xmlData++ -- try to parse the assertion that we decrypted earlier+ assertion <- case XML.parseLBS def (LBS.fromStrict xmlData) of + Left err -> throwError $ InvalidAssertionXml err + Right assertDoc -> do+ -- try to convert the assertion document into a more+ -- structured representation+ assertParseResult <- liftIO $ try $ + parseXML (XML.fromDocument assertDoc)++ case assertParseResult of + Left err -> throwError $ InvalidAssertion err+ Right assertion -> pure assertion ++ -- validate that the assertion is valid at this point in time+ let Conditions{..} = assertionConditions assertion++ if (now < conditionsNotBefore || now >= conditionsNotOnOrAfter) &&+ not (saml2DisableTimeValidation cfg)+ then throwError NotValid+ else pure ()++ -- all checks out, return the assertion+ pure assertion++-- | 'ansiX923' @plaintext@ removes ANSI X9.23 padding from @plaintext@. +-- See https://en.wikipedia.org/wiki/Padding_(cryptography)#ANSI_X9.23+ansiX923 :: BS.ByteString -> Maybe BS.ByteString +ansiX923 d+ | len == 0 = Nothing + | padLen < 1 || padLen > len = Nothing+ | otherwise = Just content+ where len = BS.length d + padBytes = BS.index d (len-1)+ padLen = fromIntegral padBytes+ (content,_) = BS.splitAt (len - padLen) d++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/XML.hs view
@@ -0,0 +1,85 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | Utility functions related to XML parsing.+module Network.Wai.SAML2.XML (+ -- * Namespaces+ saml2Name,+ saml2pName,+ xencName,+ dsName,++ -- * Utility functions+ toMaybeText,+ parseUTCTime,++ -- * XML parsing+ FromXML(..),+ oneOrFail+) where ++--------------------------------------------------------------------------------++import qualified Data.Text as T+import Data.Time++import Text.XML+import Text.XML.Cursor++-------------------------------------------------------------------------------- ++-- | 'saml2Name' @name@ constructs a 'Name' for @name@ in the +-- urn:oasis:names:tc:SAML:2.0:assertion namespace.+saml2Name :: T.Text -> Name +saml2Name name = + Name name (Just "urn:oasis:names:tc:SAML:2.0:assertion") (Just "saml2")++-- | 'saml2pName' @name@ constructs a 'Name' for @name@ in the +-- urn:oasis:names:tc:SAML:2.0:protocol namespace.+saml2pName :: T.Text -> Name +saml2pName name =+ Name name (Just "urn:oasis:names:tc:SAML:2.0:protocol") (Just "saml2p")++-- | 'xencName' @name@ constructs a 'Name' for @name@ in the +-- http://www.w3.org/2001/04/xmlenc# namespace.+xencName :: T.Text -> Name +xencName name =+ Name name (Just "http://www.w3.org/2001/04/xmlenc#") (Just "xenc")++-- | 'dsName' @name@ constructs a 'Name' for @name@ in the +-- http://www.w3.org/2000/09/xmldsig# namespace.+dsName :: T.Text -> Name +dsName name =+ Name name (Just "http://www.w3.org/2000/09/xmldsig#") (Just "ds")++-- | 'toMaybeText' @xs@ returns 'Nothing' if @xs@ is the empty list, or +-- the result of concatenating @xs@ wrapped in 'Just' otherwise.+toMaybeText :: [T.Text] -> Maybe T.Text+toMaybeText [] = Nothing +toMaybeText xs = Just $ T.concat xs++-- | The time format used by SAML2.+timeFormat :: String +timeFormat = "%Y-%m-%dT%H:%M:%S%QZ"++-- | 'parseUTCTime' @text@ parses @text@ into a 'UTCTime' value.+parseUTCTime :: MonadFail m => T.Text -> m UTCTime+parseUTCTime value = + parseTimeM False defaultTimeLocale timeFormat (T.unpack value) ++-- | A class of types which can be parsed from XML.+class FromXML a where + parseXML :: MonadFail m => Cursor -> m a++-- | 'oneOrFail' @message xs@ throws an 'XMLException' with @message@ if +-- @xs@ is the empty list. If @xs@ has at least one element, the first is+-- returned and all others are discarded.+oneOrFail :: MonadFail m => String -> [a] -> m a+oneOrFail err [] = fail err+oneOrFail _ (x:_) = pure x++--------------------------------------------------------------------------------
+ src/Network/Wai/SAML2/XML/Encrypted.hs view
@@ -0,0 +1,138 @@+--------------------------------------------------------------------------------+-- 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. --+--------------------------------------------------------------------------------++-- | Types representing elements of the encrypted XML standard.+-- See https://www.w3.org/TR/2002/REC-xmlenc-core-20021210/Overview.html+module Network.Wai.SAML2.XML.Encrypted (+ CipherData(..),+ EncryptionMethod(..),+ EncryptedKey(..),+ EncryptedAssertion(..)+) where ++--------------------------------------------------------------------------------++import qualified Data.Text as T+import Data.Text.Encoding+import qualified Data.ByteString as BS++import Text.XML.Cursor++import Network.Wai.SAML2.XML+import Network.Wai.SAML2.KeyInfo++--------------------------------------------------------------------------------++-- | Represents some ciphertext.+data CipherData = CipherData {+ cipherValue :: !BS.ByteString+} deriving (Eq, Show)++instance FromXML CipherData where + parseXML cursor = pure CipherData{+ cipherValue = encodeUtf8+ $ T.concat + $ cursor + $/ element (xencName "CipherValue")+ &/ content+ }++--------------------------------------------------------------------------------++-- | Describes an encryption method.+data EncryptionMethod = EncryptionMethod {+ -- | The name of the algorithm.+ encryptionMethodAlgorithm :: !T.Text,+ -- | The name of the digest algorithm, if any.+ encryptionMethodDigestAlgorithm :: !(Maybe T.Text)+} deriving (Eq, Show)++instance FromXML EncryptionMethod where + parseXML cursor = pure EncryptionMethod{+ encryptionMethodAlgorithm = + T.concat $ attribute "Algorithm" cursor,+ encryptionMethodDigestAlgorithm = + toMaybeText $ cursor + $/ element (dsName "DigestMethod") + >=> attribute "Algorithm"+ } ++--------------------------------------------------------------------------------++-- | Represents an encrypted key.+data EncryptedKey = EncryptedKey {+ -- | The ID of the key.+ encryptedKeyId :: !T.Text,+ -- | The intended recipient of the key.+ encryptedKeyRecipient :: !T.Text,+ -- | The method used to encrypt the key.+ encryptedKeyMethod :: !EncryptionMethod,+ -- | The key data.+ encryptedKeyData :: !KeyInfo,+ -- | The ciphertext.+ encryptedKeyCipher :: !CipherData+} deriving (Eq, Show)++instance FromXML EncryptedKey where + parseXML cursor = do+ method <- oneOrFail "EncryptionMethod is required" $+ cursor $/ element (xencName "EncryptionMethod") + >=> parseXML++ keyData <- oneOrFail "KeyInfo is required" $+ cursor $/ element (dsName "KeyInfo") + >=> parseXML++ cipher <- oneOrFail "CipherData is required" $+ cursor $/ element (xencName "CipherData")+ >=> parseXML+ + pure EncryptedKey{+ encryptedKeyId = T.concat $ attribute "Id" cursor,+ encryptedKeyRecipient = T.concat $ attribute "Recipient" cursor,+ encryptedKeyMethod = method,+ encryptedKeyData = keyData,+ encryptedKeyCipher = cipher+ }++--------------------------------------------------------------------------------++-- | Represents an encrypted SAML assertion.+data EncryptedAssertion = EncryptedAssertion {+ -- | Information about the encryption method used.+ encryptedAssertionAlgorithm :: !EncryptionMethod,+ -- | The encrypted key.+ encryptedAssertionKey :: !EncryptedKey,+ -- | The ciphertext.+ encryptedAssertionCipher :: !CipherData+} deriving (Eq, Show)++instance FromXML EncryptedAssertion where + parseXML cursor = do+ algorithm <- oneOrFail "Algorithm is required" + $ cursor + $/ element (xencName "EncryptionMethod")+ >=> parseXML ++ keyInfo <- oneOrFail "KeyInfo is required" + $ cursor + $/ element (dsName "KeyInfo") + &/ element (xencName "EncryptedKey") + >=> parseXML++ cipher <- oneOrFail "CipherData is required" + $ cursor + $/ element (xencName "CipherData")+ >=> parseXML ++ pure EncryptedAssertion{+ encryptedAssertionAlgorithm = algorithm,+ encryptedAssertionKey = keyInfo,+ encryptedAssertionCipher = cipher+ }++--------------------------------------------------------------------------------
+ wai-saml2.cabal view
@@ -0,0 +1,66 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0.+--+-- see: https://github.com/sol/hpack+--+-- hash: c0664fef77f28dfe3a12d2dfaff84d77d236c7b0b2641d4da57a4889dce066f1++name: wai-saml2+version: 0.1.0.0+synopsis: SAML2 assertion validation as WAI middleware+description: A Haskell library which implements SAML2 assertion validation as WAI middleware+category: Security+homepage: https://github.com/mbg/wai-saml2#readme+bug-reports: https://github.com/mbg/wai-saml2/issues+author: Michael B. Gale+maintainer: m.gale@warwick.ac.uk+copyright: Copyright (c) Michael B. Gale+license: MIT+license-file: LICENSE+build-type: Simple+extra-source-files:+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/mbg/wai-saml2++library+ exposed-modules:+ Network.Wai.SAML2+ Network.Wai.SAML2.Assertion+ Network.Wai.SAML2.C14N+ Network.Wai.SAML2.Config+ Network.Wai.SAML2.Error+ Network.Wai.SAML2.KeyInfo+ Network.Wai.SAML2.Response+ Network.Wai.SAML2.Signature+ Network.Wai.SAML2.StatusCode+ Network.Wai.SAML2.Validation+ Network.Wai.SAML2.XML+ Network.Wai.SAML2.XML.Encrypted+ other-modules:+ Paths_wai_saml2+ hs-source-dirs:+ src+ default-extensions: OverloadedStrings MultiWayIf RecordWildCards FlexibleInstances+ ghc-options: -W+ build-depends:+ base >=4.8 && <5+ , base64-bytestring >=0.1 && <2+ , bytestring >=0.9 && <0.11+ , c14n >=0.1.0.1 && <1+ , cryptonite <1+ , data-default-class <1+ , http-types <1+ , mtl >=2.2.1 && <3+ , text <2+ , time >=1.9 && <2+ , vault >=0.3 && <1+ , wai >=3.0 && <4+ , wai-extra >=3.0 && <4+ , x509 <2+ , x509-store <2+ , xml-conduit <2+ default-language: Haskell2010