code cleanup

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

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

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

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

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
+              (word, _):_ = readHex hex
-                     (d,_):_ -> d
-                     []      -> error "empty list"
-                     _       -> error "fuckup"
---              (word, _):_ = readHex hex
           in word : hexToWords text
         hexToWords _ = []