more integration
This commit is contained in:
parent
be32449430
commit
224ebb9c9d
15 changed files with 335 additions and 326 deletions
|
@ -49,7 +49,7 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger),
|
||||||
-- Don't forget to add new modules to your cabal file!
|
-- Don't forget to add new modules to your cabal file!
|
||||||
import Handler.Home
|
import Handler.Home
|
||||||
-- import Handler.Signup
|
-- import Handler.Signup
|
||||||
-- import Handler.Login
|
import Handler.Login
|
||||||
-- import Handler.Activate
|
-- import Handler.Activate
|
||||||
-- import Handler.Reactivate
|
-- import Handler.Reactivate
|
||||||
import Handler.Profile
|
import Handler.Profile
|
||||||
|
|
|
@ -163,7 +163,24 @@ instance Yesod App where
|
||||||
-- urlRenderOverride _ _ = Nothing
|
-- urlRenderOverride _ _ = Nothing
|
||||||
|
|
||||||
-- The page to be redirected to when authentication is required.
|
-- The page to be redirected to when authentication is required.
|
||||||
-- authRoute _ = Just $ AuthR LoginR
|
authRoute _ = Just $ AuthR LoginR
|
||||||
|
|
||||||
|
isAuthorized AdminR _ = getAdminAuth
|
||||||
|
isAuthorized AdminProfilesR _ = getAdminAuth
|
||||||
|
isAuthorized (AdminProfileSettingsR _) _ = getAdminAuth
|
||||||
|
isAuthorized (AdminUserAlbumsR _) _ = getAdminAuth
|
||||||
|
isAuthorized (AdminUserMediaR _) _ = getAdminAuth
|
||||||
|
isAuthorized (AdminProfileDeleteR _) _ = getAdminAuth
|
||||||
|
isAuthorized AdminAlbumsR _ = getAdminAuth
|
||||||
|
isAuthorized (AdminAlbumSettingsR _) _ = getAdminAuth
|
||||||
|
isAuthorized (AdminAlbumMediaR _) _ = getAdminAuth
|
||||||
|
isAuthorized (AdminAlbumDeleteR _) _ = getAdminAuth
|
||||||
|
isAuthorized AdminMediaR _ = getAdminAuth
|
||||||
|
isAuthorized (AdminMediumSettingsR _) _ = getAdminAuth
|
||||||
|
isAuthorized (AdminMediumDeleteR _) _ = getAdminAuth
|
||||||
|
isAuthorized AdminCommentR _ = getAdminAuth
|
||||||
|
isAuthorized (AdminCommentDeleteR _) _ = getAdminAuth
|
||||||
|
isAuthorized _ _ = return Authorized
|
||||||
|
|
||||||
-- This function creates static content files in the static folder
|
-- This function creates static content files in the static folder
|
||||||
-- and names them based on a hash of their content. This allows
|
-- and names them based on a hash of their content. This allows
|
||||||
|
@ -196,6 +213,20 @@ instance Yesod App where
|
||||||
|
|
||||||
makeLogger = return . appLogger
|
makeLogger = return . appLogger
|
||||||
|
|
||||||
|
getAdminAuth = do
|
||||||
|
musername <- maybeAuthId
|
||||||
|
case musername of
|
||||||
|
Nothing -> return AuthenticationRequired
|
||||||
|
Just un -> do
|
||||||
|
muser <- runDB $ getBy $ UniqueUser un
|
||||||
|
return $ case muser of
|
||||||
|
Just (Entity _ u)
|
||||||
|
| isAdmin u -> Authorized
|
||||||
|
| otherwise -> Unauthorized "You are not authorized"
|
||||||
|
Nothing -> AuthenticationRequired
|
||||||
|
|
||||||
|
isAdmin = userAdmin
|
||||||
|
|
||||||
-- How to run database actions.
|
-- How to run database actions.
|
||||||
instance YesodPersist App where
|
instance YesodPersist App where
|
||||||
type YesodPersistBackend App = SqlBackend
|
type YesodPersistBackend App = SqlBackend
|
||||||
|
@ -240,6 +271,7 @@ instance RenderMessage App FormMessage where
|
||||||
|
|
||||||
instance YesodHmacKeccak (HmacPersistDB App User Token) App where
|
instance YesodHmacKeccak (HmacPersistDB App User Token) App where
|
||||||
runHmacDB = runHmacPersistDB
|
runHmacDB = runHmacPersistDB
|
||||||
|
rawLoginRoute = Just LoginRawR
|
||||||
|
|
||||||
instance UserCredentials (Entity User) where
|
instance UserCredentials (Entity User) where
|
||||||
userUserName = userName . entityVal
|
userUserName = userName . entityVal
|
||||||
|
|
|
@ -31,15 +31,14 @@ getAlbumR albumId = do
|
||||||
let ownerId = albumOwner album
|
let ownerId = albumOwner album
|
||||||
owner <- runDB $ getJust ownerId
|
owner <- runDB $ getJust ownerId
|
||||||
let ownerName = userName owner
|
let ownerName = userName owner
|
||||||
let ownerSlug = userSlug owner
|
ownerSlug = userSlug owner
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
presence <- case msu of
|
presence <- case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity uId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
return $ (userId == ownerId) || (userId `elem` albumShares album)
|
return $ (username == ownerName) || (uId `elem` albumShares album)
|
||||||
Nothing ->
|
Nothing ->
|
||||||
return False
|
return False
|
||||||
-- media <- mapM (\a -> runDB $ getJust a) (albumContent album)
|
|
||||||
media <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTime]
|
media <- runDB $ selectList [MediumAlbum ==. albumId] [Desc MediumTime]
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle $ toHtml ("Eidolon :: Album " `T.append` albumTitle album)
|
setTitle $ toHtml ("Eidolon :: Album " `T.append` albumTitle album)
|
||||||
|
|
|
@ -28,14 +28,14 @@ getAlbumSettingsR albumId = do
|
||||||
case tempAlbum of
|
case tempAlbum of
|
||||||
Just album -> do
|
Just album -> do
|
||||||
let ownerId = albumOwner album
|
let ownerId = albumOwner album
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity uId u)) <- runDB $ getBy $ UniqueUser username
|
||||||
let ownerPresence = userId == ownerId
|
let ownerPresence = uId == ownerId
|
||||||
let presence = userId `elem` (albumShares album)
|
presence = uId `elem` (albumShares album)
|
||||||
case ownerPresence || presence of
|
if ownerPresence || presence
|
||||||
True -> do
|
then do
|
||||||
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
|
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
|
||||||
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
|
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
|
||||||
(albumSettingsWidget, enctype) <- generateFormPost $
|
(albumSettingsWidget, enctype) <- generateFormPost $
|
||||||
|
@ -44,7 +44,7 @@ getAlbumSettingsR albumId = do
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle "Eidolon :: Album Settings"
|
setTitle "Eidolon :: Album Settings"
|
||||||
$(widgetFile "albumSettings")
|
$(widgetFile "albumSettings")
|
||||||
False -> do
|
else do
|
||||||
setMessage "You must own this album to change its settings"
|
setMessage "You must own this album to change its settings"
|
||||||
redirect $ AlbumR albumId
|
redirect $ AlbumR albumId
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
|
@ -62,14 +62,13 @@ postAlbumSettingsR albumId = do
|
||||||
let ownerId = albumOwner album
|
let ownerId = albumOwner album
|
||||||
owner <- runDB $ getJust ownerId
|
owner <- runDB $ getJust ownerId
|
||||||
let ownerName = userName owner
|
let ownerName = userName owner
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity uId u)) <- runDB $ getBy $ UniqueUser username
|
||||||
let ownerPresence = userId == ownerId
|
let ownerPresence = uId == ownerId
|
||||||
let presence = userId `elem` albumShares album
|
presence = uId `elem` albumShares album
|
||||||
if
|
if ownerPresence || presence
|
||||||
ownerPresence || presence
|
|
||||||
then do
|
then do
|
||||||
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
|
entities <- runDB $ selectList [UserId !=. (albumOwner album)] [Desc UserName]
|
||||||
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
|
let users = map (\u -> (userName $ entityVal u, entityKey u)) entities
|
||||||
|
@ -85,12 +84,12 @@ postAlbumSettingsR albumId = do
|
||||||
then do
|
then do
|
||||||
link <- ($ AlbumR albumId) <$> getUrlRender
|
link <- ($ AlbumR albumId) <$> getUrlRender
|
||||||
let rcptIds = L.nub $ newShares L.\\ oldShares
|
let rcptIds = L.nub $ newShares L.\\ oldShares
|
||||||
mapM (\uId -> do
|
mapM (\id -> do
|
||||||
-- update userAlbums
|
-- update userAlbums
|
||||||
user <- runDB $ getJust uId
|
user <- runDB $ getJust id
|
||||||
let oldAlbs = userAlbums user
|
let oldAlbs = userAlbums user
|
||||||
let newAlbs = albumId : oldAlbs
|
newAlbs = albumId : oldAlbs
|
||||||
_ <- runDB $ update uId [UserAlbums =. newAlbs]
|
_ <- runDB $ update id [UserAlbums =. newAlbs]
|
||||||
-- send notification
|
-- send notification
|
||||||
let addr = userEmail user
|
let addr = userEmail user
|
||||||
sendMail addr "A new album was shared with you" $
|
sendMail addr "A new album was shared with you" $
|
||||||
|
@ -145,12 +144,11 @@ getAlbumDeleteR albumId = do
|
||||||
case tempAlbum of
|
case tempAlbum of
|
||||||
Just album -> do
|
Just album -> do
|
||||||
let ownerId = albumOwner album
|
let ownerId = albumOwner album
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity uId u)) <- runDB $ getBy $ UniqueUser username
|
||||||
if
|
if uId == ownerId
|
||||||
userId == ownerId
|
|
||||||
then do
|
then do
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle $ toHtml ("Eidolon :: Delete album" `T.append` (albumTitle album))
|
setTitle $ toHtml ("Eidolon :: Delete album" `T.append` (albumTitle album))
|
||||||
|
@ -172,12 +170,11 @@ postAlbumDeleteR albumId = do
|
||||||
Just album -> do
|
Just album -> do
|
||||||
let ownerId = albumOwner album
|
let ownerId = albumOwner album
|
||||||
owner <- runDB $ getJust ownerId
|
owner <- runDB $ getJust ownerId
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity uId u)) <- runDB $ getBy $ UniqueUser username
|
||||||
if
|
if uId == ownerId
|
||||||
userId == ownerId
|
|
||||||
then do
|
then do
|
||||||
confirm <- lookupPostParam "confirm"
|
confirm <- lookupPostParam "confirm"
|
||||||
case confirm of
|
case confirm of
|
||||||
|
@ -208,7 +205,7 @@ postAlbumDeleteR albumId = do
|
||||||
-- delete album
|
-- delete album
|
||||||
runDB $ delete albumId
|
runDB $ delete albumId
|
||||||
-- delete files
|
-- delete files
|
||||||
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey userId) </> T.unpack (extractKey albumId)
|
liftIO $ removeDirectoryRecursive $ "static" </> "data" </> T.unpack (extractKey uId) </> T.unpack (extractKey albumId)
|
||||||
-- outro
|
-- outro
|
||||||
setMessage "Album deleted succesfully"
|
setMessage "Album deleted succesfully"
|
||||||
redirect HomeR
|
redirect HomeR
|
||||||
|
|
|
@ -39,11 +39,10 @@ import Debug.Trace
|
||||||
|
|
||||||
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
|
loginIsAdmin :: IsString t => Handler (Either (t, Route App) ())
|
||||||
loginIsAdmin = do
|
loginIsAdmin = do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
|
||||||
user <- runDB $ getJust userId
|
|
||||||
if
|
if
|
||||||
userAdmin user
|
userAdmin user
|
||||||
then
|
then
|
||||||
|
@ -58,10 +57,10 @@ profileCheck userId = do
|
||||||
tempUser <- runDB $ get userId
|
tempUser <- runDB $ get userId
|
||||||
case tempUser of
|
case tempUser of
|
||||||
Just user -> do
|
Just user -> do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempLoginId -> do
|
Just username -> do
|
||||||
let loginId = getUserIdFromText tempLoginId
|
(Just (Entity loginId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
if
|
if
|
||||||
loginId == userId
|
loginId == userId
|
||||||
then
|
then
|
||||||
|
@ -79,13 +78,13 @@ mediumCheck mediumId = do
|
||||||
case tempMedium of
|
case tempMedium of
|
||||||
Just medium -> do
|
Just medium -> do
|
||||||
let ownerId = mediumOwner medium
|
let ownerId = mediumOwner medium
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
album <- runDB $ getJust $ mediumAlbum medium
|
album <- runDB $ getJust $ mediumAlbum medium
|
||||||
let presence = userId == ownerId
|
let presence = userId == ownerId
|
||||||
let albumOwnerPresence = userId == albumOwner album
|
albumOwnerPresence = userId == albumOwner album
|
||||||
if
|
if
|
||||||
presence || albumOwnerPresence
|
presence || albumOwnerPresence
|
||||||
then
|
then
|
||||||
|
|
120
Handler/Login.hs
120
Handler/Login.hs
|
@ -34,8 +34,67 @@ import qualified Data.ByteString as B
|
||||||
import qualified Data.ByteString.Char8 as BC
|
import qualified Data.ByteString.Char8 as BC
|
||||||
import Data.Aeson.Types
|
import Data.Aeson.Types
|
||||||
|
|
||||||
getLoginR :: Handler Html
|
-- getLoginR :: Handler Html
|
||||||
getLoginR = do
|
-- getLoginR = do
|
||||||
|
-- master <- getYesod
|
||||||
|
-- let addWarn = "http://" `T.isPrefixOf` appRoot (appSettings master)
|
||||||
|
-- (loginRawWidget, _) <- generateFormPost $
|
||||||
|
-- renderBootstrap3 BootstrapBasicForm loginForm
|
||||||
|
-- defaultLayout $ do
|
||||||
|
-- setTitle "Eidolon :: Login"
|
||||||
|
-- $(widgetFile "login")
|
||||||
|
|
||||||
|
|
||||||
|
-- postLoginR :: Handler RepJson
|
||||||
|
-- postLoginR = do
|
||||||
|
-- mUserName <- lookupPostParam "username"
|
||||||
|
-- mHexToken <- lookupPostParam "token"
|
||||||
|
-- mHexResponse <- lookupPostParam "response"
|
||||||
|
-- case (mUserName, mHexToken, mHexResponse) of
|
||||||
|
-- (Just userName, Nothing, Nothing) -> do
|
||||||
|
-- tempUser <- runDB $ getBy $ UniqueUser userName
|
||||||
|
-- case tempUser of
|
||||||
|
-- Just (Entity userId user) -> do
|
||||||
|
-- let salt = userSalt user
|
||||||
|
-- token <- liftIO makeRandomToken
|
||||||
|
-- runDB $ insert_ $ Token (encodeUtf8 token) "login" userName
|
||||||
|
-- returnJson ["salt" .= toHex salt, "token" .= toHex (encodeUtf8 token)]
|
||||||
|
-- Nothing ->
|
||||||
|
-- returnJsonError ("No such user" :: T.Text)
|
||||||
|
-- (Nothing, Just hexToken, Just hexResponse) -> do
|
||||||
|
-- response <- do
|
||||||
|
-- let tempToken = fromHex' $ T.unpack hexToken
|
||||||
|
-- savedToken <- runDB $ selectFirst [TokenKind ==. "login", TokenToken ==. tempToken] []
|
||||||
|
-- case savedToken of
|
||||||
|
-- Just (Entity tokenId token) -> do
|
||||||
|
-- let savedUserName = tokenUsername token
|
||||||
|
-- mqueriedUser <- runDB $ getBy $ UniqueUser savedUserName
|
||||||
|
-- let queriedUser = entityVal $ fromJust mqueriedUser
|
||||||
|
-- salted = userSalted queriedUser
|
||||||
|
-- hexSalted = toHex salted
|
||||||
|
-- expected = hmacKeccak (encodeUtf8 $ toHex $ tokenToken token) (encodeUtf8 hexSalted)
|
||||||
|
-- if encodeUtf8 hexResponse == expected
|
||||||
|
-- then do
|
||||||
|
-- -- Success!!
|
||||||
|
-- runDB $ delete tokenId
|
||||||
|
-- return $ Right $ (entityKey $ fromJust mqueriedUser)
|
||||||
|
-- else
|
||||||
|
-- return $ Left ("Wrong password" :: T.Text)
|
||||||
|
-- Nothing ->
|
||||||
|
-- return $ Left "Invalid token"
|
||||||
|
-- case response of
|
||||||
|
-- Left msg ->
|
||||||
|
-- returnJsonError msg
|
||||||
|
-- Right userId -> do
|
||||||
|
-- setSession "userId" $ extractKey userId
|
||||||
|
-- setMessage "Succesfully logged in"
|
||||||
|
-- welcomeLink <- ($ProfileR userId) <$> getUrlRender
|
||||||
|
-- returnJson ["welcome" .= welcomeLink]
|
||||||
|
-- _ ->
|
||||||
|
-- returnJsonError ("Protocol error" :: T.Text)
|
||||||
|
|
||||||
|
getLoginRawR :: Handler Html
|
||||||
|
getLoginRawR = do
|
||||||
master <- getYesod
|
master <- getYesod
|
||||||
let addWarn = "http://" `T.isPrefixOf` appRoot (appSettings master)
|
let addWarn = "http://" `T.isPrefixOf` appRoot (appSettings master)
|
||||||
(loginRawWidget, _) <- generateFormPost $
|
(loginRawWidget, _) <- generateFormPost $
|
||||||
|
@ -44,55 +103,6 @@ getLoginR = do
|
||||||
setTitle "Eidolon :: Login"
|
setTitle "Eidolon :: Login"
|
||||||
$(widgetFile "login")
|
$(widgetFile "login")
|
||||||
|
|
||||||
|
|
||||||
postLoginR :: Handler RepJson
|
|
||||||
postLoginR = do
|
|
||||||
mUserName <- lookupPostParam "username"
|
|
||||||
mHexToken <- lookupPostParam "token"
|
|
||||||
mHexResponse <- lookupPostParam "response"
|
|
||||||
case (mUserName, mHexToken, mHexResponse) of
|
|
||||||
(Just userName, Nothing, Nothing) -> do
|
|
||||||
tempUser <- runDB $ getBy $ UniqueUser userName
|
|
||||||
case tempUser of
|
|
||||||
Just (Entity userId user) -> do
|
|
||||||
let salt = userSalt user
|
|
||||||
token <- liftIO makeRandomToken
|
|
||||||
runDB $ insert_ $ Token (encodeUtf8 token) "login" userName
|
|
||||||
returnJson ["salt" .= toHex salt, "token" .= toHex (encodeUtf8 token)]
|
|
||||||
Nothing ->
|
|
||||||
returnJsonError ("No such user" :: T.Text)
|
|
||||||
(Nothing, Just hexToken, Just hexResponse) -> do
|
|
||||||
response <- do
|
|
||||||
let tempToken = fromHex' $ T.unpack hexToken
|
|
||||||
savedToken <- runDB $ selectFirst [TokenKind ==. "login", TokenToken ==. tempToken] []
|
|
||||||
case savedToken of
|
|
||||||
Just (Entity tokenId token) -> do
|
|
||||||
let savedUserName = tokenUsername token
|
|
||||||
mqueriedUser <- runDB $ getBy $ UniqueUser savedUserName
|
|
||||||
let queriedUser = entityVal $ fromJust mqueriedUser
|
|
||||||
salted = userSalted queriedUser
|
|
||||||
hexSalted = toHex salted
|
|
||||||
expected = hmacKeccak (encodeUtf8 $ toHex $ tokenToken token) (encodeUtf8 hexSalted)
|
|
||||||
if encodeUtf8 hexResponse == expected
|
|
||||||
then do
|
|
||||||
-- Success!!
|
|
||||||
runDB $ delete tokenId
|
|
||||||
return $ Right $ (entityKey $ fromJust mqueriedUser)
|
|
||||||
else
|
|
||||||
return $ Left ("Wrong password" :: T.Text)
|
|
||||||
Nothing ->
|
|
||||||
return $ Left "Invalid token"
|
|
||||||
case response of
|
|
||||||
Left msg ->
|
|
||||||
returnJsonError msg
|
|
||||||
Right userId -> do
|
|
||||||
setSession "userId" $ extractKey userId
|
|
||||||
setMessage "Succesfully logged in"
|
|
||||||
welcomeLink <- ($ProfileR userId) <$> getUrlRender
|
|
||||||
returnJson ["welcome" .= welcomeLink]
|
|
||||||
_ ->
|
|
||||||
returnJsonError ("Protocol error" :: T.Text)
|
|
||||||
|
|
||||||
postLoginRawR :: Handler Html
|
postLoginRawR :: Handler Html
|
||||||
postLoginRawR = do
|
postLoginRawR = do
|
||||||
((res, _), _) <- runFormPost $
|
((res, _), _) <- runFormPost $
|
||||||
|
@ -105,18 +115,18 @@ postLoginRawR = do
|
||||||
let testSalted = BC.unpack $ hmacKeccak (userSalt user) (encodeUtf8 $ credentialsPasswd cred)
|
let testSalted = BC.unpack $ hmacKeccak (userSalt user) (encodeUtf8 $ credentialsPasswd cred)
|
||||||
if fromHex' testSalted == userSalted user
|
if fromHex' testSalted == userSalted user
|
||||||
then do
|
then do
|
||||||
setSession "userId" $ extractKey uId
|
setCreds False $ Creds "raw" (userName user) []
|
||||||
setMessage "Successfully logged in"
|
setMessage "Successfully logged in"
|
||||||
redirect $ ProfileR uId
|
redirect $ ProfileR uId
|
||||||
else do
|
else do
|
||||||
setMessage "Wrong password"
|
setMessage "Wrong password"
|
||||||
redirect LoginR
|
redirect $ AuthR LoginR
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
setMessage "No such user"
|
setMessage "No such user"
|
||||||
redirect LoginR
|
redirect $ AuthR LoginR
|
||||||
_ -> do
|
_ -> do
|
||||||
setMessage "Login error"
|
setMessage "Login error"
|
||||||
redirect LoginR
|
redirect $ AuthR LoginR
|
||||||
|
|
||||||
data Credentials = Credentials
|
data Credentials = Credentials
|
||||||
{ credentialsName :: Text
|
{ credentialsName :: Text
|
||||||
|
|
|
@ -36,10 +36,11 @@ getMediumR mediumId = do
|
||||||
let ownerName = userName owner
|
let ownerName = userName owner
|
||||||
let albumId = mediumAlbum medium
|
let albumId = mediumAlbum medium
|
||||||
album <- runDB $ getJust albumId
|
album <- runDB $ getJust albumId
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
userId <- case msu of
|
userId <- case musername of
|
||||||
Just tempUserId ->
|
Just username -> do
|
||||||
return $ Just $ getUserIdFromText tempUserId
|
(Just (Entity uId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
|
return $ Just uId
|
||||||
Nothing ->
|
Nothing ->
|
||||||
return Nothing
|
return Nothing
|
||||||
let presence = userId == (Just ownerId) || userId == Just (albumOwner album)
|
let presence = userId == (Just ownerId) || userId == Just (albumOwner album)
|
||||||
|
@ -56,15 +57,20 @@ getMediumR mediumId = do
|
||||||
[ CommentOrigin ==. mediumId
|
[ CommentOrigin ==. mediumId
|
||||||
, CommentParent !=. Nothing ]
|
, CommentParent !=. Nothing ]
|
||||||
[ Asc CommentTime ]
|
[ Asc CommentTime ]
|
||||||
let tr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []
|
let tr = StaticR $ StaticRoute
|
||||||
pr = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPreview medium) []
|
(drop 2 $ map T.pack $ splitDirectories $ mediumThumb medium) []
|
||||||
ir = StaticR $ StaticRoute (drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []
|
pr = StaticR $ StaticRoute
|
||||||
|
(drop 2 $ map T.pack $ splitDirectories $ mediumPreview medium) []
|
||||||
|
ir = StaticR $ StaticRoute
|
||||||
|
(drop 2 $ map T.pack $ splitDirectories $ mediumPath medium) []
|
||||||
lic = T.pack $ show (toEnum (mediumLicence medium) :: Licence)
|
lic = T.pack $ show (toEnum (mediumLicence medium) :: Licence)
|
||||||
link = url (toEnum (mediumLicence medium) :: Licence)
|
link = url (toEnum (mediumLicence medium) :: Licence)
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle $ toHtml ("Eidolon :: Medium " `T.append` (mediumTitle medium))
|
setTitle $ toHtml ("Eidolon :: Medium " `T.append` (mediumTitle medium))
|
||||||
rssLink (CommentFeedRssR mediumId) $ "Comment feed of medium " `T.append` mediumTitle medium
|
rssLink (CommentFeedRssR mediumId) $
|
||||||
atomLink (CommentFeedAtomR mediumId) $ "Comment feed of medium " `T.append` mediumTitle medium
|
"Comment feed of medium " `T.append` mediumTitle medium
|
||||||
|
atomLink (CommentFeedAtomR mediumId) $
|
||||||
|
"Comment feed of medium " `T.append` mediumTitle medium
|
||||||
$(widgetFile "medium")
|
$(widgetFile "medium")
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
setMessage "This image does not exist"
|
setMessage "This image does not exist"
|
||||||
|
@ -75,11 +81,10 @@ postMediumR mediumId = do
|
||||||
tempMedium <- runDB $ get mediumId
|
tempMedium <- runDB $ get mediumId
|
||||||
case tempMedium of
|
case tempMedium of
|
||||||
Just medium -> do
|
Just medium -> do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId u)) <- runDB $ getBy $ UniqueUser username
|
||||||
u <- runDB $ getJust userId
|
|
||||||
let userSl = userSlug u
|
let userSl = userSlug u
|
||||||
((res, _), _) <- runFormPost $
|
((res, _), _) <- runFormPost $
|
||||||
renderBootstrap3 BootstrapBasicForm $
|
renderBootstrap3 BootstrapBasicForm $
|
||||||
|
@ -126,10 +131,10 @@ getCommentReplyR commentId = do
|
||||||
tempComment <- runDB $ get commentId
|
tempComment <- runDB $ get commentId
|
||||||
case tempComment of
|
case tempComment of
|
||||||
Just comment -> do
|
Just comment -> do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
let mediumId = commentOrigin comment
|
let mediumId = commentOrigin comment
|
||||||
parAuth <- runDB $ get $ commentAuthor comment
|
parAuth <- runDB $ get $ commentAuthor comment
|
||||||
let parSlug = fromMaybe "" $ userSlug <$> parAuth
|
let parSlug = fromMaybe "" $ userSlug <$> parAuth
|
||||||
|
@ -151,13 +156,12 @@ postCommentReplyR commentId = do
|
||||||
tempComment <- runDB $ get commentId
|
tempComment <- runDB $ get commentId
|
||||||
case tempComment of
|
case tempComment of
|
||||||
Just comment -> do
|
Just comment -> do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId u)) <- runDB $ getBy $ UniqueUser username
|
||||||
u <- runDB $ getJust userId
|
|
||||||
let userSl = userSlug u
|
let userSl = userSlug u
|
||||||
let mediumId = commentOrigin comment
|
mediumId = commentOrigin comment
|
||||||
((res, _), _) <- runFormPost $
|
((res, _), _) <- runFormPost $
|
||||||
renderBootstrap3 BootstrapBasicForm $
|
renderBootstrap3 BootstrapBasicForm $
|
||||||
commentForm userId mediumId (Just commentId)
|
commentForm userId mediumId (Just commentId)
|
||||||
|
@ -208,10 +212,10 @@ getCommentDeleteR commentId = do
|
||||||
tempComment <- runDB $ get commentId
|
tempComment <- runDB $ get commentId
|
||||||
case tempComment of
|
case tempComment of
|
||||||
Just comment -> do
|
Just comment -> do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
if
|
if
|
||||||
Just userId == Just (commentAuthor comment)
|
Just userId == Just (commentAuthor comment)
|
||||||
then do
|
then do
|
||||||
|
@ -233,10 +237,10 @@ postCommentDeleteR commentId = do
|
||||||
tempComment <- runDB $ get commentId
|
tempComment <- runDB $ get commentId
|
||||||
case tempComment of
|
case tempComment of
|
||||||
Just comment -> do
|
Just comment -> do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
if
|
if
|
||||||
Just userId == Just (commentAuthor comment)
|
Just userId == Just (commentAuthor comment)
|
||||||
then do
|
then do
|
||||||
|
|
|
@ -119,20 +119,6 @@ postMediumDeleteR mediumId = do
|
||||||
confirm <- lookupPostParam "confirm"
|
confirm <- lookupPostParam "confirm"
|
||||||
case confirm of
|
case confirm of
|
||||||
Just "confirm" -> do
|
Just "confirm" -> do
|
||||||
-- -- delete comments
|
|
||||||
-- commEnts <- runDB $ selectList [CommentOrigin ==. mediumId] []
|
|
||||||
-- _ <- mapM (runDB . delete . entityKey) commEnts
|
|
||||||
-- -- delete references first
|
|
||||||
-- let albumId = mediumAlbum medium
|
|
||||||
-- album <- runDB $ getJust albumId
|
|
||||||
-- let mediaList = albumContent album
|
|
||||||
-- let newMediaList = removeItem mediumId mediaList
|
|
||||||
-- -- update reference List
|
|
||||||
-- runDB $ update albumId [AlbumContent =. newMediaList]
|
|
||||||
-- liftIO $ removeFile (normalise $ tail $ mediumPath medium)
|
|
||||||
-- liftIO $ removeFile (normalise $ tail $ mediumThumb medium)
|
|
||||||
-- liftIO $ removeFile (normalise $ tail $ mediumPreview medium)
|
|
||||||
-- runDB $ delete mediumId
|
|
||||||
deleteMedium mediumId medium
|
deleteMedium mediumId medium
|
||||||
setMessage "Medium succesfully deleted"
|
setMessage "Medium succesfully deleted"
|
||||||
redirect HomeR
|
redirect HomeR
|
||||||
|
|
|
@ -25,10 +25,10 @@ import System.FilePath
|
||||||
|
|
||||||
getNewAlbumR :: Handler Html
|
getNewAlbumR :: Handler Html
|
||||||
getNewAlbumR = do
|
getNewAlbumR = do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
userId <- lift $ pure $ getUserIdFromText tempUserId
|
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
(albumWidget, enctype) <- generateFormPost $
|
(albumWidget, enctype) <- generateFormPost $
|
||||||
renderBootstrap3 BootstrapBasicForm $
|
renderBootstrap3 BootstrapBasicForm $
|
||||||
albumForm userId
|
albumForm userId
|
||||||
|
@ -41,10 +41,10 @@ getNewAlbumR = do
|
||||||
|
|
||||||
postNewAlbumR :: Handler Html
|
postNewAlbumR :: Handler Html
|
||||||
postNewAlbumR = do
|
postNewAlbumR = do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId _)) <- runDB $ getBy $ UniqueUser username
|
||||||
((result, _), _) <- runFormPost $
|
((result, _), _) <- runFormPost $
|
||||||
renderBootstrap3 BootstrapBasicForm $
|
renderBootstrap3 BootstrapBasicForm $
|
||||||
albumForm userId
|
albumForm userId
|
||||||
|
|
|
@ -37,19 +37,19 @@ getProfileR ownerId = do
|
||||||
then return $ Just alb
|
then return $ Just alb
|
||||||
else return Nothing
|
else return Nothing
|
||||||
) allAlbs
|
) allAlbs
|
||||||
let sharedAlbs = removeItem Nothing almostAlbs
|
let sharedAlbs = catMaybes almostAlbs
|
||||||
recentMedia <- runDB $ selectList [MediumOwner ==. ownerId] [Desc MediumTime]
|
recentMedia <- runDB $ selectList [MediumOwner ==. ownerId] [Desc MediumTime]
|
||||||
msu <- lookupSession "userId"
|
-- msu <- lookupSession "userId"
|
||||||
presence <- case msu of
|
musername <- maybeAuthId
|
||||||
Just tempUserId -> do
|
presence <- case musername of
|
||||||
let userId = getUserIdFromText tempUserId
|
Just username ->
|
||||||
return (userId == ownerId)
|
return (username == userName owner)
|
||||||
Nothing ->
|
Nothing ->
|
||||||
return False
|
return False
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle $ toHtml ("Eidolon :: " `T.append` userSlug owner `T.append` "'s profile")
|
setTitle $ toHtml ("Eidolon :: " `T.append` ownerSlug `T.append` "'s profile")
|
||||||
rssLink (UserFeedRssR ownerId) $ userSlug owner `T.append` "'s feed"
|
rssLink (UserFeedRssR ownerId) (ownerSlug `T.append` "'s feed")
|
||||||
atomLink (UserFeedAtomR ownerId) $ userSlug owner `T.append` "'s feed"
|
atomLink (UserFeedAtomR ownerId) (ownerSlug `T.append` "'s feed")
|
||||||
$(widgetFile "profile")
|
$(widgetFile "profile")
|
||||||
Nothing -> do
|
Nothing -> do
|
||||||
setMessage "This profile does not exist"
|
setMessage "This profile does not exist"
|
||||||
|
|
|
@ -26,7 +26,7 @@ import qualified Data.Text as T
|
||||||
import Data.List as L
|
import Data.List as L
|
||||||
import qualified System.FilePath as FP
|
import qualified System.FilePath as FP
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Text.Blaze.Internal
|
import Text.Blaze
|
||||||
-- import Codec.ImageType
|
-- import Codec.ImageType
|
||||||
-- import Codec.Picture as P
|
-- import Codec.Picture as P
|
||||||
-- import Codec.Picture.Metadata as PM
|
-- import Codec.Picture.Metadata as PM
|
||||||
|
@ -43,15 +43,14 @@ getDirectUploadR albumId = do
|
||||||
case tempAlbum of -- does the requested album exist
|
case tempAlbum of -- does the requested album exist
|
||||||
Just album -> do
|
Just album -> do
|
||||||
let ownerId = albumOwner album
|
let ownerId = albumOwner album
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of -- is anybody logged in
|
case musername of -- is anybody logged in
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
|
||||||
if
|
if
|
||||||
userId == ownerId || userId `elem` albumShares album
|
userId == ownerId || userId `elem` albumShares album
|
||||||
-- is the owner present or a user with whom the album is shared
|
-- is the owner present or a user with whom the album is shared
|
||||||
then do
|
then do
|
||||||
user <- runDB $ getJust userId
|
|
||||||
(dUploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
|
(dUploadWidget, enctype) <- generateFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
|
||||||
defaultLayout $ do
|
defaultLayout $ do
|
||||||
setTitle $ toHtml ("Eidolon :: Upload medium to " `T.append` albumTitle album)
|
setTitle $ toHtml ("Eidolon :: Upload medium to " `T.append` albumTitle album)
|
||||||
|
@ -72,14 +71,13 @@ postDirectUploadR albumId = do
|
||||||
case tempAlbum of -- does the album exist
|
case tempAlbum of -- does the album exist
|
||||||
Just album -> do
|
Just album -> do
|
||||||
let ownerId = albumOwner album
|
let ownerId = albumOwner album
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of -- is anybody logged in
|
case musername of -- is anybody logged in
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
|
||||||
if userId == ownerId || userId `elem` albumShares album
|
if userId == ownerId || userId `elem` albumShares album
|
||||||
-- is the logged in user the owner or is the album shared with him
|
-- is the logged in user the owner or is the album shared with him
|
||||||
then do
|
then do
|
||||||
user <- runDB $ getJust userId
|
|
||||||
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
|
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ dUploadForm userId user albumId
|
||||||
case result of
|
case result of
|
||||||
FormSuccess temp -> do
|
FormSuccess temp -> do
|
||||||
|
@ -97,15 +95,16 @@ postDirectUploadR albumId = do
|
||||||
(fileBulkLicence temp)
|
(fileBulkLicence temp)
|
||||||
NewFile
|
NewFile
|
||||||
)indFils
|
)indFils
|
||||||
let onlyErrNames = removeItem Nothing errNames
|
let onlyErrNames = catMaybes errNames
|
||||||
if
|
if
|
||||||
L.null onlyErrNames
|
L.null onlyErrNames
|
||||||
then do
|
then do
|
||||||
setMessage "All images succesfully uploaded"
|
setMessage "All images succesfully uploaded"
|
||||||
redirect $ AlbumR albumId
|
redirect $ AlbumR albumId
|
||||||
else do
|
else do
|
||||||
let justErrNames = map fromJust onlyErrNames
|
let msg = toMarkup $
|
||||||
let msg = Content $ Text.Blaze.Internal.Text $ "File type not supported of: " `T.append` T.intercalate ", " justErrNames
|
"File type not supported of: " `T.append`
|
||||||
|
(T.intercalate ", " onlyErrNames)
|
||||||
setMessage msg
|
setMessage msg
|
||||||
redirect HomeR
|
redirect HomeR
|
||||||
_ -> do
|
_ -> do
|
||||||
|
@ -150,11 +149,10 @@ data FileBulk = FileBulk
|
||||||
|
|
||||||
getUploadR :: Handler Html
|
getUploadR :: Handler Html
|
||||||
getUploadR = do
|
getUploadR = do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
|
||||||
user <- runDB $ getJust userId
|
|
||||||
let albums = userAlbums user
|
let albums = userAlbums user
|
||||||
if
|
if
|
||||||
I.null albums
|
I.null albums
|
||||||
|
@ -196,11 +194,10 @@ bulkUploadForm userId user = (\a b c d e f g h -> FileBulk b c d e f g a h)
|
||||||
|
|
||||||
postUploadR :: Handler Html
|
postUploadR :: Handler Html
|
||||||
postUploadR = do
|
postUploadR = do
|
||||||
msu <- lookupSession "userId"
|
musername <- maybeAuthId
|
||||||
case msu of
|
case musername of
|
||||||
Just tempUserId -> do
|
Just username -> do
|
||||||
let userId = getUserIdFromText tempUserId
|
(Just (Entity userId user)) <- runDB $ getBy $ UniqueUser username
|
||||||
user <- runDB $ getJust userId
|
|
||||||
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user
|
((result, _), _) <- runFormPost $ renderBootstrap3 BootstrapBasicForm $ bulkUploadForm userId user
|
||||||
case result of
|
case result of
|
||||||
FormSuccess temp -> do
|
FormSuccess temp -> do
|
||||||
|
@ -218,15 +215,16 @@ postUploadR = do
|
||||||
(fileBulkLicence temp)
|
(fileBulkLicence temp)
|
||||||
NewFile
|
NewFile
|
||||||
)indFils
|
)indFils
|
||||||
let onlyErrNames = removeItem Nothing errNames
|
let onlyErrNames = catMaybes errNames
|
||||||
if
|
if
|
||||||
L.null onlyErrNames
|
L.null onlyErrNames
|
||||||
then do
|
then do
|
||||||
setMessage "All images succesfully uploaded"
|
setMessage "All images succesfully uploaded"
|
||||||
redirect $ AlbumR $ fileBulkAlbum temp
|
redirect $ AlbumR $ fileBulkAlbum temp
|
||||||
else do
|
else do
|
||||||
let justErrNames = map fromJust onlyErrNames
|
let msg = toMarkup $
|
||||||
let msg = Content $ Text.Blaze.Internal.Text $ "File type not supported of: " `T.append` T.intercalate ", " justErrNames
|
"File type not supported of: "
|
||||||
|
`T.append` T.intercalate ", " onlyErrNames
|
||||||
setMessage msg
|
setMessage msg
|
||||||
redirect $ AlbumR $ fileBulkAlbum temp
|
redirect $ AlbumR $ fileBulkAlbum temp
|
||||||
_ -> do
|
_ -> do
|
||||||
|
|
|
@ -24,7 +24,7 @@
|
||||||
/page/#Int PageR GET
|
/page/#Int PageR GET
|
||||||
-- /signup SignupR GET POST
|
-- /signup SignupR GET POST
|
||||||
-- /login LoginR GET POST
|
-- /login LoginR GET POST
|
||||||
-- /loginraw LoginRawR POST
|
/loginraw LoginRawR GET POST
|
||||||
-- /logout LogoutR GET
|
-- /logout LogoutR GET
|
||||||
-- /activate/#T.Text ActivateR GET POST
|
-- /activate/#T.Text ActivateR GET POST
|
||||||
-- /activateraw/#T.Text ActivateRawR POST
|
-- /activateraw/#T.Text ActivateRawR POST
|
||||||
|
|
|
@ -32,7 +32,7 @@ library
|
||||||
Settings.Development
|
Settings.Development
|
||||||
Handler.Home
|
Handler.Home
|
||||||
-- Handler.Signup
|
-- Handler.Signup
|
||||||
-- Handler.Login
|
Handler.Login
|
||||||
-- Handler.Activate
|
-- Handler.Activate
|
||||||
-- Handler.Reactivate
|
-- Handler.Reactivate
|
||||||
Handler.Profile
|
Handler.Profile
|
||||||
|
@ -141,7 +141,7 @@ library
|
||||||
, http-client
|
, http-client
|
||||||
, yesod-form >= 1.4.7
|
, yesod-form >= 1.4.7
|
||||||
, magic
|
, magic
|
||||||
, texmath < 0.9
|
, texmath
|
||||||
, yesod-auth
|
, yesod-auth
|
||||||
, yesod-auth-hmac-keccak
|
, yesod-auth-hmac-keccak
|
||||||
|
|
||||||
|
|
|
@ -12,19 +12,3 @@ $newline always
|
||||||
your connection for leaks before proceeding.
|
your connection for leaks before proceeding.
|
||||||
<form method="post" action=@{LoginRawR}>
|
<form method="post" action=@{LoginRawR}>
|
||||||
^{loginRawWidget}
|
^{loginRawWidget}
|
||||||
<form .js-hidden>
|
|
||||||
<div .form-group .required>
|
|
||||||
<label for="username">User:
|
|
||||||
<input .form-control #username type="text" required>
|
|
||||||
<div .form-group .required>
|
|
||||||
<label for="password">Password:
|
|
||||||
<input .form-control #password type="password" required>
|
|
||||||
<div .form-group .optional>
|
|
||||||
<button .btn .btn-default type="submit" #login>Login
|
|
||||||
<div #progress>
|
|
||||||
|
|
||||||
<a href=@{ReactivateR}>Forgot your Password?
|
|
||||||
|
|
||||||
<script src="/static/js/jquery.min.js" type="text/javascript">
|
|
||||||
<!--<script src="/static/js/jsSHA.js" type="text/javascript">-->
|
|
||||||
<script src="/static/js/purs_login.js" type="text/javascript">
|
|
||||||
|
|
|
@ -25,7 +25,7 @@ $if not (null sharedAlbs)
|
||||||
<div .subheader .item>
|
<div .subheader .item>
|
||||||
<h1>Shared Albums
|
<h1>Shared Albums
|
||||||
<p>Albums others have shared with this user
|
<p>Albums others have shared with this user
|
||||||
$forall Just (Entity albumId album) <- sharedAlbs
|
$forall (Entity albumId album) <- sharedAlbs
|
||||||
<div .item>
|
<div .item>
|
||||||
<a href=@{AlbumR albumId}>
|
<a href=@{AlbumR albumId}>
|
||||||
<figure>
|
<figure>
|
||||||
|
|
Loading…
Reference in a new issue