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

instance FromXML CipherData where 
    parseXML :: Cursor -> m CipherData
parseXML Cursor
cursor = CipherData -> m CipherData
forall (f :: * -> *) a. Applicative f => a -> f a
pure CipherData :: ByteString -> CipherData
CipherData{
        cipherValue :: ByteString
cipherValue = 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
xencName Text
"CipherValue")
                    Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    }

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

-- | Describes an encryption method.
data EncryptionMethod = EncryptionMethod {
    -- | The name of the algorithm.
    EncryptionMethod -> Text
encryptionMethodAlgorithm :: !T.Text,
    -- | The name of the digest algorithm, if any.
    EncryptionMethod -> Maybe Text
encryptionMethodDigestAlgorithm :: !(Maybe T.Text)
} deriving (EncryptionMethod -> EncryptionMethod -> Bool
(EncryptionMethod -> EncryptionMethod -> Bool)
-> (EncryptionMethod -> EncryptionMethod -> Bool)
-> Eq EncryptionMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptionMethod -> EncryptionMethod -> Bool
$c/= :: EncryptionMethod -> EncryptionMethod -> Bool
== :: EncryptionMethod -> EncryptionMethod -> Bool
$c== :: EncryptionMethod -> EncryptionMethod -> Bool
Eq, Int -> EncryptionMethod -> ShowS
[EncryptionMethod] -> ShowS
EncryptionMethod -> String
(Int -> EncryptionMethod -> ShowS)
-> (EncryptionMethod -> String)
-> ([EncryptionMethod] -> ShowS)
-> Show EncryptionMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptionMethod] -> ShowS
$cshowList :: [EncryptionMethod] -> ShowS
show :: EncryptionMethod -> String
$cshow :: EncryptionMethod -> String
showsPrec :: Int -> EncryptionMethod -> ShowS
$cshowsPrec :: Int -> EncryptionMethod -> ShowS
Show)

instance FromXML EncryptionMethod where 
    parseXML :: Cursor -> m EncryptionMethod
parseXML Cursor
cursor = EncryptionMethod -> m EncryptionMethod
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncryptionMethod :: Text -> Maybe Text -> EncryptionMethod
EncryptionMethod{
        encryptionMethodAlgorithm :: Text
encryptionMethodAlgorithm = 
            [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"Algorithm" Cursor
cursor,
        encryptionMethodDigestAlgorithm :: Maybe Text
encryptionMethodDigestAlgorithm = 
            [Text] -> Maybe Text
toMaybeText ([Text] -> Maybe Text) -> [Text] -> Maybe 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
"DigestMethod") 
                       Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Name -> Cursor -> [Text]
attribute Name
"Algorithm"
    } 

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

-- | Represents an encrypted key.
data EncryptedKey = EncryptedKey {
    -- | The ID of the key.
    EncryptedKey -> Text
encryptedKeyId :: !T.Text,
    -- | The intended recipient of the key.
    EncryptedKey -> Text
encryptedKeyRecipient :: !T.Text,
    -- | The method used to encrypt the key.
    EncryptedKey -> EncryptionMethod
encryptedKeyMethod :: !EncryptionMethod,
    -- | The key data.
    EncryptedKey -> KeyInfo
encryptedKeyData :: !KeyInfo,
    -- | The ciphertext.
    EncryptedKey -> CipherData
encryptedKeyCipher :: !CipherData
} deriving (EncryptedKey -> EncryptedKey -> Bool
(EncryptedKey -> EncryptedKey -> Bool)
-> (EncryptedKey -> EncryptedKey -> Bool) -> Eq EncryptedKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptedKey -> EncryptedKey -> Bool
$c/= :: EncryptedKey -> EncryptedKey -> Bool
== :: EncryptedKey -> EncryptedKey -> Bool
$c== :: EncryptedKey -> EncryptedKey -> Bool
Eq, Int -> EncryptedKey -> ShowS
[EncryptedKey] -> ShowS
EncryptedKey -> String
(Int -> EncryptedKey -> ShowS)
-> (EncryptedKey -> String)
-> ([EncryptedKey] -> ShowS)
-> Show EncryptedKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptedKey] -> ShowS
$cshowList :: [EncryptedKey] -> ShowS
show :: EncryptedKey -> String
$cshow :: EncryptedKey -> String
showsPrec :: Int -> EncryptedKey -> ShowS
$cshowsPrec :: Int -> EncryptedKey -> ShowS
Show)

instance FromXML EncryptedKey where 
    parseXML :: Cursor -> m EncryptedKey
parseXML Cursor
cursor =  do
        EncryptionMethod
method <- String -> [EncryptionMethod] -> m EncryptionMethod
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"EncryptionMethod is required" ([EncryptionMethod] -> m EncryptionMethod)
-> [EncryptionMethod] -> m EncryptionMethod
forall a b. (a -> b) -> a -> b
$
            Cursor
cursor Cursor -> (Cursor -> [EncryptionMethod]) -> [EncryptionMethod]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xencName Text
"EncryptionMethod") 
                Axis
-> (Cursor -> [EncryptionMethod]) -> Cursor -> [EncryptionMethod]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [EncryptionMethod]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

        KeyInfo
keyData <- String -> [KeyInfo] -> m KeyInfo
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"KeyInfo is required" ([KeyInfo] -> m KeyInfo) -> [KeyInfo] -> m KeyInfo
forall a b. (a -> b) -> a -> b
$
            Cursor
cursor Cursor -> (Cursor -> [KeyInfo]) -> [KeyInfo]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
dsName Text
"KeyInfo") 
                Axis -> (Cursor -> [KeyInfo]) -> Cursor -> [KeyInfo]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [KeyInfo]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

        CipherData
cipher <- String -> [CipherData] -> m CipherData
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"CipherData is required" ([CipherData] -> m CipherData) -> [CipherData] -> m CipherData
forall a b. (a -> b) -> a -> b
$
            Cursor
cursor Cursor -> (Cursor -> [CipherData]) -> [CipherData]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element (Text -> Name
xencName Text
"CipherData")
                Axis -> (Cursor -> [CipherData]) -> Cursor -> [CipherData]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [CipherData]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML
        
        EncryptedKey -> m EncryptedKey
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncryptedKey :: Text
-> Text
-> EncryptionMethod
-> KeyInfo
-> CipherData
-> EncryptedKey
EncryptedKey{
            encryptedKeyId :: Text
encryptedKeyId = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"Id" Cursor
cursor,
            encryptedKeyRecipient :: Text
encryptedKeyRecipient = [Text] -> Text
T.concat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Name -> Cursor -> [Text]
attribute Name
"Recipient" Cursor
cursor,
            encryptedKeyMethod :: EncryptionMethod
encryptedKeyMethod = EncryptionMethod
method,
            encryptedKeyData :: KeyInfo
encryptedKeyData = KeyInfo
keyData,
            encryptedKeyCipher :: CipherData
encryptedKeyCipher = CipherData
cipher
        }

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

-- | Represents an encrypted SAML assertion.
data EncryptedAssertion = EncryptedAssertion {
    -- | Information about the encryption method used.
    EncryptedAssertion -> EncryptionMethod
encryptedAssertionAlgorithm :: !EncryptionMethod,
    -- | The encrypted key.
    EncryptedAssertion -> EncryptedKey
encryptedAssertionKey :: !EncryptedKey,
    -- | The ciphertext.
    EncryptedAssertion -> CipherData
encryptedAssertionCipher :: !CipherData
} deriving (EncryptedAssertion -> EncryptedAssertion -> Bool
(EncryptedAssertion -> EncryptedAssertion -> Bool)
-> (EncryptedAssertion -> EncryptedAssertion -> Bool)
-> Eq EncryptedAssertion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EncryptedAssertion -> EncryptedAssertion -> Bool
$c/= :: EncryptedAssertion -> EncryptedAssertion -> Bool
== :: EncryptedAssertion -> EncryptedAssertion -> Bool
$c== :: EncryptedAssertion -> EncryptedAssertion -> Bool
Eq, Int -> EncryptedAssertion -> ShowS
[EncryptedAssertion] -> ShowS
EncryptedAssertion -> String
(Int -> EncryptedAssertion -> ShowS)
-> (EncryptedAssertion -> String)
-> ([EncryptedAssertion] -> ShowS)
-> Show EncryptedAssertion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EncryptedAssertion] -> ShowS
$cshowList :: [EncryptedAssertion] -> ShowS
show :: EncryptedAssertion -> String
$cshow :: EncryptedAssertion -> String
showsPrec :: Int -> EncryptedAssertion -> ShowS
$cshowsPrec :: Int -> EncryptedAssertion -> ShowS
Show)

instance FromXML EncryptedAssertion where 
    parseXML :: Cursor -> m EncryptedAssertion
parseXML Cursor
cursor = do
        EncryptionMethod
algorithm <- String -> [EncryptionMethod] -> m EncryptionMethod
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"Algorithm is required" 
                 ([EncryptionMethod] -> m EncryptionMethod)
-> [EncryptionMethod] -> m EncryptionMethod
forall a b. (a -> b) -> a -> b
$   Cursor
cursor 
                 Cursor -> (Cursor -> [EncryptionMethod]) -> [EncryptionMethod]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/  Name -> Axis
element (Text -> Name
xencName Text
"EncryptionMethod")
                 Axis
-> (Cursor -> [EncryptionMethod]) -> Cursor -> [EncryptionMethod]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [EncryptionMethod]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML  

        EncryptedKey
keyInfo <- String -> [EncryptedKey] -> m EncryptedKey
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"KeyInfo is required" 
               ([EncryptedKey] -> m EncryptedKey)
-> [EncryptedKey] -> m EncryptedKey
forall a b. (a -> b) -> a -> b
$   Cursor
cursor 
               Cursor -> (Cursor -> [EncryptedKey]) -> [EncryptedKey]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/  Name -> Axis
element (Text -> Name
dsName Text
"KeyInfo") 
               Axis -> (Cursor -> [EncryptedKey]) -> Cursor -> [EncryptedKey]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/  Name -> Axis
element (Text -> Name
xencName Text
"EncryptedKey") 
               Axis -> (Cursor -> [EncryptedKey]) -> Cursor -> [EncryptedKey]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [EncryptedKey]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML

        CipherData
cipher <- String -> [CipherData] -> m CipherData
forall (m :: * -> *) a. MonadFail m => String -> [a] -> m a
oneOrFail String
"CipherData is required" 
               ([CipherData] -> m CipherData) -> [CipherData] -> m CipherData
forall a b. (a -> b) -> a -> b
$  Cursor
cursor 
              Cursor -> (Cursor -> [CipherData]) -> [CipherData]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/  Name -> Axis
element (Text -> Name
xencName Text
"CipherData")
              Axis -> (Cursor -> [CipherData]) -> Cursor -> [CipherData]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [CipherData]
forall a (m :: * -> *). (FromXML a, MonadFail m) => Cursor -> m a
parseXML 

        EncryptedAssertion -> m EncryptedAssertion
forall (f :: * -> *) a. Applicative f => a -> f a
pure EncryptedAssertion :: EncryptionMethod
-> EncryptedKey -> CipherData -> EncryptedAssertion
EncryptedAssertion{
            encryptedAssertionAlgorithm :: EncryptionMethod
encryptedAssertionAlgorithm = EncryptionMethod
algorithm,
            encryptedAssertionKey :: EncryptedKey
encryptedAssertionKey = EncryptedKey
keyInfo,
            encryptedAssertionCipher :: CipherData
encryptedAssertionCipher = CipherData
cipher
        }

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