Merge pull request #1462 from spencerjanssen/auth-refactor

Remove unused UserInfo from Auth functions

Author: ysangkok

src/Distribution/Server/Features/Html.hs

@@ -650,7 +650,7 @@ mkHtmlCore ServerEnv{serverBaseURI, serverBlobStore}
         pkgVotes      <- pkgNumVotes pkgname
         pkgScore      <- pkgNumScore pkgname
         auth          <- checkAuthenticated
-        userRating    <- case auth of Just (uid,_) -> pkgUserVote pkgname uid; _ -> return Nothing
+        userRating    <- case auth of Just uid -> pkgUserVote pkgname uid; _ -> return Nothing
         mdoctarblob   <- queryDocumentation realpkg
         tags          <- queryTagsForPackage pkgname
         rdeps         <- queryReverseDeps pkgname

src/Distribution/Server/Features/Users.hs

@@ -68,7 +68,7 @@ data UserFeature = UserFeature {
     -- | Require being logged in, giving the id of the current user.
     guardAuthenticated :: ServerPartE UserId,
     -- | Gets the authentication if it exists.
-    checkAuthenticated :: ServerPartE (Maybe (UserId, UserInfo)),
+    checkAuthenticated :: ServerPartE (Maybe UserId),
     -- | A hook to override the default authentication error in particular
     -- circumstances.
     authFailHook       :: Hook Auth.AuthError (Maybe ErrorResponse),
@@ -487,7 +487,7 @@ userFeature templates usersState adminsState
     -- See note about "authn" cookie above
     guardAuthenticatedWithErrHook :: Users.Users -> ServerPartE UserId
     guardAuthenticatedWithErrHook users = do
-        (uid,_) <- Auth.checkAuthenticated realm users userFeatureServerEnv
+        uid <- Auth.checkAuthenticated realm users userFeatureServerEnv
                    >>= either handleAuthError return
         addCookie Session (mkCookie "authn" "1")
         -- Set-Cookie:authn="1";Path=/;Version="1"
@@ -510,7 +510,7 @@ userFeature templates usersState adminsState
 
     -- Check if there is an authenticated userid, and return info, if so.
     -- See note about "authn" cookie above
-    checkAuthenticated :: ServerPartE (Maybe (UserId, UserInfo))
+    checkAuthenticated :: ServerPartE (Maybe UserId)
     checkAuthenticated = do
         authn <- optional (lookCookieValue "authn")
         case authn of

src/Distribution/Server/Framework/Auth.hs

@@ -82,7 +82,7 @@ guardAuthorised :: RealmName -> Users.Users -> [PrivilegeCondition]
                 -> ServerEnv
                 -> ServerPartE UserId
 guardAuthorised realm users privconds env = do
-    (uid, _) <- guardAuthenticated realm users env
+    uid <- guardAuthenticated realm users env
     guardPriviledged users uid privconds
     return uid
 
@@ -96,14 +96,14 @@ guardAuthorised realm users privconds env = do
 -- It only checks the user is known, it does not imply that the user is
 -- authorised to do anything in particular, see 'guardAuthorised'.
 --
-guardAuthenticated :: RealmName -> Users.Users -> ServerEnv -> ServerPartE (UserId, UserInfo)
+guardAuthenticated :: RealmName -> Users.Users -> ServerEnv -> ServerPartE UserId
 guardAuthenticated realm users env = do
     authres <- checkAuthenticated realm users env
     case authres of
       Left  autherr -> throwError =<< authErrorResponse realm autherr
       Right info    -> return info
 
-checkAuthenticated :: ServerMonad m => RealmName -> Users.Users -> ServerEnv -> m (Either AuthError (UserId, UserInfo))
+checkAuthenticated :: ServerMonad m => RealmName -> Users.Users -> ServerEnv -> m (Either AuthError UserId)
 checkAuthenticated realm users ServerEnv { serverRequiredBaseHostHeader } = do
     mbHost <- getHost
     case mbHost of
@@ -251,15 +251,15 @@ plainHttp req
 
 -- | Handle a auth request using an access token
 checkTokenAuth :: Users.Users -> BS.ByteString
-               -> Either AuthError (UserId, UserInfo)
+               -> Either AuthError UserId
 checkTokenAuth users ahdr = do
     parsedToken <-
       case Users.parseOriginalToken (T.decodeUtf8 ahdr) of
         Left _    -> Left BadApiKeyError
         Right tok -> Right (Users.convertToken tok)
     (uid, uinfo) <- Users.lookupAuthToken parsedToken users ?! BadApiKeyError
     _ <- getUserAuth uinfo ?! UserStatusError uid uinfo
-    return (uid, uinfo)
+    return uid
 
 ------------------------------------------------------------------------
 -- Basic auth method
@@ -268,15 +268,15 @@ checkTokenAuth users ahdr = do
 -- | Use HTTP Basic auth to authenticate the client as an active enabled user.
 --
 checkBasicAuth :: Users.Users -> RealmName -> BS.ByteString
-               -> Either AuthError (UserId, UserInfo)
+               -> Either AuthError UserId
 checkBasicAuth users realm ahdr = do
     authInfo     <- getBasicAuthInfo realm ahdr       ?! UnrecognizedAuthError
     let uname    = basicUsername authInfo
     (uid, uinfo) <- Users.lookupUserName uname users  ?! NoSuchUserError uname
     uauth        <- getUserAuth uinfo                 ?! UserStatusError uid uinfo
     let passwdhash = getPasswdHash uauth
     guard (checkBasicAuthInfo passwdhash authInfo)    ?! PasswordMismatchError uid uinfo
-    return (uid, uinfo)
+    return uid
 
 getBasicAuthInfo :: RealmName -> BS.ByteString -> Maybe BasicAuthInfo
 getBasicAuthInfo realm authHeader
@@ -327,7 +327,7 @@ headerBasicAuthChallenge (RealmName realmName) =
 -- | Use HTTP Digest auth to authenticate the client as an active enabled user.
 --
 checkDigestAuth :: Users.Users -> BS.ByteString -> Request
-                -> Either AuthError (UserId, UserInfo)
+                -> Either AuthError UserId
 checkDigestAuth users ahdr req = do
     authInfo     <- getDigestAuthInfo ahdr req         ?! UnrecognizedAuthError
     let uname    = digestUsername authInfo
@@ -337,7 +337,7 @@ checkDigestAuth users ahdr req = do
     guard (checkDigestAuthInfo passwdhash authInfo)    ?! PasswordMismatchError uid uinfo
     -- TODO: if we want to prevent replay attacks, then we must check the
     -- nonce and nonce count and issue stale=true replies.
-    return (uid, uinfo)
+    return uid
 
 -- | retrieve the Digest auth info from the headers
 --