diff --git a/Foundation.hs b/Foundation.hs index 48b1da0..12e32a3 100644 --- a/Foundation.hs +++ b/Foundation.hs @@ -66,7 +66,7 @@ instance Yesod App where defaultLayout widget = do master <- getYesod mmsg <- getMessage - msu <- lookupSession "username" + msu <- lookupSession "userId" -- We break up the default layout into two components: -- default-layout is the contents of the body tag, and diff --git a/Handler/Login.hs b/Handler/Login.hs index 33c7d1a..15b2384 100644 --- a/Handler/Login.hs +++ b/Handler/Login.hs @@ -1,6 +1,7 @@ module Handler.Login where import Import +import Data.Text data Credentials = Credentials { credentialsName :: Text @@ -24,7 +25,7 @@ postLoginR = do Just user -> do case credentialsPasswd cred == userPassword (entityVal user) of True -> do - setSession "username" $ userName (entityVal user) + setSession "userId" $ pack $ show $ entityKey user setMessage $ [shamlet|
Successfully logged in|]
               redirect $ HomeR
             False -> do
@@ -41,6 +42,6 @@ loginForm = renderDivs $ Credentials
 
 getLogoutR :: Handler Html
 getLogoutR = do
-  deleteSession "username"
+  deleteSession "userId"
   setMessage $ [shamlet|
Succesfully logged out|]
   redirect $ HomeR
diff --git a/Handler/Profile.hs b/Handler/Profile.hs
index 83e8ad3..80168b8 100644
--- a/Handler/Profile.hs
+++ b/Handler/Profile.hs
@@ -3,8 +3,11 @@ module Handler.Profile where
 import Import
 
 getProfileR :: Text -> Handler Html
-getProfileR username = do
-  msu <- lookupSession "username"
-  userMedia <- runDB $ selectList [MediumOwner ==. username] [Desc MediumTime]
-  defaultLayout $ do
-    $(widgetFile "profile")
+getProfileR username = error "reworking logic" -- do
+--  msu <- lookupSession "id"
+--  case msu of
+--    Just tempUserId -> do
+--      userId <- Key $ PersistInt64 $ fromIntegral tempUserId
+--      userMedia <- runDB $ selectList [MediumOwner ==. userId] [Desc MediumTime]
+--      defaultLayout $ do
+--        $(widgetFile "profile")
diff --git a/Handler/Signup.hs b/Handler/Signup.hs
index 491fcdb..ac9fb52 100644
--- a/Handler/Signup.hs
+++ b/Handler/Signup.hs
@@ -44,6 +44,7 @@ signupForm = renderDivs $ User
   <$> areq textField "Username" Nothing
   <*> areq emailField "Email" Nothing
   <*> areq passwordField "Password" Nothing
+  <*> pure []
 
 validateLen :: Text -> Bool
 validateLen a =
diff --git a/Handler/Upload.hs b/Handler/Upload.hs
index cba2808..d37b357 100644
--- a/Handler/Upload.hs
+++ b/Handler/Upload.hs
@@ -4,37 +4,44 @@ import Import as I
 import Data.Time
 import Data.Text
 import System.FilePath
+import Database.Persist.Types
 
 data TempMedium = TempMedium
   { tempMediumTitle :: Text
   , tempMediumFile :: FileInfo
   , tempMediumTime :: UTCTime
-  , tempMediumOwner :: Text
+  , tempMediumOwner :: UserId
   , tempMediumDesc :: Textarea
   , tempMediumTags :: [Text]
   }
 
 getUploadR :: Handler Html
 getUploadR = do
-  msu <- lookupSession "username"
+  msu <- lookupSession "userId"
   case msu of
-    Just username -> do
-      (uploadWidget, enctype) <- generateFormPost (uploadForm username)
+    Just tempUserId -> do
+      userId <- lift $ getUserIdFromText tempUserId
+      (uploadWidget, enctype) <- generateFormPost (uploadForm userId)
       defaultLayout $ do
         $(widgetFile "upload")
     Nothing -> do
       setMessage $ [shamlet|
You need to be logged in|]
       redirect $ LoginR
 
+--getUserIdFromText :: Text -> UserId
+getUserIdFromText tempUserId =
+  Key $ PersistInt64 $ fromIntegral $ read $ unpack tempUserId
+
 postUploadR :: Handler Html
 postUploadR = do
-  msu <- lookupSession "username"
+  msu <- lookupSession "userId"
   case msu of
-    Just username -> do
-      ((result, uploadWidget), enctype) <- runFormPost (uploadForm username)
+    Just tempUserId -> do
+      userId <- lift $ getUserIdFromText tempUserId
+      ((result, uploadWidget), enctype) <- runFormPost (uploadForm userId)
       case result of
         FormSuccess temp -> do
-          path <- writeOnDrive username $ tempMediumFile temp
+          path <- writeOnDrive $ tempMediumFile temp
           medium <- return $ Medium
             (tempMediumTitle temp)
             path
@@ -52,21 +59,26 @@ postUploadR = do
       setMessage $ [shamlet|
You need to be logged in|]
       redirect $ LoginR
 
-writeOnDrive :: Text -> FileInfo -> Handler FilePath
-writeOnDrive username file = do
+writeOnDrive :: FileInfo -> Handler FilePath
+writeOnDrive file = do
   filename <- return $ fileName file
   path <- return $ "static"  (unpack filename)
   liftIO $ fileMove file path
   return path
 
-uploadForm :: Text -> Form TempMedium
-uploadForm username = renderDivs $ TempMedium
+uploadForm :: UserId -> Form TempMedium
+uploadForm userId = renderDivs $ TempMedium
   <$> areq textField "Title" Nothing
   <*> areq fileField "Select file" Nothing
   <*> lift (liftIO getCurrentTime)
-  <*> pure username
+  <*> pure userId
   <*> areq textareaField "Description" Nothing
   <*> areq tagField "Enter tags" Nothing
+--  <*> areq (selectField albums) "Album" Nothing
+--  where
+--    albums :: Handler App App (OptionList AlbumId)
+--    albums = do
+--      runDB $ selectList [AlbumOwner ==. userId] [Desc AlbumTitle]
 
 tagField :: Field Handler [Text]
 tagField = Field
diff --git a/config/models b/config/models
index 3baed98..6011f3c 100644
--- a/config/models
+++ b/config/models
@@ -2,20 +2,25 @@ User
     name Text
     email Text
     password Text
+    albums [AlbumId]
     deriving Typeable
 Token
     token Text
     user User
+    deriving
 Album
     title Text
-    owner Text
+    owner [UserId]
     content [MediumId]
+    deriving
 Medium
     title Text
     path FilePath
     time UTCTime
-    owner Text
+    owner UserId
     description Textarea
     tags [Text]
+    album AlbumId
+    deriving
 
  -- By default this file is used in Model.hs (which is imported by Foundation.hs)
diff --git a/templates/default-layout.hamlet b/templates/default-layout.hamlet
index 5409ec0..e5ab1dd 100644
--- a/templates/default-layout.hamlet
+++ b/templates/default-layout.hamlet
@@ -1,8 +1,8 @@