authenticate 0.6.6.1 → 0.7.0

raw patch · 7 files changed

+36/−42 lines, 7 filesdep ~http-enumeratorPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: http-enumerator

API changes (from Hackage documentation)

Files

• OpenId2/Discovery.hs +7/−10
• OpenId2/Normalization.hs +1/−1
• OpenId2/Types.hs +2/−10
• Web/Authenticate/Internal.hs +13/−1
• Web/Authenticate/OpenId.hs +6/−8
• Web/Authenticate/Rpxnow.hs +5/−10
• authenticate.cabal +2/−2

@@ -39,14 +39,13 @@  -- | Attempt to resolve an OpenID endpoint, and user identifier. discover :: ( MonadIO m-            , Failure OpenIdException m+            , Failure AuthenticateException m             , Failure HttpException m-            , Failure InvalidUrlException m             )          => Identifier          -> m Discovery discover ident@(Identifier i) = do-    res1 <- discoverYADIS ident Nothing+    res1 <- discoverYADIS ident Nothing 10     case res1 of         Just (x, y) -> return $ Discovery2 x y         Nothing -> do@@ -61,12 +60,13 @@ --   an OpenID endpoint, and the actual identifier for the user. discoverYADIS :: ( MonadIO m                  , Failure HttpException m-                 , Failure InvalidUrlException m                  )               => Identifier               -> Maybe String+              -> Int -- ^ remaining redirects               -> m (Maybe (Provider,Identifier))-discoverYADIS ident mb_loc = do+discoverYADIS _ _ 0 = failure TooManyRedirects+discoverYADIS ident mb_loc redirects = do     let uri = fromMaybe (identifier ident) mb_loc     req <- parseUrl uri     res <- httpLbs req@@ -78,7 +78,7 @@     case statusCode res of         200 ->           case mloc' of-            Just loc -> discoverYADIS ident (Just loc)+            Just loc -> discoverYADIS ident (Just loc) (redirects - 1)             Nothing  -> do               let mdoc = parseXRDS $ BSLU.toString $ responseBody res               case mdoc of@@ -112,10 +112,7 @@  -- | 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 :: ( MonadIO m-                , Failure HttpException m-                , Failure InvalidUrlException m-                )+discoverHTML :: ( MonadIO m, Failure HttpException m)              => Identifier              -> m (Maybe Discovery) discoverHTML ident'@(Identifier ident) =

@@ -24,7 +24,7 @@ import Control.Failure (Failure (..)) import Network.URI -normalize :: Failure OpenIdException m => String -> m Identifier+normalize :: Failure AuthenticateException m => String -> m Identifier normalize ident =     case normalizeIdentifier $ Identifier ident of         Just i -> return i

@@ -13,19 +13,11 @@ module OpenId2.Types (     Provider (..)   , Identifier (..)-  , OpenIdException (..)+  , AuthenticateException (..)   ) where  -- Libraries-import Control.Exception (Exception)-import Data.Typeable (Typeable)--data OpenIdException =-      NormalizationException String-    | DiscoveryException String-    | AuthenticationException String-  deriving (Show, Typeable)-instance Exception OpenIdException+import Web.Authenticate.Internal  -- | An OpenID provider. newtype Provider = Provider { providerURI :: String } deriving (Eq,Show)

@@ -1,18 +1,30 @@+{-# LANGUAGE DeriveDataTypeable #-} module Web.Authenticate.Internal     ( qsEncode     , qsUrl+    , AuthenticateException (..)     ) where  import Codec.Binary.UTF8.String (encode) import Numeric (showHex) import Data.List (intercalate)+import Data.Typeable (Typeable)+import Control.Exception (Exception) +data AuthenticateException =+      RpxnowException String+    | NormalizationException String+    | DiscoveryException String+    | AuthenticationException String+  deriving (Show, Typeable)+instance Exception AuthenticateException+ qsUrl :: String -> [(String, String)] -> String qsUrl s [] = s qsUrl url pairs =     url ++ delim : intercalate "&" (map qsPair pairs)   where-    qsPair (x, y) = qsEncode x ++ '=' : qsEncode y +    qsPair (x, y) = qsEncode x ++ '=' : qsEncode y     delim = if '?' `elem` url then '&' else '?'  qsEncode :: String -> String

@@ -2,7 +2,7 @@ module Web.Authenticate.OpenId     ( getForwardUrl     , authenticate-    , OpenIdException (..)+    , AuthenticateException (..)     , Identifier (..)     ) where @@ -10,24 +10,22 @@ import OpenId2.Normalization (normalize) import OpenId2.Discovery (discover, Discovery (..)) import Control.Failure (Failure (failure))-import OpenId2.Types (OpenIdException (..), Identifier (Identifier),-                      Provider (Provider))+import OpenId2.Types import Web.Authenticate.Internal (qsUrl) import Control.Monad (unless) import qualified Data.ByteString.UTF8 as BSU import qualified Data.ByteString.Lazy.UTF8 as BSLU import Network.HTTP.Enumerator     ( parseUrl, urlEncodedBody, responseBody, httpLbsRedirect-    , HttpException, InvalidUrlException+    , HttpException     ) import Control.Arrow ((***)) import Data.List (unfoldr) import Data.Maybe (fromMaybe)  getForwardUrl :: ( MonadIO m-                 , Failure OpenIdException m+                 , Failure AuthenticateException m                  , Failure HttpException m-                 , Failure InvalidUrlException m                  )               => String -- ^ The openid the user provided.               -> String -- ^ The URL for this application\'s complete page.@@ -40,6 +38,7 @@                 [ ("openid.mode", "checkid_setup")                 , ("openid.identity", fromMaybe openid' mdelegate)                 , ("openid.return_to", complete)+                , ("openid.trust_root", complete)                 ]         Discovery2 (Provider p) (Identifier i) ->             return $ qsUrl p@@ -51,8 +50,7 @@                 ]  authenticate :: ( MonadIO m-                , Failure OpenIdException m-                , Failure InvalidUrlException m+                , Failure AuthenticateException m                 , Failure HttpException m                 )              => [(String, String)]

@@ -19,7 +19,7 @@ module Web.Authenticate.Rpxnow     ( Identifier (..)     , authenticate-    , RpxnowException (..)+    , AuthenticateException (..)     ) where  import Data.Object@@ -31,8 +31,8 @@ import Control.Monad import qualified Data.ByteString.Char8 as S import qualified Data.ByteString.Lazy.Char8 as L-import Control.Exception (throwIO, Exception)-import Data.Typeable (Typeable)+import Control.Exception (throwIO)+import Web.Authenticate.Internal  -- | Information received from Rpxnow after a valid login. data Identifier = Identifier@@ -43,8 +43,7 @@ -- | Attempt to log a user in. authenticate :: (MonadIO m,                  Failure HttpException m,-                 Failure InvalidUrlException m,-                 Failure RpxnowException m,+                 Failure AuthenticateException m,                  Failure ObjectExtractError m,                  Failure JsonDecodeError m)              => String -- ^ API key given by RPXNOW.@@ -73,7 +72,7 @@     res <- httpLbsRedirect req     let b = responseBody res     unless (200 <= statusCode res && statusCode res < 300) $-        liftIO $ throwIO $ HttpException (statusCode res) b+        liftIO $ throwIO $ StatusCodeException (statusCode res) b     o <- decode $ S.concat $ L.toChunks b     m <- fromMapping o     stat <- lookupScalar "stat" m@@ -92,7 +91,3 @@     go ("identifier", _) = Nothing     go (k, Scalar v) = Just (k, v)     go _ = Nothing--data RpxnowException = RpxnowException String-    deriving (Show, Typeable)-instance Exception RpxnowException

@@ -1,5 +1,5 @@ name:            authenticate-version:         0.6.6.1+version:         0.7.0 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>@@ -17,7 +17,7 @@     build-depends:   base >= 4 && < 5,                      data-object >= 0.3.1 && < 0.4,                      data-object-json >= 0.3.1 && < 0.4,-                     http-enumerator >= 0.1.1 && < 0.2,+                     http-enumerator >= 0.2.0 && < 0.3,                      tagsoup >= 0.6 && < 0.12,                      failure >= 0.0.0 && < 0.2,                      transformers >= 0.1 && < 0.3,