{-# LANGUAGE TupleSections, OverloadedStrings #-} module Handler.Signup where import Import as I import System.Random import Data.Text as T import Data.Text.Encoding import Data.ByteString as B import Data.Maybe import Network.Mail.Mime import Text.Blaze.Html.Renderer.Utf8 getSignupR :: Handler Html getSignupR = do -- (signupWidget, enctype) <- generateFormPost signupForm defaultLayout $ do $(widgetFile "signup") postSignupR :: Handler Html postSignupR = do mUserName <- lookupPostParam "username" newUserName <- case validateLen (fromJust mUserName) of True -> return $ fromJust $ mUserName False -> do setMessage "Invalid username" redirect $ SignupR mEmail <- lookupPostParam "email" mTos1 <- lookupPostParam "tos-1" mTos2 <- lookupPostParam "tos-2" case (mTos1, mTos2) of (Just "tos-1", Just "tos-2") -> return () _ -> do setMessage "You need to agree to our terms." redirect $ SignupR -- create user namesakes <- runDB $ selectList [UserName ==. newUserName] [] case namesakes of [] -> do salt <- liftIO generateSalt 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 activateLink <- ($ ActivateR activatorText) <$> getUrlRender sendMail (userEmail newUser) "Please activate your account!" $ [shamlet|

Welcome to Eidolon! To complete your sgnup please activate your account by visiting the following link: #{activateLink} |] setMessage "User pending activation" redirect $ HomeR _ -> do setMessage "This user already exists" redirect $ SignupR validateLen :: Text -> Bool validateLen a = (T.length a) > 3