eidolon/Handler/Activate.hs
2014-08-24 21:42:42 +02:00

61 lines
2.1 KiB
Haskell

module Handler.Activate where
import Import as I hiding (returnJson)
import Data.Text
import Data.Text.Encoding
import Data.Maybe
import System.Directory
import System.FilePath
getActivateR :: Text -> Handler Html
getActivateR token = do
t <- runDB $ selectFirst [ActivatorToken ==. token] []
case t of
Nothing -> do
setMessage "Invalid Token!"
redirect $ HomeR
Just (Entity activatorKey activator) -> do
uSalt <- return $ userSalt $ activatorUser activator
mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
case mToken of
Just (Entity uTokenId uToken) -> do
hexSalt <- return $ toHex uSalt
defaultLayout $ do
$(widgetFile "activate")
_ -> do
returnJsonError "Invalid token!"
redirect $ ActivateR token
postActivateR :: Text -> Handler RepJson
postActivateR token = do
msalted <- fromJust <$> lookupPostParam "salted"
salted <- return $ fromHex' $ unpack msalted
mToken <- runDB $ selectFirst [TokenToken ==. (encodeUtf8 token), TokenKind ==. "activate"] []
case mToken of
Just (Entity uTokenId uToken) -> do
newUser <- runDB $ selectFirst [ActivatorToken ==. token] []
case newUser of
Just (Entity aId activ) -> do
-- putting user in active state
uId <- runDB $ insert $ activatorUser activ
runDB $ update uId [UserSalted =. (Just salted)]
-- create user directory
liftIO $ createDirectoryIfMissing True $ "static" </> "data" </> (unpack $ extractKey uId)
-- cleanup
runDB $ delete aId
runDB $ delete uTokenId
-- login and redirect
setSession "userId" (extractKey uId)
welcomeLink <- ($ ProfileR uId) <$> getUrlRender
returnJson ["welcome" .= welcomeLink]
-- redirect $ HomeR
_ -> do
returnJsonError "Invalid activation token!"
returnJson :: (Monad m, ToJSON a, a ~ Value) =>
[(Text, a)] -> m RepJson
returnJson = return . repJson . object
returnJsonError :: Text -> Handler RepJson
returnJsonError = returnJson . (:[]) . ("error" .=)