code cleanup

This commit is contained in:
nek0 2014-08-26 04:37:56 +02:00
parent edf583dcfb
commit 7754e321b2
5 changed files with 8 additions and 11 deletions

View file

@ -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!"

View file

@ -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 ->

View file

@ -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

View file

@ -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

View file

@ -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 _ = []