authenticate 1.0.0.1 → 1.1.0

raw patch · 5 files changed

+32/−27 lines, 5 filesdep +monad-controldep +resourcetdep ~blaze-builder-conduitdep ~conduitdep ~http-conduitPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-control, resourcet

Dependency ranges changed: blaze-builder-conduit, conduit, http-conduit, xml-conduit

API changes (from Hackage documentation)

Files

• OpenId2/Discovery.hs +10/−10
• Web/Authenticate/BrowserId.hs +5/−3
• Web/Authenticate/OpenId.hs +6/−6
• Web/Authenticate/Rpxnow.hs +4/−3
• authenticate.cabal +7/−5

@@ -22,16 +22,14 @@ import OpenId2.Types import OpenId2.XRDS -import Debug.Trace -- Libraries import Data.Char import Data.Maybe import Network.HTTP.Conduit-import Data.Conduit (ResourceT, ResourceIO) import qualified Data.ByteString.Char8 as S8 import Control.Arrow (first) import Control.Monad.IO.Class (MonadIO (liftIO))-import Control.Monad (mplus)+import Control.Monad (mplus, liftM) import qualified Data.CaseInsensitive as CI import Data.Text (Text, unpack) import Data.Text.Lazy (toStrict)@@ -42,13 +40,15 @@ import Control.Applicative ((<$>), (<*>)) import Network.HTTP.Types (status200) import Control.Exception (throwIO)+import Control.Monad.Trans.Resource (MonadResource)+import Control.Monad.Trans.Control (MonadBaseControl)  data Discovery = Discovery1 Text (Maybe Text)                | Discovery2 Provider Identifier IdentType     deriving Show  -- | Attempt to resolve an OpenID endpoint, and user identifier.-discover :: ResourceIO m => Identifier -> Manager -> ResourceT m Discovery+discover :: (MonadBaseControl IO m, MonadIO m, MonadResource m) => Identifier -> Manager -> m Discovery discover ident@(Identifier i) manager = do     res1 <- discoverYADIS ident Nothing 10 manager     case res1 of@@ -63,12 +63,12 @@  -- | Attempt a YADIS based discovery, given a valid identifier.  The result is --   an OpenID endpoint, and the actual identifier for the user.-discoverYADIS :: ResourceIO m+discoverYADIS :: (MonadResource m, MonadBaseControl IO m)               => Identifier               -> Maybe String               -> Int -- ^ remaining redirects               -> Manager-              -> ResourceT m (Maybe (Provider, Identifier, IdentType))+              -> m (Maybe (Provider, Identifier, IdentType)) discoverYADIS _ _ 0 _ = liftIO $ throwIO TooManyRedirects discoverYADIS ident mb_loc redirects manager = do     let uri = fromMaybe (unpack $ identifier ident) mb_loc@@ -79,7 +79,7 @@              $ map (first $ map toLower . S8.unpack . CI.original)              $ responseHeaders res     let mloc' = if mloc == mb_loc then Nothing else mloc-    if statusCode res == status200+    if responseStatus res == status200         then           case mloc' of             Just loc -> discoverYADIS ident (Just loc) (redirects - 1) manager@@ -116,10 +116,10 @@  -- | Attempt to discover an OpenID endpoint, from an HTML document.  The result -- will be an endpoint on success, and the actual identifier of the user.-discoverHTML :: ResourceIO m => Identifier -> Manager -> ResourceT m (Maybe Discovery)+discoverHTML :: (MonadResource m, MonadBaseControl IO m) => Identifier -> Manager -> m (Maybe Discovery) discoverHTML ident'@(Identifier ident) manager = do     req <- liftIO $ parseUrl $ unpack ident-    Response _ _ lbs <- httpLbs req manager+    lbs <- liftM responseBody $ httpLbs req manager     return $ parseHTML ident' . toStrict . decodeUtf8With lenientDecode $ lbs  -- | Parse out an OpenID endpoint and an actual identifier from an HTML@@ -146,5 +146,5 @@  -- | Filter out link tags from a list of html tags. linkTag :: Tag Text -> Maybe (Text, Text)-linkTag (TagOpen "link" as) = let x = (,) <$> lookup "rel" as <*> lookup "href" as in traceShow x x+linkTag (TagOpen "link" as) = (,) <$> lookup "rel" as <*> lookup "href" as linkTag _x = Nothing

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-} module Web.Authenticate.BrowserId     ( browserIdJs     , checkAssertion@@ -6,22 +7,23 @@  import Data.Text (Text) import Network.HTTP.Conduit (parseUrl, responseBody, httpLbs, Manager, method, urlEncodedBody)-import Data.Conduit (ResourceT, ResourceIO) import Data.Aeson (json, Value (Object, String)) import Data.Attoparsec.Lazy (parse, maybeResult) import qualified Data.HashMap.Lazy as Map import Data.Text.Encoding (encodeUtf8) import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)  -- | Location of the Javascript file hosted by browserid.org browserIdJs :: Text browserIdJs = "https://browserid.org/include.js" -checkAssertion :: ResourceIO m+checkAssertion :: (MonadResource m, MonadBaseControl IO m)                => Text -- ^ audience                -> Text -- ^ assertion                -> Manager-               -> ResourceT m (Maybe Text)+               -> m (Maybe Text) checkAssertion audience assertion manager = do     req' <- liftIO $ parseUrl "https://browserid.org/verify"     let req = urlEncodedBody

@@ -20,7 +20,6 @@     ( parseUrl, urlEncodedBody, responseBody, httpLbs     , Manager     )-import Data.Conduit (ResourceT, ResourceIO) import Control.Arrow ((***), second) import Data.List (unfoldr) import Data.Maybe (fromMaybe)@@ -28,17 +27,18 @@ import Data.Text.Encoding (encodeUtf8, decodeUtf8) import Blaze.ByteString.Builder (toByteString) import Network.HTTP.Types (renderQueryText)-import Data.Monoid (mappend) import Control.Exception (throwIO)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)  getForwardUrl-    :: ResourceIO m+    :: (MonadResource m, MonadBaseControl IO m)     => Text -- ^ The openid the user provided.     -> Text -- ^ The URL for this application\'s complete page.     -> Maybe Text -- ^ Optional realm     -> [(Text, Text)] -- ^ Additional parameters to send to the OpenID provider. These can be useful for using extensions.     -> Manager-    -> ResourceT m Text -- ^ URL to send the user to.+    -> m Text -- ^ URL to send the user to. getForwardUrl openid' complete mrealm params manager = do     let realm = fromMaybe complete mrealm     disc <- normalize openid' >>= flip discover manager@@ -70,10 +70,10 @@                 : params  authenticate-    :: ResourceIO m+    :: (MonadBaseControl IO m, MonadResource m, MonadIO m)     => [(Text, Text)]     -> Manager-    -> ResourceT m (Identifier, [(Text, Text)])+    -> m (Identifier, [(Text, Text)]) authenticate params manager = do     unless (lookup "openid.mode" params == Just "id_res")         $ liftIO $ throwIO $ case lookup "openid.mode" params of

@@ -23,7 +23,6 @@  import Data.Aeson import Network.HTTP.Conduit-import Data.Conduit (ResourceT, ResourceIO) import Control.Monad.IO.Class import Data.Maybe import Control.Monad@@ -39,6 +38,8 @@ import qualified Data.HashMap.Lazy as Map import Control.Applicative ((<$>), (<*>)) import Control.Exception (throwIO)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource)  -- | Information received from Rpxnow after a valid login. data Identifier = Identifier@@ -48,11 +49,11 @@     deriving (Eq, Ord, Read, Show, Data, Typeable)  -- | Attempt to log a user in.-authenticate :: ResourceIO m+authenticate :: (MonadResource m, MonadBaseControl IO m)              => String -- ^ API key given by RPXNOW.              -> String -- ^ Token passed by client.              -> Manager-             -> ResourceT m Identifier+             -> m Identifier authenticate apiKey token manager = do     let body = L.fromChunks             [ "apiKey="

@@ -1,5 +1,5 @@ name:            authenticate-version:         1.0.0.1+version:         1.1.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman, Hiromi Ishii, Arash Rouhani@@ -15,7 +15,7 @@ library     build-depends:   base                          >= 4        && < 5                    , aeson                         >= 0.5-                   , http-conduit                  >= 1.2      && < 1.3+                   , http-conduit                  >= 1.3      && < 1.4                    , tagsoup                       >= 0.12     && < 0.13                    , transformers                  >= 0.1      && < 0.3                    , bytestring                    >= 0.9@@ -23,13 +23,15 @@                    , case-insensitive              >= 0.2                    , text                    , http-types                    >= 0.6      && < 0.7-                   , xml-conduit                   >= 0.5.1.2  && < 0.6+                   , xml-conduit                   >= 0.6      && < 0.7                    , blaze-builder                    , attoparsec                    , containers                    , unordered-containers-                   , conduit                       >= 0.2      && < 0.3-                   , blaze-builder-conduit         >= 0.2      && < 0.3+                   , conduit                       >= 0.3      && < 0.4+                   , resourcet                     >= 0.3      && < 0.4+                   , monad-control                 >= 0.3      && < 0.4+                   , blaze-builder-conduit         >= 0.3      && < 0.4     exposed-modules: Web.Authenticate.Rpxnow,                      Web.Authenticate.OpenId,                      Web.Authenticate.BrowserId,