Migrate to aeson

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

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

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 <michael@snoyman.com>
@@ -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,