diff --git a/src/Control/User.hs b/src/Control/User.hs index 9e116ee..f89cb9e 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -36,6 +36,18 @@ import Hash import API import Util +parseTokenAndUser + :: Maybe T.Text + -> (String, Maybe String) +parseTokenAndUser mcookie = + (token, mAuthUser) + where + token = T.unpack $ fromMaybe "secret" + (lookup "x-token" =<< mParsedCookie) + mAuthUser = T.unpack <$> + (lookup "x-auth-user" =<< mParsedCookie) + mParsedCookie = fmap parseCookieText mcookie + userSelectControl :: Maybe T.Text -> UserHandler UserSelectPage userSelectControl mcookie = do (ReadState l10n backend _) <- ask @@ -81,10 +93,7 @@ userOverviewControl mcookie uid mRefine = do let loc = Locale (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) mParsedCookie = fmap parseCookieText mcookie - token = T.unpack $ fromMaybe "secret" $ - lookup "x-token" =<< mParsedCookie - mAuthUser = T.unpack <$> - (lookup "x-auth-user" =<< mParsedCookie) + (token, mAuthUser) = parseTokenAndUser mcookie mMethod = T.unpack <$> (lookup "x-method" =<< mParsedCookie) euser <- liftIO $ @@ -138,11 +147,7 @@ userManageControl mcookie uid = do (ReadState l10n backend _) <- ask let loc = Locale (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) - mParsedCookie = fmap parseCookieText mcookie - token = T.unpack $ fromMaybe "secret" - (lookup "x-token" =<< mParsedCookie) - mAuthUser = T.unpack <$> - (lookup "x-auth-user" =<< mParsedCookie) + (token, mAuthUser) = parseTokenAndUser mcookie eUserDetails <- liftIO $ runClientM (userGet (mkAuthenticatedRequest token authenticateReq)) @@ -170,11 +175,7 @@ userManageDetailsSubmitControl -> UserHandler UserOverviewPage userManageDetailsSubmitControl mcookie uid uds = do (ReadState _ backend _) <- ask - let mParsedCookie = fmap parseCookieText mcookie - token = T.unpack $ fromMaybe "secret" - (lookup "x-token" =<< mParsedCookie) - mAuthUser = T.unpack <$> - (lookup "x-auth-user" =<< mParsedCookie) + let (token, mAuthUser) = parseTokenAndUser mcookie eReturn <- liftIO $ runClientM (userUpdate (mkAuthenticatedRequest token authenticateReq) uds) backend @@ -190,11 +191,7 @@ userManageAuthCreateControl -> UserHandler UserOverviewPage userManageAuthCreateControl mcookie uid (AuthSubmitReturn comment pass method) = do (ReadState _ backend _) <- ask - let mParsedCookie = fmap parseCookieText mcookie - token = T.unpack $ fromMaybe "secret" - (lookup "x-token" =<< mParsedCookie) - mAuthUser = T.unpack <$> - (lookup "x-auth-user" =<< mParsedCookie) + let (token, mAuthUser) = parseTokenAndUser mcookie hashedPass <- hashPassword pass eReturn <- liftIO $ runClientM (authManageNewAuth @@ -214,11 +211,7 @@ userManageAuthDeleteControl -> UserHandler UserOverviewPage userManageAuthDeleteControl mcookie uid (AuthDetailId adid) = do (ReadState _ backend _) <- ask - let mParsedCookie = fmap parseCookieText mcookie - token = T.unpack $ fromMaybe "secret" - (lookup "x-token" =<< mParsedCookie) - mAuthUser = T.unpack <$> - (lookup "x-auth-user" =<< mParsedCookie) + let (token, mAuthUser) = parseTokenAndUser mcookie eReturn <- liftIO $ runClientM (authManageDeleteAuth (mkAuthenticatedRequest token authenticateReq) adid) backend