diff --git a/Handler/Activate.hs b/Handler/Activate.hs new file mode 100644 index 0000000..c44e6f3 --- /dev/null +++ b/Handler/Activate.hs @@ -0,0 +1,18 @@ +module Handler.Activate where + +import Import as I +import Data.Text as T + +getActivateR :: String -> Handler Html +getActivateR token = do + t <- runDB $ selectList [TokenToken ==. (T.pack token)] [] + case t of + [] -> do + setMessage $ [shamlet|
Invalid Token!|] + redirect $ HomeR + [x] -> do + _ <- runDB $ insert $ tokenUser (entityVal x) + setMessage $ [shamlet|User activated|] + redirect $ HomeR + _ -> do + error "unexpected error" diff --git a/Handler/Login.hs b/Handler/Login.hs new file mode 100644 index 0000000..b9fa9bb --- /dev/null +++ b/Handler/Login.hs @@ -0,0 +1,9 @@ +module Handler.Login where + +import Import + +getLoginR :: Handler Html +getLoginR = error "Not yet implemented: getLoginR" + +postLoginR :: Handler Html +postLoginR = error "Not yet implemented: postLoginR" diff --git a/Handler/Signup.hs b/Handler/Signup.hs new file mode 100644 index 0000000..23cf419 --- /dev/null +++ b/Handler/Signup.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE TupleSections, OverloadedStrings #-} +module Handler.Signup where + +import Import as I +import System.Random +import Data.Text as T +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 + ((result, signupWidget), enctype) <- runFormPost signupForm + case result of + FormSuccess user -> do + namesakes <- runDB $ selectList [UserName ==. (userName user)] [] + case (validateLen (userName user)) && ((I.length namesakes) == 0) of + True -> do + tokenString <- liftIO generateString + uId <- runDB $ insert $ Token tokenString user + activateLink <- ($ ActivateR $ T.unpack tokenString) <$> getUrlRender + sendMail (userEmail user) "Please activate your account!" $ + [shamlet| +Welcome to Eidolon! + To complete your sgnup please activate your account by visiting the following link + #{activateLink} + |] + setMessage $ [shamlet|
User created|] + redirect $ HomeR + False -> do + setMessage $ [shamlet|Username error|] + redirect $ SignupR + _ -> do + setMessage $ [shamlet|Please try again|] + redirect $ SignupR + +signupForm :: Form User +signupForm = renderDivs $ User + <$> areq textField "Username" Nothing + <*> areq emailField "Email" Nothing + <*> areq passwordField "Password" Nothing + +validateLen :: Text -> Bool +validateLen a = + (T.length a) > 3 + +generateString :: IO Text +generateString = (T.pack . I.take 16 . randoms) <$> newStdGen + +sendMail :: MonadIO m => Text -> Text -> Html -> m () +sendMail toEmail subject body = + liftIO $ renderSendMail + Mail + { mailFrom = Address Nothing "noreply" -- TODO: set sender Address + , mailTo = [Address Nothing toEmail] + , mailCc = [] + , mailBcc = [] + , mailHeaders = [("Subject", subject)] + , mailParts = [[Part + { partType = "text/html; charset=utf-8" + , partEncoding = None + , partFilename = Nothing + , partHeaders = [] + , partContent = renderHtml body + }]] + } diff --git a/Model.hs b/Model.hs index 5de285c..f99ab04 100644 --- a/Model.hs +++ b/Model.hs @@ -4,6 +4,8 @@ import Yesod import Data.Text (Text) import Database.Persist.Quasi import Data.Typeable (Typeable) +import Data.Time (UTCTime) +import System.FilePath (FilePath) -- You can define all of your database entities in the entities file. -- You can find more information on persistent and how to declare entities diff --git a/eidolon.cabal b/eidolon.cabal index 0bec6c2..9553427 100644 --- a/eidolon.cabal +++ b/eidolon.cabal @@ -44,32 +44,38 @@ library NoMonomorphismRestriction DeriveDataTypeable - build-depends: base >= 4 && < 5 - , yesod >= 1.2.5 && < 1.3 - , yesod-core >= 1.2.12 && < 1.3 - , yesod-auth >= 1.3 && < 1.4 - , yesod-static >= 1.2 && < 1.3 - , yesod-form >= 1.3 && < 1.4 - , bytestring >= 0.9 && < 0.11 - , text >= 0.11 && < 2.0 - , persistent >= 1.3 && < 1.4 - , persistent-sqlite >= 1.3 && < 1.4 - , persistent-template >= 1.3 && < 1.4 + build-depends: base >= 4 + , yesod >= 1.2.5 + , yesod-core >= 1.2.12 + , yesod-auth >= 1.3 + , yesod-static >= 1.2 + , yesod-form >= 1.3 + , bytestring >= 0.9 + , text >= 0.11 + , persistent >= 1.3 + , persistent-sqlite >= 1.3 + , persistent-template >= 1.3 , template-haskell - , shakespeare >= 2.0 && < 2.1 - , hjsmin >= 0.1 && < 0.2 - , monad-control >= 0.3 && < 0.4 - , wai-extra >= 3.0 && < 3.1 - , yaml >= 0.8 && < 0.9 - , http-conduit >= 2.1 && < 2.2 - , directory >= 1.1 && < 1.3 - , warp >= 3.0 && < 3.1 + , shakespeare >= 2.0 + , hjsmin >= 0.1 + , monad-control >= 0.3 + , wai-extra >= 3.0 + , yaml >= 0.8 + , http-conduit >= 2.1 + , directory >= 1.1 + , warp >= 3.0 , data-default - , aeson >= 0.6 && < 0.8 - , conduit >= 1.0 && < 2.0 - , monad-logger >= 0.3 && < 0.4 - , fast-logger >= 2.1.4 && < 2.2 - , wai-logger >= 2.1 && < 2.2 + , aeson >= 0.6 + , conduit >= 1.0 + , monad-logger >= 0.3 + , fast-logger >= 2.1.4 + , wai-logger >= 2.1 + -- custom dependencies + , random + , mime-mail + , blaze-html + , filepath + , time executable eidolon if flag(library-only) diff --git a/static/tmp/autogen-SWBGXCgb.js b/static/tmp/autogen-SWBGXCgb.js new file mode 100644 index 0000000..dd273a1 --- /dev/null +++ b/static/tmp/autogen-SWBGXCgb.js @@ -0,0 +1 @@ +document.getElementById("hident4").innerHTML="This text was added by the Javascript part of the homepage widget." \ No newline at end of file diff --git a/static/tmp/autogen-vozS04Wr.css b/static/tmp/autogen-vozS04Wr.css new file mode 100644 index 0000000..b8e1b5c --- /dev/null +++ b/static/tmp/autogen-vozS04Wr.css @@ -0,0 +1,8 @@ +h1 { + text-align: center +; +} +h2#hident4 { + color: #990 +; +} diff --git a/templates/home.hamlet b/templates/home.hamlet new file mode 100644 index 0000000..d87a9f1 --- /dev/null +++ b/templates/home.hamlet @@ -0,0 +1,9 @@ +Login +Signup + +$if null recentMedia +This gallery is still empty. +$else + $forall (Entity mediaId medium) <- recentMedia +
+diff --git a/templates/signup.hamlet b/templates/signup.hamlet new file mode 100644 index 0000000..534b6d9 --- /dev/null +++ b/templates/signup.hamlet @@ -0,0 +1,6 @@ +Signup + +