Compare commits
37 commits
| Author | SHA1 | Date | |
|---|---|---|---|
| 7b29a58a22 | |||
| 16bcee802d | |||
| 2ce5997c93 | |||
| c4b57d7a29 | |||
| c9b7bdd84b | |||
| 67d88bd31b | |||
| 1e661031fb | |||
| de60936cd2 | |||
| c63309b9e8 | |||
| 6b8781760c | |||
| f0951506a0 | |||
| 2353d2fdc9 | |||
| 3511f257e6 | |||
| 1b591f05d8 | |||
| 1c395150e0 | |||
| 2bd43b0df5 | |||
| f058168db9 | |||
| 842b6c8936 | |||
| ddda1e7566 | |||
| 4984a836b4 | |||
| 255103af13 | |||
| 3ed15bae87 | |||
| 8b618bfdbb | |||
| 62bf6f5933 | |||
| 90ef6829e9 | |||
| 71d1e9bc34 | |||
| e51fac7b6a | |||
| d31a3d6330 | |||
| ee514454f7 | |||
| 20ce55f22a | |||
| 81ca02948b | |||
| ee6d6de212 | |||
| 596c830feb | |||
| e2c414f108 | |||
| c259f6dc1a | |||
| c84fa67136 | |||
| b601bdd796 |
25 changed files with 584 additions and 610 deletions
21
README.md
21
README.md
|
|
@ -1,25 +1,28 @@
|
||||||
# sTodo
|
# sTodo
|
||||||
Stuce's simple todo is a web app that let's you self host a simple todolist.
|
Stuce's simple todo is a web app that let's you self host a simple todolist.
|
||||||
The goal is to provide a minimalistic and fast todo list that is self hostable.
|
The goal is to provide a minimalistic and fast todo list that is self hostable.
|
||||||
|
## Usage
|
||||||
|
- can be used as is for a single user behind a vpn (for ex, wireguard)
|
||||||
|
- can be setup for multi user with a reverse proxy and an authentification provider that supports trusted sso (for ex, nginx + authelia)
|
||||||
## Next goals
|
## Next goals
|
||||||
- Make multi user support
|
- Make multi user support
|
||||||
- [ ] Get user by trusted header
|
|
||||||
- [ ] Add option to enable single user (usefull for vpn single user easy setup)
|
|
||||||
- [ ] Add menu to add other users to the group
|
|
||||||
- [ ] make the code more readable by renaming/moving the handlers better
|
|
||||||
- [ ] write a minimal step by step guide to install with nix,
|
- [ ] write a minimal step by step guide to install with nix,
|
||||||
- [ ] add some css to make it look nicer
|
- [ ] add some css to make it look nicer
|
||||||
- [ ] add htmx to make more agreable without making js manadatory
|
- [ ] add htmx to make more agreable without making js manadatory
|
||||||
## Version 1.0.0
|
- [x] make api to allow usage with native app (a way to get every list that has been modified since date $date belonging from the user in a json or similar format)
|
||||||
Simple todo list for **single user only** at the moment.
|
- [ ] use getRep and provideRep to make text/javascript response as alternatives to html
|
||||||
|
- [ ] document api to help create clients
|
||||||
|
## Version 0.0.3
|
||||||
|
Simple todo list webapp.
|
||||||
Features :
|
Features :
|
||||||
- add and delete (and soon share) groups that contain a list of todolists
|
- add and delete groups that contain a list of todolists
|
||||||
- add and delete todolists inside groups
|
- add and delete todolists inside groups
|
||||||
- add todolist items or edit complete list via text for easy manipulation
|
- add todolist items or edit complete list via text for easy manipulation
|
||||||
|
- api to allow creating native clients with offline capability
|
||||||
- possibility to deploy easily via nix module with a flake
|
- possibility to deploy easily via nix module with a flake
|
||||||
- that's it, the goal is to keep it minimal !!!
|
- that's it, the goal is to keep it minimal !!!
|
||||||
|
# Development
|
||||||
## Haskell Setup (I sadly don't use nix develop at the moment)
|
## Haskell Setup
|
||||||
|
|
||||||
1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)
|
1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)
|
||||||
* On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh`
|
* On POSIX systems, this is usually `curl -sSL https://get.haskellstack.org/ | sh`
|
||||||
|
|
|
||||||
1
client_session_key.aes
Normal file
1
client_session_key.aes
Normal file
|
|
@ -0,0 +1 @@
|
||||||
|
:M^¦ÄO2«I†è𑳉4,pe<70>¿Ôì8Ä·,CI†(q¸¦7/ ÷gGˆuâÍ×¥L'¿(Éœ¡wq1I#ÔpµÌYW»)2L{2—;våÇ_ižËÀ[ÛÈʳ<C38A>ûÕY
|
||||||
|
|
@ -8,13 +8,15 @@ TodolistItem
|
||||||
Todolist
|
Todolist
|
||||||
groupId GroupId OnDeleteCascade
|
groupId GroupId OnDeleteCascade
|
||||||
title Text
|
title Text
|
||||||
|
lastModified UTCTime
|
||||||
UniqueListPair groupId title
|
UniqueListPair groupId title
|
||||||
User
|
User
|
||||||
name Text
|
name Text
|
||||||
|
lastModified UTCTime
|
||||||
UniqueName name
|
UniqueName name
|
||||||
Group
|
Group
|
||||||
group Text
|
group Text
|
||||||
|
lastModified UTCTime
|
||||||
GroupUser
|
GroupUser
|
||||||
user UserId
|
user UserId
|
||||||
group Text
|
|
||||||
groupId GroupId OnDeleteCascade
|
groupId GroupId OnDeleteCascade
|
||||||
|
|
@ -6,7 +6,7 @@
|
||||||
/favicon.ico FaviconR GET
|
/favicon.ico FaviconR GET
|
||||||
/robots.txt RobotsR GET
|
/robots.txt RobotsR GET
|
||||||
|
|
||||||
/ HomeR GET
|
/ GroupR GET
|
||||||
/group/#GroupId TodolistR GET
|
/group/#GroupId TodolistR GET
|
||||||
|
|
||||||
/add AddGroupR POST
|
/add AddGroupR POST
|
||||||
|
|
@ -16,10 +16,14 @@
|
||||||
|
|
||||||
/check/group/#GroupId/todolist/#TodolistId/#TodolistItemId CheckTodolistItemR POST
|
/check/group/#GroupId/todolist/#TodolistId/#TodolistItemId CheckTodolistItemR POST
|
||||||
/edit/group/#GroupId/todolist/#TodolistId EditTodolistItemsR GET POST
|
/edit/group/#GroupId/todolist/#TodolistId EditTodolistItemsR GET POST
|
||||||
|
/sort/group/#GroupId/todolist/#TodolistId SortTodolistItemsR POST
|
||||||
|
/trim/group/#GroupId/todolist/#TodolistId TrimTodolistItemsR POST
|
||||||
|
|
||||||
/edit/group/#GroupId EditTodolistR GET POST
|
/edit/group/#GroupId EditTodolistR GET POST
|
||||||
|
/adduser/group/#GroupId AddUserR POST
|
||||||
/edit EditGroupR GET POST
|
/edit EditGroupR GET POST
|
||||||
|
|
||||||
/delete DeleteGroupR POST
|
/delete DeleteGroupR POST
|
||||||
/delete/group/#GroupId DeleteTodolistR POST
|
/delete/group/#GroupId DeleteTodolistR POST
|
||||||
|
|
||||||
|
/api/#Int ApiR GET
|
||||||
|
|
|
||||||
|
|
@ -10,8 +10,8 @@
|
||||||
nixpkgs,
|
nixpkgs,
|
||||||
}: let
|
}: let
|
||||||
tarball = fetchTarball {
|
tarball = fetchTarball {
|
||||||
url = "https://git.stuce.ch/stuce/sTodo/releases/download/Release1/release1.tar.gz";
|
url = "https://git.stuce.ch/stuce/sTodo/releases/download/r3/r3.tar.gz";
|
||||||
sha256 = "10jyldwmcs5zyz1k8lp3jscn7nhlvn56g0709l5jp91qimw7xiqz";
|
sha256 = "1imgbbgbgx2r8qr90mpxlwfy9hcfpdz0sa4nir05jhqx8q1rl0y1";
|
||||||
};
|
};
|
||||||
in {
|
in {
|
||||||
packages.x86_64-linux.sTodo = with nixpkgs.legacyPackages.x86_64-linux;
|
packages.x86_64-linux.sTodo = with nixpkgs.legacyPackages.x86_64-linux;
|
||||||
|
|
@ -19,10 +19,12 @@
|
||||||
pname = "sTodo";
|
pname = "sTodo";
|
||||||
version = "1.0.0";
|
version = "1.0.0";
|
||||||
src = tarball;
|
src = tarball;
|
||||||
buildInputs = [zlib gmp libffi openssl];
|
buildInputs = [libz gmp libffi];
|
||||||
|
nativeBuildInputs = [openssl];
|
||||||
installPhase = ''
|
installPhase = ''
|
||||||
mkdir -p $out/bin
|
mkdir -p $out/bin
|
||||||
cp $src/sTodo $out/bin
|
cp $src/sTodo $out/bin
|
||||||
|
chmod ugo+x $out/bin/sTodo
|
||||||
'';
|
'';
|
||||||
mainProgram = "sTodo";
|
mainProgram = "sTodo";
|
||||||
};
|
};
|
||||||
|
|
|
||||||
|
|
@ -44,7 +44,10 @@ import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
|
||||||
-- Import all relevant handler modules here.
|
-- Import all relevant handler modules here.
|
||||||
-- Don't forget to add new modules to your cabal file!
|
-- Don't forget to add new modules to your cabal file!
|
||||||
import Handler.Common
|
import Handler.Common
|
||||||
import Handler.TodoEntry
|
import Handler.Group
|
||||||
|
import Handler.Todolist
|
||||||
|
import Handler.TodolistItem
|
||||||
|
import Handler.Api
|
||||||
|
|
||||||
-- This line actually creates our YesodDispatch instance. It is the second half
|
-- This line actually creates our YesodDispatch instance. It is the second half
|
||||||
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
-- of the call to mkYesodData which occurs in Foundation.hs. Please see the
|
||||||
|
|
|
||||||
|
|
@ -1,36 +1,40 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
{-# LANGUAGE ExplicitForAll #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE ImportQualifiedPost #-}
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
{-# LANGUAGE ViewPatterns #-}
|
{-# LANGUAGE ViewPatterns #-}
|
||||||
{-# LANGUAGE ExplicitForAll #-}
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
|
||||||
{-# LANGUAGE InstanceSigs #-}
|
|
||||||
|
|
||||||
module Foundation where
|
module Foundation where
|
||||||
|
|
||||||
import Import.NoFoundation
|
import Control.Monad.Logger (LogSource)
|
||||||
import Data.Kind (Type)
|
import Data.Kind (Type)
|
||||||
import Database.Persist.Sql (ConnectionPool, runSqlPool)
|
import Data.Text qualified as Text (intercalate, pack)
|
||||||
|
import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool)
|
||||||
|
import Import.NoFoundation
|
||||||
import Text.Hamlet (hamletFile)
|
import Text.Hamlet (hamletFile)
|
||||||
import Text.Jasmine (minifym)
|
import Text.Jasmine (minifym)
|
||||||
import Control.Monad.Logger (LogSource)
|
|
||||||
|
|
||||||
import Yesod.Default.Util (addStaticContentExternal)
|
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
|
||||||
import Yesod.Core.Types (Logger)
|
import Yesod.Core.Types (Logger)
|
||||||
import qualified Yesod.Core.Unsafe as Unsafe
|
import Yesod.Core.Unsafe qualified as Unsafe
|
||||||
import qualified Data.CaseInsensitive as CI
|
import Yesod.Default.Util (addStaticContentExternal)
|
||||||
import qualified Data.Text.Encoding as TE
|
|
||||||
|
|
||||||
-- | The foundation datatype for your application. This can be a good place to
|
{- | The foundation datatype for your application. This can be a good place to
|
||||||
-- keep settings and values requiring initialization before your application
|
keep settings and values requiring initialization before your application
|
||||||
-- starts running, such as database connections. Every handler will have
|
starts running, such as database connections. Every handler will have
|
||||||
-- access to the data present here.
|
access to the data present here.
|
||||||
|
-}
|
||||||
data App = App
|
data App = App
|
||||||
{ appSettings :: AppSettings
|
{ appSettings :: AppSettings
|
||||||
, appStatic :: Static -- ^ Settings for static file serving.
|
, appStatic :: Static
|
||||||
, appConnPool :: ConnectionPool -- ^ Database connection pool.
|
-- ^ Settings for static file serving.
|
||||||
|
, appConnPool :: ConnectionPool
|
||||||
|
-- ^ Database connection pool.
|
||||||
, appHttpManager :: Manager
|
, appHttpManager :: Manager
|
||||||
, appLogger :: Logger
|
, appLogger :: Logger
|
||||||
}
|
}
|
||||||
|
|
@ -63,8 +67,10 @@ mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")
|
||||||
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
|
type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
|
||||||
|
|
||||||
-- | A convenient synonym for database access functions.
|
-- | A convenient synonym for database access functions.
|
||||||
type DB a = forall (m :: Type -> Type).
|
type DB a =
|
||||||
(MonadUnliftIO m) => ReaderT SqlBackend m a
|
forall (m :: Type -> Type).
|
||||||
|
(MonadUnliftIO m) =>
|
||||||
|
ReaderT SqlBackend m a
|
||||||
|
|
||||||
-- Please see the documentation for the Yesod typeclass. There are a number
|
-- Please see the documentation for the Yesod typeclass. There are a number
|
||||||
-- of settings which can be configured by overriding methods here.
|
-- of settings which can be configured by overriding methods here.
|
||||||
|
|
@ -77,12 +83,12 @@ instance Yesod App where
|
||||||
Nothing -> getApprootText guessApproot app req
|
Nothing -> getApprootText guessApproot app req
|
||||||
Just root -> root
|
Just root -> root
|
||||||
|
|
||||||
-- Store session data on the client in encrypted cookies,
|
-- -- Store session data on the client in encrypted cookies,
|
||||||
-- default session idle timeout is 120 minutes
|
-- -- default session idle timeout is 120 minutes
|
||||||
makeSessionBackend :: App -> IO (Maybe SessionBackend)
|
-- makeSessionBackend :: App -> IO (Maybe SessionBackend)
|
||||||
makeSessionBackend app = Just <$> defaultClientSessionBackend
|
-- makeSessionBackend app = Just <$> defaultClientSessionBackend
|
||||||
120 -- timeout in minutes
|
-- 120 -- timeout in minutes
|
||||||
(appSessionKey $ appSettings app)
|
-- (appSessionKey $ appSettings app)
|
||||||
|
|
||||||
-- Yesod Middleware allows you to run code before and after each handler function.
|
-- Yesod Middleware allows you to run code before and after each handler function.
|
||||||
-- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
|
-- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
|
||||||
|
|
@ -91,15 +97,15 @@ instance Yesod App where
|
||||||
-- b) Validates that incoming write requests include that token in either a header or POST parameter.
|
-- b) Validates that incoming write requests include that token in either a header or POST parameter.
|
||||||
-- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
|
-- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
|
||||||
-- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
|
-- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
|
||||||
yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
|
-- yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
|
||||||
yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
|
-- yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
|
||||||
|
|
||||||
defaultLayout :: Widget -> Handler Html
|
defaultLayout :: Widget -> Handler Html
|
||||||
defaultLayout widget = do
|
defaultLayout widget = do
|
||||||
master <- getYesod
|
master <- getYesod
|
||||||
mmsg <- getMessage
|
mmsg <- getMessage
|
||||||
|
|
||||||
mcurrentRoute <- getCurrentRoute
|
-- mcurrentRoute <- getCurrentRoute
|
||||||
|
|
||||||
-- We break up the default layout into two components:
|
-- We break up the default layout into two components:
|
||||||
-- default-layout is the contents of the body tag, and
|
-- default-layout is the contents of the body tag, and
|
||||||
|
|
@ -111,24 +117,25 @@ instance Yesod App where
|
||||||
$(widgetFile "default-layout")
|
$(widgetFile "default-layout")
|
||||||
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
|
||||||
|
|
||||||
isAuthorized
|
-- isAuthorized
|
||||||
:: Route App -- ^ The route the user is visiting.
|
-- :: Route App -- ^ The route the user is visiting.
|
||||||
-> Bool -- ^ Whether or not this is a "write" request.
|
-- -> Bool -- ^ Whether or not this is a "write" request.
|
||||||
-> Handler AuthResult
|
-- -> Handler AuthResult
|
||||||
-- Routes not requiring authentication.
|
-- -- Routes not requiring authentication.
|
||||||
-- TODO: check this bullshit if need to change it or not (prolly authelia problem)
|
-- isAuthorized _ _ = return Authorized
|
||||||
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
|
||||||
-- expiration dates to be set far in the future without worry of
|
-- expiration dates to be set far in the future without worry of
|
||||||
-- users receiving stale content.
|
-- users receiving stale content.
|
||||||
addStaticContent
|
addStaticContent ::
|
||||||
:: Text -- ^ The file extension
|
Text ->
|
||||||
-> Text -- ^ The MIME content type
|
-- \^ The file extension
|
||||||
-> LByteString -- ^ The contents of the file
|
Text ->
|
||||||
-> Handler (Maybe (Either Text (Route App, [(Text, Text)])))
|
-- \^ The MIME content type
|
||||||
|
LByteString ->
|
||||||
|
-- \^ The contents of the file
|
||||||
|
Handler (Maybe (Either Text (Route App, [(Text, Text)])))
|
||||||
addStaticContent ext mime content = do
|
addStaticContent ext mime content = do
|
||||||
master <- getYesod
|
master <- getYesod
|
||||||
let staticDir = appStaticDir $ appSettings master
|
let staticDir = appStaticDir $ appSettings master
|
||||||
|
|
@ -148,10 +155,12 @@ instance Yesod App where
|
||||||
-- in development, and warnings and errors in production.
|
-- in development, and warnings and errors in production.
|
||||||
shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
|
shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
|
||||||
shouldLogIO app _source level =
|
shouldLogIO app _source level =
|
||||||
return $
|
return
|
||||||
appShouldLogAll (appSettings app)
|
$ appShouldLogAll (appSettings app)
|
||||||
|| level == LevelWarn
|
|| level
|
||||||
|| level == LevelError
|
== LevelWarn
|
||||||
|
|| level
|
||||||
|
== LevelError
|
||||||
|
|
||||||
makeLogger :: App -> IO Logger
|
makeLogger :: App -> IO Logger
|
||||||
makeLogger = return . appLogger
|
makeLogger = return . appLogger
|
||||||
|
|
@ -191,3 +200,50 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
|
||||||
-- https://github.com/yesodweb/yesod/wiki/Sending-email
|
-- https://github.com/yesodweb/yesod/wiki/Sending-email
|
||||||
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
|
-- https://github.com/yesodweb/yesod/wiki/Serve-static-files-from-a-separate-domain
|
||||||
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
|
-- https://github.com/yesodweb/yesod/wiki/i18n-messages-in-the-scaffolding
|
||||||
|
|
||||||
|
-- TODO: complete implementation should short circuit if multi user is on but no user exist, to enforce policy safely
|
||||||
|
getUserId :: HandlerFor App (Key User)
|
||||||
|
getUserId = do
|
||||||
|
mName <- lookupHeader "Remote-User"
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
mUser <- case mName of
|
||||||
|
-- TODO: make remote user an argument to make it usable not only with authelia, and maybe do a check for good mesure when nothing is found ?
|
||||||
|
Just name -> runDB $ insertBy $ User (decodeUtf8 name) currentTime
|
||||||
|
Nothing -> runDB $ insertBy $ User "single-user" currentTime
|
||||||
|
case mUser of
|
||||||
|
Left (Entity userId _) -> return userId
|
||||||
|
Right userId -> return userId
|
||||||
|
|
||||||
|
dbIfAuth :: GroupId -> ReaderT SqlBackend (HandlerFor App) b -> HandlerFor App b
|
||||||
|
dbIfAuth groupId action = do
|
||||||
|
-- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests
|
||||||
|
user <- getUserId
|
||||||
|
result <- runDB $ selectFirst [GroupUserUser ==. user, GroupUserGroupId ==. groupId] []
|
||||||
|
if isNothing result
|
||||||
|
then permissionDenied "you are not logged in or you dont have access to this group"
|
||||||
|
else runDB action
|
||||||
|
|
||||||
|
getGroups :: Key User -> Handler [Entity Group]
|
||||||
|
getGroups userId =
|
||||||
|
let sql = "SELECT ?? FROM \"group\" JOIN group_user gu ON \"group\".id = gu.group_id WHERE gu.user = ?"
|
||||||
|
in runDB $ rawSql sql [toPersistValue userId]
|
||||||
|
|
||||||
|
todolistItemToCSV :: Entity TodolistItem -> Text
|
||||||
|
todolistItemToCSV item = "i," <> fieldToText item
|
||||||
|
todolistToCSV :: Entity Todolist -> Text
|
||||||
|
todolistToCSV list = "l," <> fieldToText list
|
||||||
|
groupToCSV :: Entity Group -> Text
|
||||||
|
groupToCSV group = "g," <> fieldToText group
|
||||||
|
userToCSV :: Entity User -> Text
|
||||||
|
userToCSV user = "u," <> fieldToText user
|
||||||
|
|
||||||
|
-- TODO: error management ? (maybe use Either Text Text and then propagate left to handler and send error ?)
|
||||||
|
fieldToText :: (PersistEntity record) => Entity record -> Text
|
||||||
|
fieldToText field = Text.intercalate "," (map persistValueToText $ entityValues field)
|
||||||
|
|
||||||
|
persistValueToText :: PersistValue -> Text
|
||||||
|
persistValueToText (PersistText s) = s
|
||||||
|
persistValueToText (PersistInt64 i) = Text.pack $ show i
|
||||||
|
persistValueToText (PersistUTCTime d) = Text.pack $ show $ floor (utcTimeToPOSIXSeconds d)
|
||||||
|
persistValueToText (PersistBool b) = if b then "T" else "F"
|
||||||
|
persistValueToText _ = error "Wrong input type"
|
||||||
|
|
|
||||||
33
src/Handler/Api.hs
Normal file
33
src/Handler/Api.hs
Normal file
|
|
@ -0,0 +1,33 @@
|
||||||
|
{-# LANGUAGE ImportQualifiedPost #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
|
||||||
|
module Handler.Api where
|
||||||
|
|
||||||
|
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
|
||||||
|
import Database.Persist.Sql (rawSql)
|
||||||
|
import Import
|
||||||
|
|
||||||
|
getApiR :: Int -> Handler TypedContent
|
||||||
|
getApiR time = do
|
||||||
|
-- TODO: use only one runDB (or use joins ?)
|
||||||
|
userId <- getUserId
|
||||||
|
let utcTime = posixSecondsToUTCTime (fromIntegral time)
|
||||||
|
-- condition : parent user or group changed
|
||||||
|
let sqlUpdatedGroups = "select ?? from \"group\" join group_user gu on \"group\".id = gu.group_id where gu.user = ? where \"group\".last_modified > ? or user.last_modified > ?;"
|
||||||
|
-- condition : parent group or list changed
|
||||||
|
let sqlUpdatedLists = "select ?? from todolist join group_user on todolist.group_id = group_user.group_id and group_user.user = ? join \"group\" as g on g.id = todolist.id where list.last_modified > ? or g.last_modified > ?;"
|
||||||
|
-- condition : parent list changed
|
||||||
|
let sqlUpdatedItems = "select ?? from todolist where todolist.last_modified > ? join group_user on todolist.group_id = group_user.group_id and group_user.user = ? join todolist_item on todolist_item.todolist_id = todolist.id;"
|
||||||
|
runDB $ do
|
||||||
|
user <- selectList [UserId ==. userId, UserLastModified >. utcTime] []
|
||||||
|
groups <- rawSql sqlUpdatedGroups [toPersistValue userId, toPersistValue utcTime, toPersistValue utcTime]
|
||||||
|
lists <- rawSql sqlUpdatedLists [toPersistValue userId, toPersistValue utcTime, toPersistValue utcTime]
|
||||||
|
items <- rawSql sqlUpdatedItems [toPersistValue utcTime, toPersistValue userId]
|
||||||
|
let t =
|
||||||
|
unlines
|
||||||
|
$ map userToCSV user
|
||||||
|
<> map groupToCSV groups
|
||||||
|
<> map todolistToCSV lists
|
||||||
|
<> map todolistItemToCSV items
|
||||||
|
return $ TypedContent typePlain $ toContent t
|
||||||
73
src/Handler/Group.hs
Normal file
73
src/Handler/Group.hs
Normal file
|
|
@ -0,0 +1,73 @@
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
|
module Handler.Group where
|
||||||
|
|
||||||
|
import Database.Persist.Sql (fromSqlKey, toSqlKey)
|
||||||
|
import Import
|
||||||
|
import Text.Read
|
||||||
|
|
||||||
|
getGroupR :: Handler TypedContent
|
||||||
|
getGroupR = do
|
||||||
|
userId <- getUserId
|
||||||
|
groups <- getGroups userId
|
||||||
|
selectRep $ do
|
||||||
|
provideRep
|
||||||
|
$ defaultLayout
|
||||||
|
$ do
|
||||||
|
setTitle "Groups"
|
||||||
|
$(widgetFile "group")
|
||||||
|
provideRep $ return $ unlines $ map groupToCSV groups
|
||||||
|
|
||||||
|
postAddGroupR :: Handler TypedContent
|
||||||
|
postAddGroupR = do
|
||||||
|
g <- runInputPost $ ireq textField "group"
|
||||||
|
-- TODO: in a newer version, put insertUnique_
|
||||||
|
user <- getUserId
|
||||||
|
_ <- runDB $ do
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
gId <- insert $ Group g currentTime
|
||||||
|
success <- insertUnique $ GroupUser user gId
|
||||||
|
when (isNothing success) $ delete gId
|
||||||
|
redirect GroupR
|
||||||
|
|
||||||
|
getEditGroupR :: Handler Html
|
||||||
|
getEditGroupR = do
|
||||||
|
userId <- getUserId
|
||||||
|
groups <- getGroups userId
|
||||||
|
defaultLayout $ do
|
||||||
|
let a e = pack $ show $ fromSqlKey $ entityKey e :: Text
|
||||||
|
setTitle "Groups"
|
||||||
|
$(widgetFile "edit-group")
|
||||||
|
postEditGroupR :: Handler TypedContent
|
||||||
|
postEditGroupR = do
|
||||||
|
-- TODO: not implemented yet
|
||||||
|
-- title <- runInputPost $ ireq textField "title"
|
||||||
|
-- users <- runInputPost $ ireq textField "users"
|
||||||
|
-- id <- runInputPost $ ireq intField "id"
|
||||||
|
-- let key = toSqlKey id
|
||||||
|
-- runDB $ update key [GroupGroup =. title]
|
||||||
|
redirect EditGroupR
|
||||||
|
postDeleteGroupR :: Handler Html
|
||||||
|
postDeleteGroupR = do
|
||||||
|
text <- lookupPostParams "ids"
|
||||||
|
let ints = map (read . unpack) text :: [Int64]
|
||||||
|
let ids = map toSqlKey ints :: [GroupId]
|
||||||
|
userId <- getUserId
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
-- TODO: test this and maybe change it to sql to be more efficient ?
|
||||||
|
when (ids /= [])
|
||||||
|
$ runDB
|
||||||
|
$ do
|
||||||
|
update userId [UserLastModified =. currentTime]
|
||||||
|
deleteWhere [GroupUserGroupId <-. ids, GroupUserUser ==. userId]
|
||||||
|
nonOrphans <- selectList [GroupUserGroupId <-. ids] []
|
||||||
|
let nonOrphansIds = map (groupUserGroupId . entityVal) nonOrphans
|
||||||
|
deleteWhere [GroupId <-. ids, GroupId /<-. nonOrphansIds]
|
||||||
|
redirect EditGroupR
|
||||||
|
|
@ -1,263 +0,0 @@
|
||||||
{-# LANGUAGE NoImplicitPrelude #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
|
||||||
{-# LANGUAGE TemplateHaskell #-}
|
|
||||||
{-# LANGUAGE QuasiQuotes #-}
|
|
||||||
{-# LANGUAGE FlexibleContexts #-}
|
|
||||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
|
||||||
{-# HLINT ignore "Replace case with fromMaybe" #-}
|
|
||||||
module Handler.TodoEntry where
|
|
||||||
|
|
||||||
import Import
|
|
||||||
import Text.Read
|
|
||||||
import Database.Persist.Sql (rawExecute, fromSqlKey, toSqlKey)
|
|
||||||
-- TODO: move this back to another handler
|
|
||||||
getHomeR :: Handler Html
|
|
||||||
getHomeR = do
|
|
||||||
user <- getUserId
|
|
||||||
groups <- runDB $ do
|
|
||||||
selectList [GroupUserUser ==. user] [Asc GroupUserGroup]
|
|
||||||
mToken <- fmap reqToken getRequest
|
|
||||||
defaultLayout $ do
|
|
||||||
setTitle "Groups"
|
|
||||||
[whamlet|
|
|
||||||
<a href=@{HomeR}>Home
|
|
||||||
<ul>
|
|
||||||
$forall group <- groups
|
|
||||||
<li>
|
|
||||||
<a href=@{TodolistR $ (groupUserGroupId . entityVal) group}>#{(groupUserGroup . entityVal) group}
|
|
||||||
<form action=@{AddGroupR} method="post">
|
|
||||||
<input type="text" name="group" placeholder="new group">
|
|
||||||
$maybe token <- mToken
|
|
||||||
<input type="hidden" name="_token" value="#{token}">
|
|
||||||
<button type="submit">add
|
|
||||||
<a href=@{EditGroupR}>Edit
|
|
||||||
|]
|
|
||||||
|
|
||||||
postAddGroupR :: Handler Html
|
|
||||||
postAddGroupR = do
|
|
||||||
g <- runInputPost $ ireq textField "group"
|
|
||||||
-- TODO: in a newer version, put insertUnique_
|
|
||||||
user <- getUserId
|
|
||||||
_ <- runDB $ do
|
|
||||||
gId <- insert $ Group g
|
|
||||||
success <- insertUnique $ GroupUser user g gId
|
|
||||||
when (isNothing success) $ delete gId
|
|
||||||
redirect HomeR
|
|
||||||
postAddTodolistR :: GroupId -> Handler Html
|
|
||||||
postAddTodolistR groupId = do
|
|
||||||
list <- runInputPost $ ireq textField "list"
|
|
||||||
-- TODO: in a newer version, put insertUnique_
|
|
||||||
_ <- dbIfAuth groupId (insertUnique $ Todolist groupId list)
|
|
||||||
redirect $ TodolistR groupId
|
|
||||||
|
|
||||||
-- TODO: move this to a new handler file
|
|
||||||
getTodolistR :: GroupId -> Handler Html
|
|
||||||
getTodolistR groupId = do
|
|
||||||
lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] [])
|
|
||||||
mToken <- fmap reqToken getRequest
|
|
||||||
defaultLayout $ do
|
|
||||||
let getTitle = todolistTitle . entityVal
|
|
||||||
setTitle "todolist"
|
|
||||||
[whamlet|
|
|
||||||
<a href=@{HomeR}>Home
|
|
||||||
<ul>
|
|
||||||
$forall list <- lists
|
|
||||||
<li>
|
|
||||||
<a href=@{TodolistItemsR groupId (entityKey list)}>#{getTitle list}
|
|
||||||
<form action=@{AddTodolistR groupId} method="post">
|
|
||||||
<input type="text" name="list" placeholder="new list">
|
|
||||||
$maybe token <- mToken
|
|
||||||
<input type="hidden" name="_token" value="#{token}">
|
|
||||||
<button type="submit">add
|
|
||||||
<a href=@{EditTodolistR groupId}>Edit
|
|
||||||
|]
|
|
||||||
|
|
||||||
getTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
||||||
getTodolistItemsR groupId todolistId = do
|
|
||||||
items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [])
|
|
||||||
mToken <- fmap reqToken getRequest
|
|
||||||
defaultLayout $ do
|
|
||||||
setTitle "items"
|
|
||||||
[whamlet|
|
|
||||||
<a href=@{HomeR}>Home
|
|
||||||
|
|
||||||
<a href=@{TodolistR groupId}>Lists
|
|
||||||
<ul>
|
|
||||||
$forall item <- items
|
|
||||||
<li>
|
|
||||||
<form action=@{CheckTodolistItemR groupId todolistId (entityKey item)} method="POST">
|
|
||||||
$maybe token <- mToken
|
|
||||||
<input type="hidden" name="_token" value="#{token}">
|
|
||||||
<button type="submit">#{getText item}
|
|
||||||
<form action=@{AddTodolistItemR groupId todolistId} method="post">
|
|
||||||
<form action=@{AddTodolistItemR groupId todolistId} method="post">
|
|
||||||
<input type="text" name="item" placeholder="new item">
|
|
||||||
$maybe token <- mToken
|
|
||||||
<input type="hidden" name="_token" value="#{token}">
|
|
||||||
<button type="submit">add
|
|
||||||
<a href=@{EditTodolistItemsR groupId todolistId}>Edit list
|
|
||||||
|]
|
|
||||||
|
|
||||||
|
|
||||||
postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html
|
|
||||||
postCheckTodolistItemR groupId todolistId todolistItemId = do
|
|
||||||
dbIfAuth groupId (rawExecute "UPDATE todolist_item SET value = NOT value WHERE id = ?" [toPersistValue todolistItemId])
|
|
||||||
redirect $ TodolistItemsR groupId todolistId
|
|
||||||
|
|
||||||
|
|
||||||
postAddTodolistItemR :: GroupId -> TodolistId -> Handler Html
|
|
||||||
postAddTodolistItemR groupId todolistId = do
|
|
||||||
item <- runInputPost $ ireq textField "item"
|
|
||||||
_ <- dbIfAuth groupId (insert_ $ TodolistItem todolistId False item)
|
|
||||||
redirect $ TodolistItemsR groupId todolistId
|
|
||||||
|
|
||||||
getEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
||||||
getEditTodolistItemsR groupId todolistId = do
|
|
||||||
items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [])
|
|
||||||
mToken <- fmap reqToken getRequest
|
|
||||||
let text = unlines $ map getText items
|
|
||||||
defaultLayout $ do
|
|
||||||
setTitle "edit"
|
|
||||||
[whamlet|
|
|
||||||
<form action=@{EditTodolistItemsR groupId todolistId} method=POST>
|
|
||||||
<label for="edit text area">Edit todolist
|
|
||||||
<br>
|
|
||||||
<textarea id="edit text area" name=text rows=30 cols=50 placeholder="[x] wake up1 [x] eat [ ] sleep [ ] repeat">#{text}
|
|
||||||
$maybe token <- mToken
|
|
||||||
<input type="hidden" name="_token" value="#{token}">
|
|
||||||
<br>
|
|
||||||
<button type="submit">edit
|
|
||||||
|]
|
|
||||||
postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
|
||||||
postEditTodolistItemsR groupId todolistId = do
|
|
||||||
text <- runInputPost $ ireq textField "text"
|
|
||||||
let xs = getItems text todolistId
|
|
||||||
dbIfAuth groupId (do
|
|
||||||
deleteWhere [TodolistItemTodolistId ==. todolistId]
|
|
||||||
insertMany_ xs)
|
|
||||||
redirect $ TodolistItemsR groupId todolistId
|
|
||||||
|
|
||||||
getEditTodolistR :: GroupId -> Handler Html
|
|
||||||
getEditTodolistR groupId = do
|
|
||||||
lists <- runDB $
|
|
||||||
selectList [TodolistGroupId ==. groupId] [Asc TodolistTitle]
|
|
||||||
mToken <- fmap reqToken getRequest
|
|
||||||
defaultLayout $ do
|
|
||||||
let keyToText e = pack $ show $ fromSqlKey $ entityKey e ::Text
|
|
||||||
setTitle "Groups"
|
|
||||||
[whamlet|
|
|
||||||
<form action=@{DeleteTodolistR groupId} method="POST">
|
|
||||||
<ul>
|
|
||||||
$forall list <- lists
|
|
||||||
<li>
|
|
||||||
<input type="checkbox" name="ids" value="#{keyToText list}">
|
|
||||||
<a href="">#{(todolistTitle . entityVal) list}
|
|
||||||
$maybe token <- mToken
|
|
||||||
<input type="hidden" name="_token" value="#{token}">
|
|
||||||
<button type=submit>Delete selected
|
|
||||||
<a href=@{TodolistR groupId}>Back
|
|
||||||
|]
|
|
||||||
postDeleteTodolistR :: GroupId -> Handler Html
|
|
||||||
postDeleteTodolistR groupId = do
|
|
||||||
text <- lookupPostParams "ids"
|
|
||||||
let ints = map (read . unpack) text :: [Int64]
|
|
||||||
let ids = map toSqlKey ints :: [TodolistId]
|
|
||||||
dbIfAuth groupId (deleteWhere [TodolistId <-. ids])
|
|
||||||
redirect $ EditTodolistR groupId
|
|
||||||
postEditTodolistR :: GroupId -> Handler Html
|
|
||||||
postEditTodolistR groupId = error "not done yet"
|
|
||||||
|
|
||||||
getEditGroupR :: Handler Html
|
|
||||||
getEditGroupR = do
|
|
||||||
userId <- getUserId
|
|
||||||
groups <- runDB $ do
|
|
||||||
selectList [GroupUserUser ==. userId] [Asc GroupUserGroup]
|
|
||||||
mToken <- fmap reqToken getRequest
|
|
||||||
defaultLayout $ do
|
|
||||||
let a e = pack $ show $ fromSqlKey $ entityKey e ::Text
|
|
||||||
setTitle "Groups"
|
|
||||||
[whamlet|
|
|
||||||
<form action=@{DeleteGroupR} method="POST">
|
|
||||||
<ul>
|
|
||||||
$forall group <- groups
|
|
||||||
<li>
|
|
||||||
<input type="checkbox" name="ids" value="#{a group}">
|
|
||||||
<a href="">#{(groupUserGroup . entityVal) group}
|
|
||||||
$maybe token <- mToken
|
|
||||||
<input type="hidden" name="_token" value="#{token}">
|
|
||||||
<button type=submit>Delete selected
|
|
||||||
<a href=@{HomeR}>Back
|
|
||||||
|]
|
|
||||||
|
|
||||||
postEditGroupR :: Handler Html
|
|
||||||
postEditGroupR = do
|
|
||||||
-- TODO: not implemented yet
|
|
||||||
-- title <- runInputPost $ ireq textField "title"
|
|
||||||
-- users <- runInputPost $ ireq textField "users"
|
|
||||||
-- id <- runInputPost $ ireq intField "id"
|
|
||||||
-- let key = toSqlKey id
|
|
||||||
-- runDB $ update key [GroupGroup =. title]
|
|
||||||
redirect EditGroupR
|
|
||||||
|
|
||||||
postDeleteGroupR :: Handler Html
|
|
||||||
postDeleteGroupR = do
|
|
||||||
text <- lookupPostParams "ids"
|
|
||||||
let ints = map (read . unpack) text :: [Int64]
|
|
||||||
let ids = map toSqlKey ints :: [GroupId]
|
|
||||||
-- TODO: make sure the user has access to it aswell (this only works now for single user)
|
|
||||||
runDB $ deleteWhere [GroupId <-. ids]
|
|
||||||
redirect EditGroupR
|
|
||||||
|
|
||||||
getText :: Entity TodolistItem -> Text
|
|
||||||
getText item =
|
|
||||||
if value then "[x] " <> name
|
|
||||||
else "[ ] " <> name
|
|
||||||
where
|
|
||||||
value = (todolistItemValue . entityVal) item
|
|
||||||
name = (todolistItemName . entityVal) item
|
|
||||||
|
|
||||||
getItems :: Text -> TodolistId -> [TodolistItem]
|
|
||||||
getItems text todolistId = map read (lines text)
|
|
||||||
where read line = do
|
|
||||||
let (d, n) = splitAt 4 line
|
|
||||||
let
|
|
||||||
value = case d of
|
|
||||||
"[x] " -> True
|
|
||||||
"[ ] " -> False
|
|
||||||
_ -> error "Invalid status"
|
|
||||||
name = case n of
|
|
||||||
"" -> error "empty name"
|
|
||||||
something -> filter (/= '\r') something
|
|
||||||
TodolistItem todolistId value name
|
|
||||||
-- TODO: complete implementation should short circuit if multi user is on but no user exist
|
|
||||||
|
|
||||||
|
|
||||||
-- getUserId :: Handler (Key User)
|
|
||||||
-- getUserId = do
|
|
||||||
-- mUser <- runDB $ getBy $ UniqueName "Stuce"
|
|
||||||
-- case mUser of
|
|
||||||
-- Nothing -> runDB $ insert $ User "Stuce"
|
|
||||||
-- Just u -> return $ entityKey u
|
|
||||||
|
|
||||||
-- TODO: use yesodAuth and clean this mess
|
|
||||||
getUserId :: Handler (Key User)
|
|
||||||
getUserId = do
|
|
||||||
mName <- lookupHeader "Remote-User"
|
|
||||||
case mName of
|
|
||||||
-- TODO: if this temporary solution stays, we need here a way to use authDummy somehow in developpement
|
|
||||||
Nothing -> permissionDenied "no trusted header found !"
|
|
||||||
Just name -> do
|
|
||||||
mUser <- runDB $ getBy $ UniqueName (decodeUtf8 name)
|
|
||||||
case mUser of
|
|
||||||
Nothing -> runDB $ insert $ User (decodeUtf8 name)
|
|
||||||
Just u -> return $ entityKey u
|
|
||||||
|
|
||||||
dbIfAuth groupId action = do
|
|
||||||
-- TODO: decide if we prefer fast (rawSql) or safe (type safe persist query) after in production latency tests
|
|
||||||
-- TODO: optimize the persist implementation anyway
|
|
||||||
user <- getUserId
|
|
||||||
result <- runDB $ selectFirst [GroupUserUser ==. user, GroupUserGroupId ==. groupId] []
|
|
||||||
if isNothing result then permissionDenied "you are not logged in or you dont have access to this group"
|
|
||||||
else runDB action
|
|
||||||
78
src/Handler/Todolist.hs
Normal file
78
src/Handler/Todolist.hs
Normal file
|
|
@ -0,0 +1,78 @@
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
|
{-# HLINT ignore "Replace case with fromMaybe" #-}
|
||||||
|
module Handler.Todolist where
|
||||||
|
|
||||||
|
import Database.Persist.Sql (fromSqlKey, toSqlKey)
|
||||||
|
import Import
|
||||||
|
import Text.Read
|
||||||
|
|
||||||
|
postAddTodolistR :: GroupId -> Handler Html
|
||||||
|
postAddTodolistR groupId = do
|
||||||
|
list <- runInputPost $ ireq textField "list"
|
||||||
|
-- TODO: in a newer version, put insertUnique_
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
_ <- dbIfAuth groupId (insertUnique $ Todolist groupId list currentTime)
|
||||||
|
redirect $ TodolistR groupId
|
||||||
|
|
||||||
|
getTodolistR :: GroupId -> Handler TypedContent
|
||||||
|
getTodolistR groupId = do
|
||||||
|
lists <- dbIfAuth groupId (selectList [TodolistGroupId ==. groupId] [])
|
||||||
|
selectRep $ do
|
||||||
|
provideRep
|
||||||
|
$ defaultLayout
|
||||||
|
$ do
|
||||||
|
let getTitle = todolistTitle . entityVal
|
||||||
|
setTitle "todolist"
|
||||||
|
$(widgetFile "todolist")
|
||||||
|
provideRep $ return $ unlines $ map todolistToCSV lists
|
||||||
|
|
||||||
|
getEditTodolistR :: GroupId -> Handler Html
|
||||||
|
getEditTodolistR groupId = do
|
||||||
|
lists <-
|
||||||
|
runDB
|
||||||
|
$ selectList [TodolistGroupId ==. groupId] [Asc TodolistTitle]
|
||||||
|
defaultLayout $ do
|
||||||
|
let keyToText e = pack $ show $ fromSqlKey $ entityKey e :: Text
|
||||||
|
setTitle "Groups"
|
||||||
|
$(widgetFile "edit-todolist")
|
||||||
|
|
||||||
|
postDeleteTodolistR :: GroupId -> Handler Html
|
||||||
|
postDeleteTodolistR groupId = do
|
||||||
|
text <- lookupPostParams "ids"
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
let ints = map (read . unpack) text :: [Int64]
|
||||||
|
let ids = map toSqlKey ints :: [TodolistId]
|
||||||
|
dbIfAuth
|
||||||
|
groupId
|
||||||
|
( do
|
||||||
|
deleteWhere [TodolistId <-. ids]
|
||||||
|
update groupId [GroupLastModified =. currentTime]
|
||||||
|
)
|
||||||
|
|
||||||
|
redirect $ EditTodolistR groupId
|
||||||
|
postEditTodolistR :: GroupId -> Handler Html
|
||||||
|
postEditTodolistR groupId = error "not done yet"
|
||||||
|
|
||||||
|
postAddUserR :: GroupId -> Handler Html
|
||||||
|
postAddUserR groupId = do
|
||||||
|
user <- runInputPost $ ireq textField "user"
|
||||||
|
_ <-
|
||||||
|
dbIfAuth
|
||||||
|
groupId
|
||||||
|
( do
|
||||||
|
mUserId <- getBy $ UniqueName user
|
||||||
|
case mUserId of
|
||||||
|
Nothing ->
|
||||||
|
-- handle error
|
||||||
|
redirect $ TodolistR groupId
|
||||||
|
Just userId -> insert $ GroupUser (entityKey userId) groupId
|
||||||
|
)
|
||||||
|
redirect $ TodolistR groupId
|
||||||
121
src/Handler/TodolistItem.hs
Normal file
121
src/Handler/TodolistItem.hs
Normal file
|
|
@ -0,0 +1,121 @@
|
||||||
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
{-# LANGUAGE QuasiQuotes #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
{-# LANGUAGE NoImplicitPrelude #-}
|
||||||
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
|
|
||||||
|
{-# HLINT ignore "Replace case with fromMaybe" #-}
|
||||||
|
module Handler.TodolistItem where
|
||||||
|
|
||||||
|
import Database.Persist.Sql (rawExecute)
|
||||||
|
import Import
|
||||||
|
|
||||||
|
getTodolistItemsR :: GroupId -> TodolistId -> Handler TypedContent
|
||||||
|
getTodolistItemsR groupId todolistId = do
|
||||||
|
mSortOption <- lookupSession "sort"
|
||||||
|
items <- case mSortOption of
|
||||||
|
(Just "value") -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Desc TodolistItemValue, Asc TodolistItemId])
|
||||||
|
_ -> dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [Asc TodolistItemId])
|
||||||
|
|
||||||
|
selectRep $ do
|
||||||
|
provideRep
|
||||||
|
$ defaultLayout
|
||||||
|
$ do
|
||||||
|
setTitle "items"
|
||||||
|
$(widgetFile "todolist-items")
|
||||||
|
provideRep $ return $ unlines $ map todolistItemToCSV items
|
||||||
|
|
||||||
|
postCheckTodolistItemR :: GroupId -> TodolistId -> TodolistItemId -> Handler Html
|
||||||
|
postCheckTodolistItemR groupId todolistId todolistItemId = do
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
dbIfAuth
|
||||||
|
groupId
|
||||||
|
( do
|
||||||
|
rawExecute "UPDATE todolist_item SET value = NOT value WHERE id = ?" [toPersistValue todolistItemId]
|
||||||
|
update todolistId [TodolistLastModified =. currentTime]
|
||||||
|
)
|
||||||
|
redirect $ TodolistItemsR groupId todolistId
|
||||||
|
|
||||||
|
postAddTodolistItemR :: GroupId -> TodolistId -> Handler Html
|
||||||
|
postAddTodolistItemR groupId todolistId = do
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
item <- runInputPost $ ireq textField "item"
|
||||||
|
_ <-
|
||||||
|
dbIfAuth
|
||||||
|
groupId
|
||||||
|
( do
|
||||||
|
insert_ $ TodolistItem todolistId False item
|
||||||
|
update todolistId [TodolistLastModified =. currentTime]
|
||||||
|
)
|
||||||
|
redirect $ TodolistItemsR groupId todolistId
|
||||||
|
|
||||||
|
getEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
||||||
|
getEditTodolistItemsR groupId todolistId = do
|
||||||
|
items <- dbIfAuth groupId (selectList [TodolistItemTodolistId ==. todolistId] [])
|
||||||
|
let text = unlines $ map getText items
|
||||||
|
defaultLayout $ do
|
||||||
|
setTitle "edit"
|
||||||
|
$(widgetFile "edit-todolist-items")
|
||||||
|
|
||||||
|
postEditTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
||||||
|
postEditTodolistItemsR groupId todolistId = do
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
mText <- runInputPost $ iopt textField "text"
|
||||||
|
let xs = case mText of
|
||||||
|
(Just text) -> getItems text todolistId
|
||||||
|
Nothing -> [] -- Case statement used to let delete all without error TODO: check if can use flatmap instead ?
|
||||||
|
dbIfAuth
|
||||||
|
groupId
|
||||||
|
( do
|
||||||
|
deleteWhere [TodolistItemTodolistId ==. todolistId]
|
||||||
|
insertMany_ xs
|
||||||
|
update todolistId [TodolistLastModified =. currentTime]
|
||||||
|
)
|
||||||
|
|
||||||
|
redirect $ TodolistItemsR groupId todolistId
|
||||||
|
|
||||||
|
postTrimTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
||||||
|
postTrimTodolistItemsR groupId todolistId = do
|
||||||
|
currentTime <- liftIO getCurrentTime
|
||||||
|
dbIfAuth
|
||||||
|
groupId
|
||||||
|
( do
|
||||||
|
deleteWhere [TodolistItemTodolistId ==. todolistId, TodolistItemValue ==. True]
|
||||||
|
update todolistId [TodolistLastModified =. currentTime]
|
||||||
|
)
|
||||||
|
redirect $ TodolistItemsR groupId todolistId
|
||||||
|
|
||||||
|
postSortTodolistItemsR :: GroupId -> TodolistId -> Handler Html
|
||||||
|
postSortTodolistItemsR groupId todolistId = do
|
||||||
|
mSession <- lookupSession "sort"
|
||||||
|
case mSession of
|
||||||
|
(Just "value") -> setSession "sort" "id"
|
||||||
|
_ -> setSession "sort" "value"
|
||||||
|
redirect $ TodolistItemsR groupId todolistId
|
||||||
|
|
||||||
|
getText :: Entity TodolistItem -> Text
|
||||||
|
getText item =
|
||||||
|
if value
|
||||||
|
then "[x] " <> name
|
||||||
|
else "[ ] " <> name
|
||||||
|
where
|
||||||
|
value = (todolistItemValue . entityVal) item
|
||||||
|
name = (todolistItemName . entityVal) item
|
||||||
|
|
||||||
|
getItems :: Text -> TodolistId -> [TodolistItem]
|
||||||
|
getItems text todolistId = map read (lines text)
|
||||||
|
where
|
||||||
|
read line = do
|
||||||
|
let (d, n) = splitAt 4 line
|
||||||
|
let
|
||||||
|
value = case d of
|
||||||
|
"[x] " -> True
|
||||||
|
"[ ] " -> False
|
||||||
|
_ -> error "Invalid status"
|
||||||
|
name = case n of
|
||||||
|
"" -> error "empty name"
|
||||||
|
something -> filter (/= '\r') something
|
||||||
|
TodolistItem todolistId value name
|
||||||
|
|
@ -49,7 +49,7 @@ packages:
|
||||||
# extra-package-dbs: []
|
# extra-package-dbs: []
|
||||||
|
|
||||||
# Control whether we use the GHC we find on the path
|
# Control whether we use the GHC we find on the path
|
||||||
# system-ghc: true
|
system-ghc: true
|
||||||
#
|
#
|
||||||
# Require a specific version of Stack, using version ranges
|
# Require a specific version of Stack, using version ranges
|
||||||
# require-stack-version: -any # Default
|
# require-stack-version: -any # Default
|
||||||
|
|
|
||||||
|
|
@ -1,7 +1,7 @@
|
||||||
# This file was autogenerated by Stack.
|
# This file was autogenerated by Stack.
|
||||||
# You should not edit this file by hand.
|
# You should not edit this file by hand.
|
||||||
# For more information, please see the documentation at:
|
# For more information, please see the documentation at:
|
||||||
# https://docs.haskellstack.org/en/stable/topics/lock_files
|
# https://docs.haskellstack.org/en/stable/lock_files
|
||||||
|
|
||||||
packages: []
|
packages: []
|
||||||
snapshots:
|
snapshots:
|
||||||
|
|
|
||||||
|
|
@ -2,8 +2,7 @@
|
||||||
<div .container>
|
<div .container>
|
||||||
$maybe msg <- mmsg
|
$maybe msg <- mmsg
|
||||||
<div>#{msg}
|
<div>#{msg}
|
||||||
|
^{widget}
|
||||||
^{widget}
|
|
||||||
|
|
||||||
<!-- Footer -->
|
<!-- Footer -->
|
||||||
<footer>
|
<footer>
|
||||||
|
|
|
||||||
8
templates/edit-group.hamlet
Normal file
8
templates/edit-group.hamlet
Normal file
|
|
@ -0,0 +1,8 @@
|
||||||
|
<form action=@{DeleteGroupR} method="POST">
|
||||||
|
<ul>
|
||||||
|
$forall group <- groups
|
||||||
|
<li>
|
||||||
|
<input type="checkbox" name="ids" value="#{a group}">
|
||||||
|
<a href="">#{(groupGroup . entityVal) group}
|
||||||
|
<button type=submit>Delete selected
|
||||||
|
<a href=@{GroupR}>Back
|
||||||
6
templates/edit-todolist-items.hamlet
Normal file
6
templates/edit-todolist-items.hamlet
Normal file
|
|
@ -0,0 +1,6 @@
|
||||||
|
<form action=@{EditTodolistItemsR groupId todolistId} method=POST>
|
||||||
|
<label for="edit text area">Edit todolist
|
||||||
|
<br>
|
||||||
|
<textarea id="edit text area" name=text rows=30 cols=50 placeholder="[x] wake up1 [x] eat [ ] sleep [ ] repeat">#{text}
|
||||||
|
<br>
|
||||||
|
<button type="submit">edit
|
||||||
8
templates/edit-todolist.hamlet
Normal file
8
templates/edit-todolist.hamlet
Normal file
|
|
@ -0,0 +1,8 @@
|
||||||
|
<form action=@{DeleteTodolistR groupId} method="POST">
|
||||||
|
<ul>
|
||||||
|
$forall list <- lists
|
||||||
|
<li>
|
||||||
|
<input type="checkbox" name="ids" value="#{keyToText list}">
|
||||||
|
<a href="">#{(todolistTitle . entityVal) list}
|
||||||
|
<button type=submit>Delete selected
|
||||||
|
<a href=@{TodolistR groupId}>Back
|
||||||
9
templates/group.hamlet
Normal file
9
templates/group.hamlet
Normal file
|
|
@ -0,0 +1,9 @@
|
||||||
|
<a href=@{GroupR}>Home
|
||||||
|
<ul>
|
||||||
|
$forall group <- groups
|
||||||
|
<li>
|
||||||
|
<a href=@{TodolistR $ entityKey group}>#{(groupGroup . entityVal) group}
|
||||||
|
<form action=@{AddGroupR} method="post">
|
||||||
|
<input type="text" name="group" placeholder="new group">
|
||||||
|
<button type="submit">add
|
||||||
|
<a href=@{EditGroupR}>Edit
|
||||||
|
|
@ -1,141 +0,0 @@
|
||||||
<div .masthead>
|
|
||||||
<div .container>
|
|
||||||
<div .row>
|
|
||||||
<h1 .header>
|
|
||||||
Yesod—a modern framework for blazing fast websites
|
|
||||||
<h2>
|
|
||||||
Fast, stable & spiced with great community
|
|
||||||
<a href="http://www.yesodweb.com/book/" .btn.btn-info.btn-lg>
|
|
||||||
Read the Book
|
|
||||||
|
|
||||||
<div .container>
|
|
||||||
<!-- Starting
|
|
||||||
================================================== -->
|
|
||||||
<div .bs-docs-section>
|
|
||||||
<div .row>
|
|
||||||
<div .col-lg-12>
|
|
||||||
<div .page-header>
|
|
||||||
<h1 #start>Starting
|
|
||||||
|
|
||||||
<p>
|
|
||||||
Now that you have a working project you should use the
|
|
||||||
<a href=http://www.yesodweb.com/book/>Yesod book</a> to learn more.
|
|
||||||
<p>
|
|
||||||
You can also use this scaffolded site to explore some concepts, and best practices.
|
|
||||||
|
|
||||||
<ul .list-group>
|
|
||||||
|
|
||||||
<li .list-group-item>
|
|
||||||
This page was generated by the <tt>#{handlerName}</tt> handler in
|
|
||||||
<tt>Handler/Home.hs</tt>.
|
|
||||||
|
|
||||||
<li .list-group-item>
|
|
||||||
The <tt>#{handlerName}</tt> handler is set to generate your
|
|
||||||
site's home screen in the Routes file
|
|
||||||
<tt>config/routes.yesodroutes
|
|
||||||
|
|
||||||
<li .list-group-item>
|
|
||||||
We can link to other handlers, like the <a href="@{ProfileR}">Profile</a>.
|
|
||||||
Try it out as an anonymous user and see the access denied.
|
|
||||||
Then, try to <a href="@{AuthR LoginR}">login</a> with the dummy authentication added
|
|
||||||
while in development.
|
|
||||||
|
|
||||||
<li .list-group-item>
|
|
||||||
The HTML you are seeing now is actually composed by a number of <em>widgets</em>, #
|
|
||||||
most of them are brought together by the <tt>defaultLayout</tt> function which #
|
|
||||||
is defined in the <tt>Foundation.hs</tt> module, and used by <tt>#{handlerName}</tt>. #
|
|
||||||
All the files for templates and widgets are in <tt>templates</tt>.
|
|
||||||
|
|
||||||
<li .list-group-item>
|
|
||||||
A Widget's Html, Css and Javascript are separated in three files with the
|
|
||||||
<tt>.hamlet</tt>, <tt>.lucius</tt> and <tt>.julius</tt> extensions.
|
|
||||||
|
|
||||||
<li .list-group-item ##{aDomId}>
|
|
||||||
If you had javascript enabled then you wouldn't be seeing this.
|
|
||||||
|
|
||||||
<hr>
|
|
||||||
|
|
||||||
<!-- Forms
|
|
||||||
================================================== -->
|
|
||||||
<div .bs-docs-section>
|
|
||||||
<div .row>
|
|
||||||
<div .col-lg-12>
|
|
||||||
<div .page-header>
|
|
||||||
<h1 #forms>Forms
|
|
||||||
|
|
||||||
<p>
|
|
||||||
This is an example of a form. Read the
|
|
||||||
<a href="http://www.yesodweb.com/book/forms">Forms chapter</a> #
|
|
||||||
in the yesod book to learn more about them.
|
|
||||||
|
|
||||||
<div .row>
|
|
||||||
<div .col-lg-6>
|
|
||||||
<div .bs-callout bs-callout-info well>
|
|
||||||
<form .form-horizontal method=post action=@{HomeR}#forms enctype=#{formEnctype}>
|
|
||||||
^{formWidget}
|
|
||||||
|
|
||||||
<button .btn.btn-primary type="submit">
|
|
||||||
Upload it!
|
|
||||||
|
|
||||||
|
|
||||||
<div .col-lg-4.col-lg-offset-1>
|
|
||||||
<div .bs-callout.bs-callout-info.upload-response>
|
|
||||||
|
|
||||||
$maybe (FileForm info con) <- submission
|
|
||||||
Your file type is <em>#{fileContentType info}</em>. You say it has: <em>#{con}</em>
|
|
||||||
|
|
||||||
$nothing
|
|
||||||
File upload result will be here...
|
|
||||||
|
|
||||||
|
|
||||||
<hr>
|
|
||||||
|
|
||||||
<!-- JSON
|
|
||||||
================================================== -->
|
|
||||||
<div .bs-docs-section>
|
|
||||||
<div .row>
|
|
||||||
<div .col-lg-12>
|
|
||||||
<div .page-header>
|
|
||||||
<h1 #json>JSON
|
|
||||||
|
|
||||||
<p>
|
|
||||||
Yesod has JSON support baked-in.
|
|
||||||
The form below makes an AJAX request with Javascript,
|
|
||||||
then updates the page with your submission.
|
|
||||||
(see <tt>Handler/Comment.hs</tt>, <tt>templates/homepage.julius</tt>,
|
|
||||||
and <tt>Handler/Home.hs</tt> for the implementation).
|
|
||||||
|
|
||||||
<div .row>
|
|
||||||
<div .col-lg-6>
|
|
||||||
<div .bs-callout.bs-callout-info.well>
|
|
||||||
<form .form-horizontal ##{commentFormId}>
|
|
||||||
<div .field>
|
|
||||||
<textarea rows="2" ##{commentTextareaId} placeholder="Your comment here..." required></textarea>
|
|
||||||
|
|
||||||
<button .btn.btn-primary type=submit>
|
|
||||||
Create comment
|
|
||||||
|
|
||||||
<div .col-lg-4.col-lg-offset-1>
|
|
||||||
<div .bs-callout.bs-callout-info>
|
|
||||||
<small>
|
|
||||||
Your comments will appear here. You can also open the
|
|
||||||
console log to see the raw response from the server.
|
|
||||||
<ul ##{commentListId}>
|
|
||||||
$forall comment <- allComments
|
|
||||||
<li>#{commentMessage $ entityVal comment}
|
|
||||||
|
|
||||||
<hr>
|
|
||||||
|
|
||||||
<!-- Testing
|
|
||||||
================================================== -->
|
|
||||||
<div .bs-docs-section>
|
|
||||||
<div .row>
|
|
||||||
<div .col-lg-12>
|
|
||||||
<div .page-header>
|
|
||||||
<h1 #test>Testing
|
|
||||||
|
|
||||||
<p>
|
|
||||||
And last but not least, Testing. In <tt>test/Spec.hs</tt> you will find a #
|
|
||||||
test suite that performs tests on this page.
|
|
||||||
<p>
|
|
||||||
You can run your tests by doing: <code>stack test</code>
|
|
||||||
|
|
@ -1,34 +0,0 @@
|
||||||
document.getElementById(#{toJSON aDomId}).innerHTML = "This text was added by the Javascript part of the homepage widget.";
|
|
||||||
|
|
||||||
$(function() {
|
|
||||||
$("##{rawJS commentFormId}").submit(function(event) {
|
|
||||||
event.preventDefault();
|
|
||||||
|
|
||||||
var message = $("##{rawJS commentTextareaId}").val();
|
|
||||||
// (Browsers that enforce the "required" attribute on the textarea won't see this alert)
|
|
||||||
if (!message) {
|
|
||||||
alert("Please fill out the comment form first.");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
|
|
||||||
// Make an AJAX request to the server to create a new comment
|
|
||||||
$.ajax({
|
|
||||||
url: '@{CommentR}',
|
|
||||||
type: 'POST',
|
|
||||||
contentType: "application/json",
|
|
||||||
data: JSON.stringify({
|
|
||||||
message: message,
|
|
||||||
}),
|
|
||||||
success: function (data) {
|
|
||||||
var newNode = $("<li></li>");
|
|
||||||
newNode.text(data.message);
|
|
||||||
console.log(data);
|
|
||||||
$("##{rawJS commentListId}").append(newNode);
|
|
||||||
},
|
|
||||||
error: function (data) {
|
|
||||||
console.log("Error creating comment: " + data);
|
|
||||||
},
|
|
||||||
});
|
|
||||||
|
|
||||||
});
|
|
||||||
});
|
|
||||||
|
|
@ -1,13 +0,0 @@
|
||||||
h2##{aDomId} {
|
|
||||||
color: #990
|
|
||||||
}
|
|
||||||
|
|
||||||
li {
|
|
||||||
line-height: 2em;
|
|
||||||
font-size: 16px
|
|
||||||
}
|
|
||||||
|
|
||||||
##{commentTextareaId} {
|
|
||||||
width: 400px;
|
|
||||||
height: 100px;
|
|
||||||
}
|
|
||||||
|
|
@ -1,10 +0,0 @@
|
||||||
<div .ui.container>
|
|
||||||
|
|
||||||
<h1>
|
|
||||||
Access granted!
|
|
||||||
|
|
||||||
<p>
|
|
||||||
This page is protected and access is allowed only for authenticated users.
|
|
||||||
|
|
||||||
<p>
|
|
||||||
Your data is protected with us <strong><span class="username">#{userIdent user}</span></strong>!
|
|
||||||
17
templates/todolist-items.hamlet
Normal file
17
templates/todolist-items.hamlet
Normal file
|
|
@ -0,0 +1,17 @@
|
||||||
|
<a href=@{GroupR}>Home
|
||||||
|
|
||||||
|
<a href=@{TodolistR groupId}>Lists
|
||||||
|
<ul>
|
||||||
|
$forall item <- items
|
||||||
|
<li>
|
||||||
|
<form action=@{CheckTodolistItemR groupId todolistId (entityKey item)} method="POST">
|
||||||
|
<button type="submit">#{getText item}
|
||||||
|
<form action=@{AddTodolistItemR groupId todolistId} method="post">
|
||||||
|
<form action=@{AddTodolistItemR groupId todolistId} method="post">
|
||||||
|
<input type="text" name="item" placeholder="new item">
|
||||||
|
<button type="submit">add
|
||||||
|
<form action=@{TrimTodolistItemsR groupId todolistId} method="post">
|
||||||
|
<button type="submit">trim
|
||||||
|
<form action=@{SortTodolistItemsR groupId todolistId} method="post">
|
||||||
|
<button type="submit">sort
|
||||||
|
<a href=@{EditTodolistItemsR groupId todolistId}>Edit
|
||||||
12
templates/todolist.hamlet
Normal file
12
templates/todolist.hamlet
Normal file
|
|
@ -0,0 +1,12 @@
|
||||||
|
<a href=@{GroupR}>Home
|
||||||
|
<ul>
|
||||||
|
$forall list <- lists
|
||||||
|
<li>
|
||||||
|
<a href=@{TodolistItemsR groupId (entityKey list)}>#{getTitle list}
|
||||||
|
<form action=@{AddTodolistR groupId} method="post">
|
||||||
|
<input type="text" name="list" placeholder="new list">
|
||||||
|
<button type="submit">add
|
||||||
|
<form action=@{AddUserR groupId} method="post">
|
||||||
|
<input type="text" name="user" placeholder="new user">
|
||||||
|
<button type="submit">share
|
||||||
|
<a href=@{EditTodolistR groupId}>Edit
|
||||||
Loading…
Add table
Add a link
Reference in a new issue