{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- |
-- Module      : Text.XRDS
-- Copyright   : (c) Trevor Elliott, 2008
-- License     : BSD3
--
-- Maintainer  : Trevor Elliott <trevor@geekgateway.com>
-- Stability   :
-- Portability :
--

module OpenId2.XRDS (
    -- * Types
    XRDS
  , Service(..)

    -- * Parsing
  , parseXRDS
  ) where

-- Libraries
import Control.Monad ((>=>))
import Data.Maybe (listToMaybe)
import Text.XML (parseLBS, def)
import Text.XML.Cursor (fromDocument, element, content, ($/), (&|), Cursor, (&/), attribute)
import qualified Data.ByteString.Lazy as L
import Data.Text (Text)
import qualified Data.Text.Read

-- Types -----------------------------------------------------------------------

type XRDS = [XRD]

type XRD = [Service]

data Service = Service
  { Service -> [Text]
serviceTypes      :: [Text]
  , Service -> [Text]
serviceMediaTypes :: [Text]
  , Service -> [Text]
serviceURIs       :: [Text]
  , Service -> [Text]
serviceLocalIDs   :: [Text]
  , Service -> Maybe Int
servicePriority   :: Maybe Int
  } deriving Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
(Int -> Service -> ShowS)
-> (Service -> String) -> ([Service] -> ShowS) -> Show Service
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Service] -> ShowS
$cshowList :: [Service] -> ShowS
show :: Service -> String
$cshow :: Service -> String
showsPrec :: Int -> Service -> ShowS
$cshowsPrec :: Int -> Service -> ShowS
Show

parseXRDS :: L.ByteString -> Maybe XRDS
parseXRDS :: ByteString -> Maybe XRDS
parseXRDS ByteString
str =
    (SomeException -> Maybe XRDS)
-> (Document -> Maybe XRDS)
-> Either SomeException Document
-> Maybe XRDS
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
        (Maybe XRDS -> SomeException -> Maybe XRDS
forall a b. a -> b -> a
const Maybe XRDS
forall a. Maybe a
Nothing)
        (XRDS -> Maybe XRDS
forall a. a -> Maybe a
Just (XRDS -> Maybe XRDS)
-> (Document -> XRDS) -> Document -> Maybe XRDS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor -> XRDS
parseXRDS' (Cursor -> XRDS) -> (Document -> Cursor) -> Document -> XRDS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Cursor
fromDocument)
        (ParseSettings -> ByteString -> Either SomeException Document
parseLBS ParseSettings
forall a. Default a => a
def ByteString
str)

parseXRDS' :: Cursor -> [[Service]]
parseXRDS' :: Cursor -> XRDS
parseXRDS' = Name -> Axis
element Name
"{xri://$xrds}XRDS" Axis -> (Cursor -> XRDS) -> Cursor -> XRDS
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/
             Name -> Axis
element Name
"{xri://$xrd*($v*2.0)}XRD" Axis -> (Cursor -> [Service]) -> Cursor -> XRDS
forall node a b.
(Cursor node -> [a]) -> (a -> b) -> Cursor node -> [b]
&|
             Cursor -> [Service]
parseXRD

parseXRD :: Cursor -> [Service]
parseXRD :: Cursor -> [Service]
parseXRD Cursor
c = Cursor
c Cursor -> (Cursor -> [Service]) -> [Service]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
"{xri://$xrd*($v*2.0)}Service" Axis -> (Cursor -> [Service]) -> Cursor -> [Service]
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Cursor -> [Service]
parseService

parseService :: Cursor -> [Service]
parseService :: Cursor -> [Service]
parseService Cursor
c =
    if [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
types then [] else [Service :: [Text] -> [Text] -> [Text] -> [Text] -> Maybe Int -> Service
Service
        { serviceTypes :: [Text]
serviceTypes = [Text]
types
        , serviceMediaTypes :: [Text]
serviceMediaTypes = [Text]
mtypes
        , serviceURIs :: [Text]
serviceURIs = [Text]
uris
        , serviceLocalIDs :: [Text]
serviceLocalIDs = [Text]
localids
        , servicePriority :: Maybe Int
servicePriority = [Text] -> Maybe Text
forall a. [a] -> Maybe a
listToMaybe (Name -> Cursor -> [Text]
attribute Name
"priority" Cursor
c) Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Maybe Int
forall a. Integral a => Text -> Maybe a
readMaybe
        }]
  where
    types :: [Text]
types = Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
"{xri://$xrd*($v*2.0)}Type" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    mtypes :: [Text]
mtypes = Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
"{xri://$xrd*($v*2.0)}MediaType" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    uris :: [Text]
uris = Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
"{xri://$xrd*($v*2.0)}URI" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    localids :: [Text]
localids = Cursor
c Cursor -> (Cursor -> [Text]) -> [Text]
forall node a. Cursor node -> (Cursor node -> [a]) -> [a]
$/ Name -> Axis
element Name
"{xri://$xrd*($v*2.0)}LocalID" Axis -> (Cursor -> [Text]) -> Cursor -> [Text]
forall node a.
Axis node -> (Cursor node -> [a]) -> Cursor node -> [a]
&/ Cursor -> [Text]
content
    readMaybe :: Text -> Maybe a
readMaybe Text
t =
        case Reader a -> Reader a
forall a. Num a => Reader a -> Reader a
Data.Text.Read.signed Reader a
forall a. Integral a => Reader a
Data.Text.Read.decimal Text
t of
            Right (a
i, Text
"") -> a -> Maybe a
forall a. a -> Maybe a
Just a
i
            Either String (a, Text)
_ -> Maybe a
forall a. Maybe a
Nothing