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

instance FromXML StatusCode where 
    parseXML :: Cursor -> m StatusCode
parseXML Cursor
cursor =  
        let value :: Text
value = [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
saml2pName Text
"Status")
                Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/  Name -> Axis
element (Text -> Name
saml2pName Text
"StatusCode") 
                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
"Value"
        in case Text
value of
            Text
"urn:oasis:names:tc:SAML:2.0:status:Success" -> StatusCode -> m StatusCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure StatusCode
Success
            Text
_ -> String -> m StatusCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Not a valid status code."
    

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