diff --git a/Web/Authenticate/Facebook.hs b/Web/Authenticate/Facebook.hs index 3571401d..b0945ff6 100644 --- a/Web/Authenticate/Facebook.hs +++ b/Web/Authenticate/Facebook.hs @@ -4,14 +4,13 @@ module Web.Authenticate.Facebook where import Network.HTTP.Enumerator import Data.List (intercalate) -import Data.Object -import Data.Object.Json +import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as L8 -import qualified Data.ByteString.Lazy as L -import qualified Data.ByteString as S import Web.Authenticate.Internal (qsEncode) import Data.Data (Data) import Data.Typeable (Typeable) +import Control.Exception (Exception, throwIO) +import Data.Attoparsec.Lazy (parse, eitherResult) data Facebook = Facebook { facebookClientId :: String @@ -63,8 +62,15 @@ graphUrl (AccessToken s) func = concat , s ] -getGraphData :: AccessToken -> String -> IO StringObject +getGraphData :: AccessToken -> String -> IO (Either String Value) getGraphData at func = do let url = graphUrl at func b <- simpleHttp url - decode $ S.concat $ L.toChunks b + return $ eitherResult $ parse json b + +getGraphData' :: AccessToken -> String -> IO Value +getGraphData' a b = getGraphData a b >>= either (throwIO . InvalidJsonException) return + +data InvalidJsonException = InvalidJsonException String + deriving (Show, Typeable) +instance Exception InvalidJsonException diff --git a/Web/Authenticate/Rpxnow.hs b/Web/Authenticate/Rpxnow.hs index c60f235a..7ce7e018 100644 --- a/Web/Authenticate/Rpxnow.hs +++ b/Web/Authenticate/Rpxnow.hs @@ -22,8 +22,7 @@ module Web.Authenticate.Rpxnow , AuthenticateException (..) ) where -import Data.Object -import Data.Object.Json +import Data.Aeson import Network.HTTP.Enumerator import "transformers" Control.Monad.IO.Class import Control.Failure @@ -35,20 +34,22 @@ import Control.Exception (throwIO) import Web.Authenticate.Internal import Data.Data (Data) import Data.Typeable (Typeable) +import Data.Attoparsec.Lazy (parse) +import qualified Data.Attoparsec.Lazy as AT +import Data.Text (Text) +import qualified Data.Aeson.Types -- | Information received from Rpxnow after a valid login. data Identifier = Identifier - { identifier :: String - , extraData :: [(String, String)] + { identifier :: Text + , extraData :: [(Text, Text)] } deriving (Eq, Ord, Read, Show, Data, Typeable) -- | Attempt to log a user in. authenticate :: (MonadIO m, Failure HttpException m, - Failure AuthenticateException m, - Failure ObjectExtractError m, - Failure JsonDecodeError m) + Failure AuthenticateException m) => String -- ^ API key given by RPXNOW. -> String -- ^ Token passed by client. -> m Identifier @@ -76,21 +77,32 @@ authenticate apiKey token = do let b = responseBody res unless (200 <= statusCode res && statusCode res < 300) $ liftIO $ throwIO $ StatusCodeException (statusCode res) b - o <- decode $ S.concat $ L.toChunks b - m <- fromMapping o - stat <- lookupScalar "stat" m - unless (stat == "ok") $ failure $ RpxnowException $ - "Rpxnow login not accepted: " ++ stat ++ "\n" ++ L.unpack b - parseProfile m + o <- unResult $ parse json b + --m <- fromMapping o + let mstat = flip Data.Aeson.Types.parse o $ \v -> + case v of + Object m -> m .: "stat" + _ -> mzero + case mstat of + Success "ok" -> return () + Success stat -> failure $ RpxnowException $ + "Rpxnow login not accepted: " ++ stat ++ "\n" ++ L.unpack b + _ -> failure $ RpxnowException "Now stat value found on Rpxnow response" + case Data.Aeson.Types.parse parseProfile o of + Success x -> return x + Error e -> failure $ RpxnowException $ "Unable to parse Rpxnow response: " ++ e -parseProfile :: (Monad m, Failure ObjectExtractError m) - => [(String, StringObject)] -> m Identifier -parseProfile m = do - profile <- lookupMapping "profile" m - ident <- lookupScalar "identifier" profile +unResult :: Failure AuthenticateException m => AT.Result a -> m a +unResult = either (failure . RpxnowException) return . AT.eitherResult + +parseProfile :: Value -> Data.Aeson.Types.Parser Identifier +parseProfile (Object m) = do + profile <- m .: "profile" + ident <- m .: "identifier" let profile' = mapMaybe go profile return $ Identifier ident profile' where go ("identifier", _) = Nothing - go (k, Scalar v) = Just (k, v) + go (k, String v) = Just (k, v) go _ = Nothing +parseProfile _ = mzero diff --git a/authenticate.cabal b/authenticate.cabal index 8d6fc2a9..7bfe432c 100644 --- a/authenticate.cabal +++ b/authenticate.cabal @@ -1,5 +1,5 @@ name: authenticate -version: 0.8.2.2 +version: 0.9.0 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -15,8 +15,7 @@ homepage: http://github.com/snoyberg/authenticate/tree/master library build-depends: base >= 4 && < 5, - data-object >= 0.3.1 && < 0.4, - data-object-json >= 0.3.1 && < 0.4, + aeson >= 0.3.1.1 && < 0.4, http-enumerator >= 0.3.0 && < 0.4, tagsoup >= 0.6 && < 0.13, failure >= 0.0.0 && < 0.2, @@ -31,7 +30,9 @@ library base64-bytestring >= 0.1 && < 0.2, SHA >= 1.4 && < 1.5, random >= 1.0 && < 1.1, - wai-extra >= 0.3 && < 0.4 + wai-extra >= 0.3 && < 0.4, + text >= 0.5 && < 1.0, + attoparsec >= 0.8.5 && < 0.9 exposed-modules: Web.Authenticate.Rpxnow, Web.Authenticate.OpenId, Web.Authenticate.OpenId.Providers,