[can now add an additional openid identifier, though trouble may arise if that identifier is already used with another authid Jeremy Shaw **20110224191145 Ignore-this: a40b5ecc265d7735f97ab52833a2d8a5 ] hunk ./AuthURL.hs 73 + | A_AddAuth hunk ./AuthURL.hs 84 + , return A_AddAuth hunk ./AuthURL.hs 98 + toPathSegments A_AddAuth = ["add_auth"] hunk ./AuthURL.hs 110 + , do segment "add_auth" + return A_AddAuth hunk ./Pages/Home.hs 25 -

You are logged in as <% show uid %>. You can logout here.

+

You are logged in as <% show uid %>. You can logout here. You can add an additional auth method here.

hunk ./Pages/Login.hs 43 -googlePage :: (Happstack m, ShowURL m, URL m ~ AuthURL) => AuthMode -> Maybe String -> m Response +loginPage :: RouteT AuthURL (ServerPartT IO) Response +loginPage = + appTemplate "login" () $ +
    +
  1. Login with your Google
    2. +
  2. Login with your Yahoo Account
    3. +
  3. Login with your Live Journal Account
    4. +
  4. Login with your Myspace Account
    5. +
  5. Login with your OpenId Account
    6. +
+ +addAuthPage :: RouteT AuthURL (ServerPartT IO) Response +addAuthPage = + appTemplate "login" () $ +
    +
  1. Add your Google
    2. +
  2. Add your Yahoo Account
    3. +
  3. Add your Live Journal Account
    4. +
  4. Add your Myspace Account
    5. +
  5. Add your OpenId Account
    6. +
+ +googlePage :: (Happstack m, ShowURL m, URL m ~ AuthURL) => + AuthMode -- ^ authentication mode + -> Maybe String -- ^ realm + -> m Response hunk ./Pages/Login.hs 74 +yahooPage :: (Happstack m, ShowURL m, URL m ~ AuthURL) => + AuthMode -- ^ authentication mode + -> Maybe String -- ^ realm + -> m Response +yahooPage authMode realm = + do openIdUrl <- showURL (A_OpenId authMode) + gotoURL <- liftIO $ getForwardUrl yahoo openIdUrl realm [] + seeOther gotoURL (toResponse gotoURL) + + hunk ./Pages/Login.hs 92 - - +openIdPage AddIdentifierMode onAuthURL = + do identifier <- getIdentifier + mAuthId <- getAuthId + case mAuthId of + Nothing -> undefined + (Just authId) -> + do update (AddAuthMethod (AuthIdentifier identifier) authId) + seeOther onAuthURL (toResponse ()) hunk ./State/Auth.hs 26 - , AddAuthIdentifier(..) + , AddAuthMethod(..) hunk ./State/Auth.hs 146 -data AuthToken = AuthToken { tokenString :: String - , tokenExpires :: UTCTime - , tokenAuthId :: Maybe AuthId - , tokenAuthMethod :: AuthMethod - } +data AuthToken + = AuthToken { tokenString :: String + , tokenExpires :: UTCTime + , tokenAuthId :: Maybe AuthId + , tokenAuthMethod :: AuthMethod + } hunk ./State/Auth.hs 284 -addAuthIdentifier :: Identifier -> AuthId -> Update AuthState () -addAuthIdentifier identifier authid = +addAuthMethod :: AuthMethod -> AuthId -> Update AuthState () +addAuthMethod authMethod authid = hunk ./State/Auth.hs 287 - put $ as { authMaps = IxSet.insert (AuthMap (AuthIdentifier identifier) authid) authMaps } + put $ as { authMaps = IxSet.insert (AuthMap authMethod authid) authMaps } hunk ./State/Auth.hs 402 - , 'addAuthIdentifier + , 'addAuthMethod hunk ./demo.hs 100 - A_Login -> loginPage - A_Logout -> logoutPage + A_Login -> loginPage + A_AddAuth -> addAuthPage + A_Logout -> logoutPage hunk ./demo.hs 104 - (A_OpenId authMode) -> openIdPage authMode onAuthURL + (A_OpenIdProvider authMode Yahoo) -> yahooPage authMode (Just "http://*.n-heptane.com:8000/") + (A_OpenId authMode) -> openIdPage authMode onAuthURL hunk ./demo.hs 112 -loginPage :: RouteT AuthURL (ServerPartT IO) Response -loginPage = - appTemplate "login" () $ -
    -
  1. Google
    2. -