advanced linting

This commit is contained in:
nek0 2019-10-16 18:22:51 +02:00
parent b29daaf841
commit 18571fa201

View file

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