README.md

@@ -1,27 +1,10 @@
 # sTodo
 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.
-## Usage
+
-- can be used as is for a single user behind a vpn (for ex, wireguard)
+## Version 1.0.0
-- can be setup for multi user with a reverse proxy and an authentification provider that supports trusted sso  (for ex, nginx + authelia)
+Simple todo list for **single user only** at the moment.
-## Next goals
+
-- Make multi user support
-	- [ ] write a minimal step by step guide to install with nix,
-	- [ ] add some css to make it look nicer
-	- [ ] add htmx to make more agreable without making js manadatory
-	- [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)
-  - [ ] 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 :
-	- add and delete groups that contain a list of todolists
-	- add and delete todolists inside groups
-	- 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
-	- that's it, the goal is to keep it minimal !!!
-# Development
 ## Haskell Setup
 
 1. If you haven't already, [install Stack](https://haskell-lang.org/get-started)

client_session_key.aes

@@ -1 +0,0 @@
-:M^¦ÄO2«I†èš‘³‰4,pe<70>¿Ôì8Ä·,CI†(q¸¦7/ ÷gGˆuâÍ×¥L'¿(Éœ¡wq1I#ÔpµÌYW»)2L{2—;våÇ_ižËÀ[ÛÈʳ<C38A>ûÕY

config/client_session_key

@@ -1 +0,0 @@
-‏xdHB>ט<>“,ס‚rM‘םE®vף×ֶ’תה`’₪<13>e״<?ל<>ֺq־P§¶p€$ֶ¢
d<>ֺR»ס׳©אױ´sR<73>Mk~¥ auָz|‚ט₪>“\hםuQׁכ¯R4­‎Q

config/models.persistentmodels

@@ -8,15 +8,13 @@ TodolistItem
 Todolist
     groupId GroupId OnDeleteCascade
     title Text
-    lastModified UTCTime
     UniqueListPair groupId title
 User
     name Text
-    lastModified UTCTime
     UniqueName name
 Group
     group Text
-    lastModified UTCTime
 GroupUser
     user UserId
-    groupId GroupId OnDeleteCascade
+    group Text
+    groupId GroupId OnDeleteCascade

config/routes.yesodroutes

@@ -6,7 +6,7 @@
 /favicon.ico FaviconR GET
 /robots.txt RobotsR GET
 
-/ GroupR GET
+/ HomeR GET
 /group/#GroupId TodolistR GET
 
 /add AddGroupR POST 
@@ -16,14 +16,10 @@
 
 /check/group/#GroupId/todolist/#TodolistId/#TodolistItemId CheckTodolistItemR 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
-/adduser/group/#GroupId AddUserR POST
 /edit EditGroupR GET POST
 
 /delete DeleteGroupR POST
 /delete/group/#GroupId DeleteTodolistR POST
 
-/api/#Int ApiR GET

config/settings.yml

@@ -2,7 +2,6 @@
 # See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables
 
 static-dir:     "_env:YESOD_STATIC_DIR:static"
-session-key:     "_env:YESOD_SESSION_KEY:config/client_session_key"
 host:           "_env:YESOD_HOST:*4" # any IPv4 host
 port:           "_env:YESOD_PORT:3000" # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line.
 # For `keter` user, enable the follwing line, and comment out previous one.

flake.nix

@@ -1,125 +0,0 @@
-{
-  description = "A flake to install sTodo";
-
-  inputs = {
-    nixpkgs.url = "github:nixos/nixpkgs/nixos-unstable";
-  };
-
-  outputs = {
-    self,
-    nixpkgs,
-  }: let
-    tarball = fetchTarball {
-      url = "https://git.stuce.ch/stuce/sTodo/releases/download/r3/r3.tar.gz";
-      sha256 = "1imgbbgbgx2r8qr90mpxlwfy9hcfpdz0sa4nir05jhqx8q1rl0y1";
-    };
-  in {
-    packages.x86_64-linux.sTodo = with nixpkgs.legacyPackages.x86_64-linux;
-      stdenv.mkDerivation {
-        pname = "sTodo";
-        version = "1.0.0";
-        src = tarball;
-        buildInputs = [libz gmp libffi];
-        nativeBuildInputs = [openssl];
-        installPhase = ''
-          mkdir -p $out/bin
-          cp $src/sTodo $out/bin
-          chmod ugo+x $out/bin/sTodo
-        '';
-        mainProgram = "sTodo";
-      };
-    nixosModules.sTodo = {
-      config,
-      lib,
-      pkgs,
-      ...
-    }: let
-      cfg = config.services.sTodo;
-      sessionKey = "/etc/sTodo/client_session_key.aes";
-    in {
-      options.services.sTodo = {
-        # options.programs.sTodo = {
-        enable = lib.mkEnableOption "sTodo";
-        package = lib.mkOption {
-          type = lib.types.package;
-          default = self.packages.x86_64-linux.sTodo;
-        };
-        appRoot = lib.mkOption {
-          type = lib.types.str;
-          default = "http://localhost:6901";
-          description = "Link used to access the webapp";
-        };
-        clientSessionKey = lib.mkOption {
-          type = lib.types.str;
-          default = "/etc/sTodo/client_session_key.aes";
-          description = "Location of the client session key";
-        };
-
-        port = lib.mkOption {
-          type = lib.types.int;
-          default = 6901;
-          description = "Default port of the app";
-        };
-      };
-
-      # Systemd Service
-      config = lib.mkIf cfg.enable {
-        environment.etc."sTodo/static" = {
-          source = "${tarball}/static";
-        };
-        environment.systemPackages = [pkgs.openssl];
-        users.groups."sTodo".name = "sTodo";
-        users.users."sTodo" = {
-          name = "sTodo";
-          isSystemUser = true;
-          group = "sTodo";
-        };
-        systemd.services.sTodo.preStart = ''
-          [ -f ${sessionKey} ] || {
-            "${pkgs.openssl}/bin/openssl" rand 256 > ${sessionKey}
-          }
-        '';
-        systemd.services.sTodo = {
-          description = "Launch a sTodo app to have a online todolist";
-          after = ["network.target"];
-          wantedBy = ["multi-user.target"];
-          serviceConfig = {
-            ExecStart = "${cfg.package}/bin/sTodo";
-            Restart = "always";
-            User = "sTodo";
-            Group = "sTodo";
-            StateDirectory = "sTodo";
-            StateDirectoryMode = "0700";
-
-            AmbientCapabilities = "";
-            CapabilityBoundingSet = "";
-            DeviceAllow = "";
-            LockPersonality = true;
-            MemoryDenyWriteExecute = true;
-            NoNewPrivileges = true;
-
-            PrivateDevices = true;
-            PrivateUsers = true;
-
-            ProtectClock = true;
-            ProtectControlGroups = true;
-            ProtectHome = "read-only";
-            ProtectHostname = true;
-            ProtectKernelLogs = true;
-            ProtectKernelModules = true;
-            ProtectKernelTunables = true;
-            ProtectProc = "noaccess";
-            ProtectSystem = "strict";
-          };
-          environment = {
-            YESOD_PORT = "${toString cfg.port}";
-            YESOD_APPROOT = "${cfg.appRoot}";
-            YESOD_SQLITE_DATABASE = "/var/lib/sTodo/sTodo.sqlite3";
-            YESOD_STATIC_DIR = "/etc/sTodo/static";
-            YESOD_SESSION_KEY = sessionKey;
-          };
-        };
-      };
-    };
-  };
-}

shell.nix

@@ -1,11 +0,0 @@
-{pkgs ? import <nixpkgs> {}}:
-pkgs.mkShell {
-  buildInputs = [
-    pkgs.haskellPackages.ghc
-    pkgs.haskellPackages.stack
-    pkgs.haskellPackages.yesod
-    pkgs.haskellPackages.yesod-bin
-    pkgs.haskellPackages.haskell-language-server
-    pkgs.zlib
-  ];
-}

src/Application.hs

@@ -1,14 +1,11 @@
 {-# LANGUAGE NoImplicitPrelude #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE InstanceSigs #-}
 module Application
     ( getApplicationDev
     , appMain
@@ -44,10 +41,8 @@ import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
 -- Import all relevant handler modules here.
 -- Don't forget to add new modules to your cabal file!
 import Handler.Common
-import Handler.Group
+import Handler.Home
-import Handler.Todolist
+import Handler.TodoEntry
-import Handler.TodolistItem
-import Handler.Api
 
 -- 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
@@ -191,4 +186,4 @@ handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
 
 -- | Run DB queries
 db :: ReaderT SqlBackend Handler a -> IO a
-db = handler . runDB
+db = handler . runDB

src/Foundation.hs

@@ -1,53 +1,49 @@
-{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE NoImplicitPrelude #-}
-{-# LANGUAGE ImportQualifiedPost #-}
-{-# LANGUAGE InstanceSigs #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE InstanceSigs #-}
 
 module Foundation where
 
-import Control.Monad.Logger (LogSource)
-import Data.Kind (Type)
-import Data.Text qualified as Text (intercalate, pack)
-import Database.Persist.Sql (ConnectionPool, rawSql, runSqlPool)
 import Import.NoFoundation
-import Text.Hamlet (hamletFile)
+import Data.Kind            (Type)
-import Text.Jasmine (minifym)
+import Database.Persist.Sql (ConnectionPool, runSqlPool)
+import Text.Hamlet          (hamletFile)
+import Text.Jasmine         (minifym)
+import Control.Monad.Logger (LogSource)
 
-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
+import Yesod.Default.Util   (addStaticContentExternal)
-import Yesod.Core.Types (Logger)
+import Yesod.Core.Types     (Logger)
-import Yesod.Core.Unsafe qualified as Unsafe
+import qualified Yesod.Core.Unsafe as Unsafe
-import Yesod.Default.Util (addStaticContentExternal)
+import qualified Data.CaseInsensitive as CI
+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
-  { appSettings :: AppSettings
+    { appSettings    :: AppSettings
-  , appStatic :: Static
+    , appStatic      :: Static -- ^ Settings for static file serving.
-  -- ^ Settings for static file serving.
+    , appConnPool    :: ConnectionPool -- ^ Database connection pool.
-  , appConnPool :: ConnectionPool
+    , appHttpManager :: Manager
-  -- ^ Database connection pool.
+    , appLogger      :: Logger
-  , appHttpManager :: Manager
+    }
-  , appLogger :: Logger
-  }
 
 data MenuItem = MenuItem
-  { menuItemLabel :: Text
+    { menuItemLabel :: Text
-  , menuItemRoute :: Route App
+    , menuItemRoute :: Route App
-  , menuItemAccessCallback :: Bool
+    , menuItemAccessCallback :: Bool
-  }
+    }
 
 data MenuTypes
-  = NavbarLeft MenuItem
+    = NavbarLeft MenuItem
-  | NavbarRight MenuItem
+    | NavbarRight MenuItem
 
 -- This is where we define all of the routes in our application. For a full
 -- explanation of the syntax, please see:
@@ -67,128 +63,123 @@ mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")
 type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
 
 -- | A convenient synonym for database access functions.
-type DB a =
+type DB a = forall (m :: Type -> Type).
-  forall (m :: Type -> Type).
+    (MonadUnliftIO m) => ReaderT SqlBackend m a
-  (MonadUnliftIO m) =>
-  ReaderT SqlBackend m a
 
 -- Please see the documentation for the Yesod typeclass. There are a number
 -- of settings which can be configured by overriding methods here.
 instance Yesod App where
-  -- Controls the base of generated URLs. For more information on modifying,
+    -- Controls the base of generated URLs. For more information on modifying,
-  -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
+    -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
-  approot :: Approot App
+    approot :: Approot App
-  approot = ApprootRequest $ \app req ->
+    approot = ApprootRequest $ \app req ->
-    case appRoot $ appSettings app of
+        case appRoot $ appSettings app of
-      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 _ = Just <$> defaultClientSessionBackend
-  --     120    -- timeout in minutes
+        120    -- timeout in minutes
-  --     (appSessionKey $ appSettings app)
+        "config/client_session_key.aes"
 
-  -- 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.
-  -- Some users may also want to add the defaultCsrfMiddleware, which:
+    -- Some users may also want to add the defaultCsrfMiddleware, which:
-  --   a) Sets a cookie with a CSRF token in it.
+    --   a) Sets a cookie with a CSRF token in it.
-  --   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
-    -- default-layout-wrapper is the entire page. Since the final
+        -- default-layout-wrapper is the entire page. Since the final
-    -- value passed to hamletToRepHtml cannot be a widget, this allows
+        -- value passed to hamletToRepHtml cannot be a widget, this allows
-    -- you to use normal widget features in default-layout.
+        -- you to use normal widget features in default-layout.
 
-    pc <- widgetToPageContent $ do
+        pc <- widgetToPageContent $ do
-      $(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.
-  -- isAuthorized _ _ = return Authorized
+    -- TODO: check this bullshit if need to change it or not (prolly authelia problem)
+    isAuthorized _ _ = return Authorized
 
-  -- This function creates static content files in the static folder
-  -- and names them based on a hash of their content. This allows
-  -- expiration dates to be set far in the future without worry of
-  -- users receiving stale content.
-  addStaticContent ::
-    Text ->
-    -- \^ The file extension
-    Text ->
-    -- \^ The MIME content type
-    LByteString ->
-    -- \^ The contents of the file
-    Handler (Maybe (Either Text (Route App, [(Text, Text)])))
-  addStaticContent ext mime content = do
-    master <- getYesod
-    let staticDir = appStaticDir $ appSettings master
-    addStaticContentExternal
-      minifym
-      genFileName
-      staticDir
-      (StaticR . flip StaticRoute [])
-      ext
-      mime
-      content
-   where
-    -- Generate a unique filename based on the content itself
-    genFileName lbs = "autogen-" ++ base64md5 lbs
 
-  -- What messages should be logged. The following includes all messages when
+    -- This function creates static content files in the static folder
-  -- in development, and warnings and errors in production.
+    -- and names them based on a hash of their content. This allows
-  shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
+    -- expiration dates to be set far in the future without worry of
-  shouldLogIO app _source level =
+    -- users receiving stale content.
-    return
+    addStaticContent
-      $ appShouldLogAll (appSettings app)
+        :: Text  -- ^ The file extension
-      || level
+        -> Text -- ^ The MIME content type
-      == LevelWarn
+        -> LByteString -- ^ The contents of the file
-      || level
+        -> Handler (Maybe (Either Text (Route App, [(Text, Text)])))
-      == LevelError
+    addStaticContent ext mime content = do
+        master <- getYesod
+        let staticDir = appStaticDir $ appSettings master
+        addStaticContentExternal
+            minifym
+            genFileName
+            staticDir
+            (StaticR . flip StaticRoute [])
+            ext
+            mime
+            content
+      where
+        -- Generate a unique filename based on the content itself
+        genFileName lbs = "autogen-" ++ base64md5 lbs
 
-  makeLogger :: App -> IO Logger
+    -- What messages should be logged. The following includes all messages when
-  makeLogger = return . appLogger
+    -- in development, and warnings and errors in production.
+    shouldLogIO :: App -> LogSource -> LogLevel -> IO Bool
+    shouldLogIO app _source level =
+        return $
+        appShouldLogAll (appSettings app)
+            || level == LevelWarn
+            || level == LevelError
+
+    makeLogger :: App -> IO Logger
+    makeLogger = return . appLogger
 
 -- How to run database actions.
 instance YesodPersist App where
-  type YesodPersistBackend App = SqlBackend
+    type YesodPersistBackend App = SqlBackend
-  runDB :: SqlPersistT Handler a -> Handler a
+    runDB :: SqlPersistT Handler a -> Handler a
-  runDB action = do
+    runDB action = do
-    master <- getYesod
+        master <- getYesod
-    runSqlPool action $ appConnPool master
+        runSqlPool action $ appConnPool master
 
 instance YesodPersistRunner App where
-  getDBRunner :: Handler (DBRunner App, Handler ())
+    getDBRunner :: Handler (DBRunner App, Handler ())
-  getDBRunner = defaultGetDBRunner appConnPool
+    getDBRunner = defaultGetDBRunner appConnPool
 
 -- This instance is required to use forms. You can modify renderMessage to
 -- achieve customized and internationalized form validation messages.
 instance RenderMessage App FormMessage where
-  renderMessage :: App -> [Lang] -> FormMessage -> Text
+    renderMessage :: App -> [Lang] -> FormMessage -> Text
-  renderMessage _ _ = defaultFormMessage
+    renderMessage _ _ = defaultFormMessage
 
 -- Useful when writing code that is re-usable outside of the Handler context.
 -- An example is background jobs that send email.
 -- This can also be useful for writing code that works across multiple Yesod applications.
 instance HasHttpManager App where
-  getHttpManager :: App -> Manager
+    getHttpManager :: App -> Manager
-  getHttpManager = appHttpManager
+    getHttpManager = appHttpManager
 
 unsafeHandler :: App -> Handler a -> IO a
 unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
@@ -200,50 +191,3 @@ unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
 -- 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/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"

src/Handler/Api.hs

@@ -1,33 +0,0 @@
-{-# 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

src/Handler/Group.hs

@@ -1,73 +0,0 @@
-{-# 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

src/Handler/TodoEntry.hs

@@ -0,0 +1,249 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE FlexibleContexts #-}
+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
+            &nbsp;
+            <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&#10;[x] eat&#10;[ ] sleep&#10;[ ] 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
+    groups <- runDB $ do
+        -- TODO: using 404 is just a hack to win time, but next it needs better auth handling
+        userId <- getBy404 $ UniqueName getUser
+        selectList [GroupUserUser ==. entityKey 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
+getUser = "Stuce" :: Text
+
+getUserId :: Handler (Key User)
+getUserId = do
+        mUser <- runDB $ getBy $ UniqueName getUser
+        case mUser of
+            Nothing -> runDB $ insert $ User getUser
+            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

src/Handler/Todolist.hs

@@ -1,78 +0,0 @@
-{-# 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

src/Handler/TodolistItem.hs

@@ -1,121 +0,0 @@
-{-# 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

src/Settings.hs

@@ -33,8 +33,7 @@ data AppSettings = AppSettings
     -- ^ Configuration settings for accessing the database.
     , appRoot                   :: Maybe Text
     -- ^ Base for all generated URLs. If @Nothing@, determined
-    , appSessionKey                :: [Char]
+    -- from the request headers.
-    -- ^ Where to get the client session key
     , appHost                   :: HostPreference
     -- ^ Host/interface the server should bind to.
     , appPort                   :: Int
@@ -75,7 +74,6 @@ instance FromJSON AppSettings where
         appStaticDir              <- o .: "static-dir"
         appDatabaseConf           <- o .: "database"
         appRoot                   <- o .:? "approot"
-        appSessionKey                <- o .: "session-key"
         appHost                   <- fromString <$> o .: "host"
         appPort                   <- o .: "port"
         appIpFromHeader           <- o .: "ip-from-header"

stack.yaml

@@ -49,7 +49,7 @@ packages:
 # extra-package-dbs: []
 
 # 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-stack-version: -any # Default

stack.yaml.lock

@@ -1,7 +1,7 @@
 # This file was autogenerated by Stack.
 # You should not edit this file by hand.
 # For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/lock_files
+#   https://docs.haskellstack.org/en/stable/topics/lock_files
 
 packages: []
 snapshots:

templates/default-layout.hamlet

@@ -1,10 +1,11 @@
 <!-- Page Contents -->
 <div .container>
-  $maybe msg <- mmsg
+    $maybe msg <- mmsg
-    <div>#{msg}
+      <div>#{msg}
-  ^{widget}
+
+^{widget}
 
 <!-- Footer -->
 <footer>
-  <p>
+        <p>
-    #{appCopyright $ appSettings master}
+            #{appCopyright $ appSettings master}

templates/edit-group.hamlet

@@ -1,8 +0,0 @@
-<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

templates/edit-todolist-items.hamlet

@@ -1,6 +0,0 @@
-<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&#10;[x] eat&#10;[ ] sleep&#10;[ ] repeat">#{text}
-  <br>
-  <button type="submit">edit

templates/edit-todolist.hamlet

@@ -1,8 +0,0 @@
-<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

templates/group.hamlet

@@ -1,9 +0,0 @@
-<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

templates/homepage.hamlet

@@ -0,0 +1,141 @@
+<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>

templates/homepage.julius

@@ -0,0 +1,34 @@
+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);
+      },
+    });
+
+  });
+});

templates/homepage.lucius

@@ -0,0 +1,13 @@
+h2##{aDomId} {
+    color: #990
+}
+
+li {
+    line-height: 2em;
+    font-size: 16px
+}
+
+##{commentTextareaId} {
+    width: 400px;
+    height: 100px;
+}

templates/profile.hamlet

@@ -0,0 +1,10 @@
+<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>!

templates/todolist-items.hamlet

@@ -1,17 +0,0 @@
-<a href=@{GroupR}>Home
-&nbsp;
-<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

templates/todolist.hamlet

@@ -1,12 +0,0 @@
-<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