From 7754e321b2cf5a2213c1535fac846a51d0af466b Mon Sep 17 00:00:00 2001 From: nek0 Date: Tue, 26 Aug 2014 04:37:56 +0200 Subject: [PATCH] code cleanup --- Handler/Activate.hs | 7 ++++--- Handler/Login.hs | 2 +- Handler/NewAlbum.hs | 2 +- Handler/Signup.hs | 2 +- Helper.hs | 6 +----- 5 files changed, 8 insertions(+), 11 deletions(-) diff --git a/Handler/Activate.hs b/Handler/Activate.hs index 22f216f..f343bc6 100644 --- a/Handler/Activate.hs +++ b/Handler/Activate.hs @@ -23,7 +23,7 @@ getActivateR token = do defaultLayout $ do $(widgetFile "activate") _ -> do - returnJsonError "Invalid token!" + setMessage "Invalid token!" redirect $ ActivateR token postActivateR :: Text -> Handler RepJson @@ -38,7 +38,7 @@ postActivateR token = do Just (Entity aId activ) -> do -- putting user in active state uId <- runDB $ insert $ activatorUser activ - runDB $ update uId [UserSalted =. (Just salted)] + runDB $ update uId [UserSalted =. salted] -- create user directory liftIO $ createDirectoryIfMissing True $ "static" "data" (unpack $ extractKey uId) -- cleanup @@ -48,7 +48,8 @@ postActivateR token = do setSession "userId" (extractKey uId) welcomeLink <- ($ ProfileR uId) <$> getUrlRender returnJson ["welcome" .= welcomeLink] - -- redirect $ HomeR + Nothing -> do + returnJsonError "Invalid token" _ -> do returnJsonError "Invalid activation token!" diff --git a/Handler/Login.hs b/Handler/Login.hs index dae4dc2..85b52a5 100644 --- a/Handler/Login.hs +++ b/Handler/Login.hs @@ -50,7 +50,7 @@ postLoginR = do savedUserId <- return $ tokenUser token queriedUser <- runDB $ getJust (fromJust savedUserId) salted <- return $ userSalted queriedUser - hexSalted <- return $ toHex $ fromJust salted + hexSalted <- return $ toHex salted expected <- return $ hmacSHA1 (tokenToken token) (encodeUtf8 hexSalted) case (fromHex' $ T.unpack hexResponse) == expected of True -> diff --git a/Handler/NewAlbum.hs b/Handler/NewAlbum.hs index 5372397..185993e 100644 --- a/Handler/NewAlbum.hs +++ b/Handler/NewAlbum.hs @@ -15,7 +15,7 @@ getNewAlbumR = do defaultLayout $ do $(widgetFile "newAlbum") Nothing -> do - setMessage "You need to be lgged in" + setMessage "You need to be logged in" redirect $ LoginR postNewAlbumR :: Handler Html diff --git a/Handler/Signup.hs b/Handler/Signup.hs index 4119ebc..392a32c 100644 --- a/Handler/Signup.hs +++ b/Handler/Signup.hs @@ -39,7 +39,7 @@ postSignupR = do case namesakes of [] -> do salt <- liftIO generateSalt - newUser <- return $ User newUserName (fromJust mEmail) "" salt Nothing [] + newUser <- return $ User newUserName newUserName (fromJust mEmail) salt "" [] activatorText <- liftIO generateString aId <- runDB $ insert $ Activator activatorText newUser tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing diff --git a/Helper.hs b/Helper.hs index 0a9489c..b6a7578 100644 --- a/Helper.hs +++ b/Helper.hs @@ -48,11 +48,7 @@ fromHex :: String -> BL.ByteString fromHex = BL.pack . hexToWords where hexToWords (c:c':text) = let hex = [c, c'] - word = case readHex hex of - (d,_):_ -> d - [] -> error "empty list" - _ -> error "fuckup" --- (word, _):_ = readHex hex + (word, _):_ = readHex hex in word : hexToWords text hexToWords _ = []