authenticate 0.8.0 → 0.8.0.1

raw patch · 4 files changed

+26/−16 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• OpenId2/Discovery.hs +13/−11
• OpenId2/Types.hs +4/−0
• Web/Authenticate/OpenId.hs +8/−4
• authenticate.cabal +1/−1

@@ -35,7 +35,7 @@ import Network.Wai (ciOriginal)  data Discovery = Discovery1 String (Maybe String)-               | Discovery2 Provider Identifier+               | Discovery2 Provider Identifier IdentType     deriving Show  -- | Attempt to resolve an OpenID endpoint, and user identifier.@@ -48,7 +48,7 @@ discover ident@(Identifier i) = do     res1 <- discoverYADIS ident Nothing 10     case res1 of-        Just (x, y) -> return $ Discovery2 x y+        Just (x, y, z) -> return $ Discovery2 x y z         Nothing -> do             res2 <- discoverHTML ident             case res2 of@@ -65,7 +65,7 @@               => Identifier               -> Maybe String               -> Int -- ^ remaining redirects-              -> m (Maybe (Provider,Identifier))+              -> m (Maybe (Provider, Identifier, IdentType)) discoverYADIS _ _ 0 = failure TooManyRedirects discoverYADIS ident mb_loc redirects = do     let uri = fromMaybe (identifier ident) mb_loc@@ -90,7 +90,7 @@  -- | Parse out an OpenID endpoint, and actual identifier from a YADIS xml -- document.-parseYADIS :: Identifier -> XRDS -> Maybe (Provider,Identifier)+parseYADIS :: Identifier -> XRDS -> Maybe (Provider, Identifier, IdentType) parseYADIS ident = listToMaybe . mapMaybe isOpenId . concat   where   isOpenId svc = do@@ -98,15 +98,15 @@         localId = maybe ident Identifier $ listToMaybe $ serviceLocalIDs svc         f (x,y) | x `elem` tys = Just y                 | otherwise    = Nothing-    lid <- listToMaybe $ mapMaybe f-      [ ("http://specs.openid.net/auth/2.0/server", ident)+    (lid, itype) <- listToMaybe $ mapMaybe f+      [ ("http://specs.openid.net/auth/2.0/server", (ident, OPIdent))       -- claimed identifiers-      , ("http://specs.openid.net/auth/2.0/signon", localId)-      , ("http://openid.net/signon/1.0"           , localId)-      , ("http://openid.net/signon/1.1"           , localId)+      , ("http://specs.openid.net/auth/2.0/signon", (localId, ClaimedIdent))+      , ("http://openid.net/signon/1.0"           , (localId, ClaimedIdent))+      , ("http://openid.net/signon/1.1"           , (localId, ClaimedIdent))       ]     uri <- listToMaybe $ serviceURIs svc-    return (Provider uri, lid)+    return (Provider uri, lid, itype)   -- HTML-Based Discovery --------------------------------------------------------@@ -136,7 +136,9 @@     resolve2 ls = do       prov <- lookup "openid2.provider" ls       let lid = maybe ident Identifier $ lookup "openid2.local_id" ls-      return $ Discovery2 (Provider prov) lid+      -- Based on OpenID 2.0 spec, section 7.3.3, HTML discovery can only+      -- result in a claimed identifier.+      return $ Discovery2 (Provider prov) lid ClaimedIdent     resolve ls = resolve2 ls `mplus` resolve1 ls  

@@ -13,6 +13,7 @@ module OpenId2.Types (     Provider (..)   , Identifier (..)+  , IdentType (..)   , AuthenticateException (..)   ) where @@ -26,4 +27,7 @@  -- | A valid OpenID identifier. newtype Identifier = Identifier { identifier :: String }+    deriving (Eq, Ord, Show, Read, Data, Typeable)++data IdentType = OPIdent | ClaimedIdent     deriving (Eq, Ord, Show, Read, Data, Typeable)

@@ -45,12 +45,16 @@                 : ("openid.realm", realm)                 : ("openid.trust_root", complete)                 : params-        Discovery2 (Provider p) (Identifier i) ->+        Discovery2 (Provider p) (Identifier i) itype -> do+            let i' =+                    case itype of+                        ClaimedIdent -> i+                        OPIdent -> "http://specs.openid.net/auth/2.0/identifier_select"             return $ qsUrl p                 $ ("openid.ns", "http://specs.openid.net/auth/2.0")                 : ("openid.mode", "checkid_setup")-                : ("openid.claimed_id", i)-                : ("openid.identity", i)+                : ("openid.claimed_id", i')+                : ("openid.identity", i')                 : ("openid.return_to", complete)                 : ("openid.realm", realm)                 : params@@ -79,7 +83,7 @@     disc <- normalize ident >>= discover     let endpoint = case disc of                     Discovery1 p _ -> p-                    Discovery2 (Provider p) _ -> p+                    Discovery2 (Provider p) _ _ -> p     let params' = map (BSU.fromString *** BSU.fromString)                 $ ("openid.mode", "check_authentication")                 : filter (\(k, _) -> k /= "openid.mode") params

@@ -1,5 +1,5 @@ name:            authenticate-version:         0.8.0+version:         0.8.0.1 license:         BSD3 license-file:    LICENSE author:          Michael Snoyman <michael@snoyman.com>