--------------------------------------------------------------------------------
-- 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.
    KeyInfo -> ByteString
keyInfoCertificate :: BS.ByteString
} deriving (KeyInfo -> KeyInfo -> Bool
(KeyInfo -> KeyInfo -> Bool)
-> (KeyInfo -> KeyInfo -> Bool) -> Eq KeyInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: KeyInfo -> KeyInfo -> Bool
$c/= :: KeyInfo -> KeyInfo -> Bool
== :: KeyInfo -> KeyInfo -> Bool
$c== :: KeyInfo -> KeyInfo -> Bool
Eq, Int -> KeyInfo -> ShowS
[KeyInfo] -> ShowS
KeyInfo -> String
(Int -> KeyInfo -> ShowS)
-> (KeyInfo -> String) -> ([KeyInfo] -> ShowS) -> Show KeyInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [KeyInfo] -> ShowS
$cshowList :: [KeyInfo] -> ShowS
show :: KeyInfo -> String
$cshow :: KeyInfo -> String
showsPrec :: Int -> KeyInfo -> ShowS
$cshowsPrec :: Int -> KeyInfo -> ShowS
Show)

instance FromXML KeyInfo where 
    parseXML :: Cursor -> m KeyInfo
parseXML Cursor
cursor = KeyInfo -> m KeyInfo
forall (f :: * -> *) a. Applicative f => a -> f a
pure KeyInfo :: ByteString -> KeyInfo
KeyInfo{
        keyInfoCertificate :: ByteString
keyInfoCertificate = 
            Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Cursor
cursor
                      Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
dsName Text
"X509Data")
                      Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Name -> Axis
element (Text -> Name
dsName Text
"X509Certificate")
                      Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    }
    
--------------------------------------------------------------------------------