diff --git a/Web/Authenticate/Rpxnow.hs b/Web/Authenticate/Rpxnow.hs index a7bda581..2c106632 100644 --- a/Web/Authenticate/Rpxnow.hs +++ b/Web/Authenticate/Rpxnow.hs @@ -38,6 +38,8 @@ import Data.Attoparsec.Lazy (parse) import qualified Data.Attoparsec.Lazy as AT import Data.Text (Text) import qualified Data.Aeson.Types +import qualified Data.Map as Map +import Control.Applicative ((<$>), (<*>)) -- | Information received from Rpxnow after a valid login. data Identifier = Identifier @@ -101,9 +103,9 @@ 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' + Identifier + <$> (profile .: "identifier") + <*> return (mapMaybe go (Map.toList profile)) where go ("identifier", _) = Nothing go (k, String v) = Just (k, v) diff --git a/authenticate.cabal b/authenticate.cabal index dd8eff73..bcbc3328 100644 --- a/authenticate.cabal +++ b/authenticate.cabal @@ -1,5 +1,5 @@ name: authenticate -version: 0.9.1.2 +version: 0.9.1.3 license: BSD3 license-file: LICENSE author: Michael Snoyman @@ -34,7 +34,8 @@ library http-types >= 0.6 && < 0.7, enumerator >= 0.4.7 && < 0.5, blaze-builder >= 0.2 && < 0.4, - attoparsec >= 0.8.5 && < 0.9 + attoparsec >= 0.8.5 && < 0.9, + containers exposed-modules: Web.Authenticate.Rpxnow, Web.Authenticate.OpenId, Web.Authenticate.OpenId.Providers, diff --git a/rpxnow.hs b/rpxnow.hs new file mode 100644 index 00000000..e37d5580 --- /dev/null +++ b/rpxnow.hs @@ -0,0 +1,38 @@ +{-# LANGUAGE TypeFamilies, QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings #-} +import Yesod +import Web.Authenticate.Rpxnow +import Data.Maybe (fromMaybe) +import qualified Data.Aeson as A +import qualified Data.Vector as V +import qualified Data.Map as M +import Data.Text (unpack) + +appName :: String +appName = "yesod-test" +apiKey = "c8043882f14387d7ad8dfc99a1a8dab2e028f690" +data RP = RP +type Handler = GHandler RP RP + +mkYesod "RP" [parseRoutes| +/ RootR GET +/complete CompleteR POST +|] + +instance Yesod RP where approot _ = "http://localhost:3000" + +getRootR :: Handler RepHtml +getRootR = defaultLayout [hamlet| +