advanced linting

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" $
+      (token, mAuthUser) = parseTokenAndUser mcookie
-        lookup "x-token" =<< mParsedCookie
-      mAuthUser = T.unpack <$>
-        (lookup "x-auth-user" =<< mParsedCookie)
       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, mAuthUser) = parseTokenAndUser mcookie
-      token = T.unpack $ fromMaybe "secret"
-        (lookup "x-token" =<< mParsedCookie)
-      mAuthUser = T.unpack <$>
-        (lookup "x-auth-user" =<< mParsedCookie)
   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
+  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
     (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
+  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
   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
+  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
     (authManageDeleteAuth (mkAuthenticatedRequest token authenticateReq) adid)
     backend