stuff

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|<pre>Invalid Token!|]
+      redirect $ HomeR
+    [x] -> do
+      _ <- runDB $ insert $ tokenUser (entityVal x)
+      setMessage $ [shamlet|<pre>User activated|]
+      redirect $ HomeR
+    _ -> do
+      error "unexpected error"

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"

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|
+              <h1> Welcome to Eidolon!
+              To complete your sgnup please activate your account by visiting the following link
+              <a href="#{activateLink}">#{activateLink}</a>
+            |]
+          setMessage $ [shamlet|<pre>User created|]
+          redirect $ HomeR
+        False -> do
+          setMessage $ [shamlet|<pre>Username error|]
+          redirect $ SignupR
+    _ -> do
+      setMessage $ [shamlet|<pre>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
+        }]]
+      }

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

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)

static/tmp/autogen-SWBGXCgb.js

@@ -0,0 +1 @@
+document.getElementById("hident4").innerHTML="This text was added by the Javascript part of the homepage widget."

static/tmp/autogen-vozS04Wr.css

@@ -0,0 +1,8 @@
+h1 {
+    text-align: center
+;
+}
+h2#hident4 {
+    color: #990
+;
+}

templates/home.hamlet

@@ -0,0 +1,9 @@
+<a href=@{LoginR}>Login
+<a href=@{SignupR}>Signup
+
+$if null recentMedia
+  <p>This gallery is still empty.
+$else
+  $forall (Entity mediaId medium) <- recentMedia
+    <div class="thumbnails">
+      <div class="single">

templates/signup.hamlet

@@ -0,0 +1,6 @@
+<h3>Signup
+
+<form method=post enctype=#{enctype}>
+  ^{signupWidget}
+  <div>
+    <input type=submit value="Register">