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 defaultLayout $ do
$(widgetFile "activate") $(widgetFile "activate")
_ -> do _ -> do
returnJsonError "Invalid token!" setMessage "Invalid token!"
redirect $ ActivateR token redirect $ ActivateR token
postActivateR :: Text -> Handler RepJson postActivateR :: Text -> Handler RepJson
@ -38,7 +38,7 @@ postActivateR token = do
Just (Entity aId activ) -> do Just (Entity aId activ) -> do
-- putting user in active state -- putting user in active state
uId <- runDB $ insert $ activatorUser activ uId <- runDB $ insert $ activatorUser activ
runDB $ update uId [UserSalted =. (Just salted)] runDB $ update uId [UserSalted =. salted]
-- create user directory -- create user directory
liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> (unpack $ extractKey uId) liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> (unpack $ extractKey uId)
-- cleanup -- cleanup
@ -48,7 +48,8 @@ postActivateR token = do
setSession "userId" (extractKey uId) setSession "userId" (extractKey uId)
welcomeLink <- ($ ProfileR uId) <$> getUrlRender welcomeLink <- ($ ProfileR uId) <$> getUrlRender
returnJson ["welcome" .= welcomeLink] returnJson ["welcome" .= welcomeLink]
-- redirect $ HomeR Nothing -> do
returnJsonError "Invalid token"
_ -> do _ -> do
returnJsonError "Invalid activation token!" returnJsonError "Invalid activation token!"

View file

@ -50,7 +50,7 @@ postLoginR = do
savedUserId <- return $ tokenUser token savedUserId <- return $ tokenUser token
queriedUser <- runDB $ getJust (fromJust savedUserId) queriedUser <- runDB $ getJust (fromJust savedUserId)
salted <- return $ userSalted queriedUser salted <- return $ userSalted queriedUser
hexSalted <- return $ toHex $ fromJust salted hexSalted <- return $ toHex salted
expected <- return $ hmacSHA1 (tokenToken token) (encodeUtf8 hexSalted) expected <- return $ hmacSHA1 (tokenToken token) (encodeUtf8 hexSalted)
case (fromHex' $ T.unpack hexResponse) == expected of case (fromHex' $ T.unpack hexResponse) == expected of
True -> True ->

View file

@ -15,7 +15,7 @@ getNewAlbumR = do
defaultLayout $ do defaultLayout $ do
$(widgetFile "newAlbum") $(widgetFile "newAlbum")
Nothing -> do Nothing -> do
setMessage "You need to be lgged in" setMessage "You need to be logged in"
redirect $ LoginR redirect $ LoginR
postNewAlbumR :: Handler Html postNewAlbumR :: Handler Html

View file

@ -39,7 +39,7 @@ postSignupR = do
case namesakes of case namesakes of
[] -> do [] -> do
salt <- liftIO generateSalt salt <- liftIO generateSalt
newUser <- return $ User newUserName (fromJust mEmail) "" salt Nothing [] newUser <- return $ User newUserName newUserName (fromJust mEmail) salt "" []
activatorText <- liftIO generateString activatorText <- liftIO generateString
aId <- runDB $ insert $ Activator activatorText newUser aId <- runDB $ insert $ Activator activatorText newUser
tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing tId <- runDB $ insert $ Token (encodeUtf8 activatorText) "activate" Nothing

View file

@ -48,11 +48,7 @@ fromHex :: String -> BL.ByteString
fromHex = BL.pack . hexToWords fromHex = BL.pack . hexToWords
where hexToWords (c:c':text) = where hexToWords (c:c':text) =
let hex = [c, c'] let hex = [c, c']
word = case readHex hex of (word, _):_ = readHex hex
(d,_):_ -> d
[] -> error "empty list"
_ -> error "fuckup"
-- (word, _):_ = readHex hex
in word : hexToWords text in word : hexToWords text
hexToWords _ = [] hexToWords _ = []