version 1 done

2025-06-07 16:04:51 +01:00 · 2025-06-07 16:04:51 +01:00 · 59e14ce390
commit 59e14ce390
47 changed files with 9188 additions and 0 deletions
--- a/src/Application.hs
+++ b/src/Application.hs
@ -0,0 +1,189 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Application
+    ( getApplicationDev
+    , appMain
+    , develMain
+    , makeFoundation
+    , makeLogWare
+    -- * for DevelMain
+    , getApplicationRepl
+    , shutdownApp
+    -- * for GHCI
+    , handler
+    , db
+    ) where
+
+import Control.Monad.Logger                 (liftLoc, runLoggingT)
+import Database.Persist.Sqlite              (createSqlitePool, runSqlPool,
+                                             sqlDatabase, sqlPoolSize, rawExecute)
+import Import
+import Language.Haskell.TH.Syntax           (qLocation)
+import Network.HTTP.Client.TLS              (getGlobalManager)
+import Network.Wai (Middleware)
+import Network.Wai.Handler.Warp             (Settings, defaultSettings,
+                                             defaultShouldDisplayException,
+                                             runSettings, setHost,
+                                             setOnException, setPort, getPort)
+import Network.Wai.Middleware.RequestLogger (Destination (Logger),
+                                             IPAddrSource (..),
+                                             OutputFormat (..), destination,
+                                             mkRequestLogger, outputFormat)
+import System.Log.FastLogger                (defaultBufSize, newStdoutLoggerSet,
+                                             toLogStr)
+
+-- Import all relevant handler modules here.
+-- Don't forget to add new modules to your cabal file!
+import Handler.Common
+import Handler.Home
+import Handler.TodoEntry
+
+-- 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
+-- comments there for more details.
+mkYesodDispatch "App" resourcesApp
+
+-- | This function allocates resources (such as a database connection pool),
+-- performs initialization and returns a foundation datatype value. This is also
+-- the place to put your migrate statements to have automatic database
+-- migrations handled by Yesod.
+makeFoundation :: AppSettings -> IO App
+makeFoundation appSettings = do
+    -- Some basic initializations: HTTP connection manager, logger, and static
+    -- subsite.
+    appHttpManager <- getGlobalManager
+    appLogger <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
+    appStatic <-
+        (if appMutableStatic appSettings then staticDevel else static)
+        (appStaticDir appSettings)
+
+    -- We need a log function to create a connection pool. We need a connection
+    -- pool to create our foundation. And we need our foundation to get a
+    -- logging function. To get out of this loop, we initially create a
+    -- temporary foundation without a real connection pool, get a log function
+    -- from there, and then create the real foundation.
+    let mkFoundation appConnPool = App {..}
+        -- The App {..} syntax is an example of record wild cards. For more
+        -- information, see:
+        -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
+        tempFoundation = mkFoundation $ error "connPool forced in tempFoundation"
+        logFunc = messageLoggerSource tempFoundation appLogger
+
+    -- Create the database connection pool
+    pool <- flip runLoggingT logFunc $ createSqlitePool
+        (sqlDatabase $ appDatabaseConf appSettings)
+        (sqlPoolSize $ appDatabaseConf appSettings)
+    -- Perform database migration using our application's logging settings.
+    runLoggingT (runSqlPool (runMigration migrateAll) pool) logFunc
+    _ <- runSqlPool (rawExecute "PRAGMA foreign_keys = ON;" []) pool
+
+    -- Return the foundation
+    return $ mkFoundation pool
+
+-- | Convert our foundation to a WAI Application by calling @toWaiAppPlain@ and
+-- applying some additional middlewares.
+makeApplication :: App -> IO Application
+makeApplication foundation = do
+    logWare <- makeLogWare foundation
+    -- Create the WAI application and apply middlewares
+    appPlain <- toWaiAppPlain foundation
+    return $ logWare $ defaultMiddlewaresNoLogging appPlain
+
+makeLogWare :: App -> IO Middleware
+makeLogWare foundation =
+    mkRequestLogger def
+        { outputFormat =
+            if appDetailedRequestLogging $ appSettings foundation
+                then Detailed True
+                else Apache
+                        (if appIpFromHeader $ appSettings foundation
+                            then FromFallback
+                            else FromSocket)
+        , destination = Logger $ loggerSet $ appLogger foundation
+        }
+
+
+-- | Warp settings for the given foundation value.
+warpSettings :: App -> Settings
+warpSettings foundation =
+      setPort (appPort $ appSettings foundation)
+    $ setHost (appHost $ appSettings foundation)
+    $ setOnException (\_req e ->
+        when (defaultShouldDisplayException e) $ messageLoggerSource
+            foundation
+            (appLogger foundation)
+            $(qLocation >>= liftLoc)
+            "yesod"
+            LevelError
+            (toLogStr $ "Exception from Warp: " ++ show e))
+      defaultSettings
+
+-- | For yesod devel, return the Warp settings and WAI Application.
+getApplicationDev :: IO (Settings, Application)
+getApplicationDev = do
+    settings <- getAppSettings
+    foundation <- makeFoundation settings
+    wsettings <- getDevSettings $ warpSettings foundation
+    app <- makeApplication foundation
+    return (wsettings, app)
+
+getAppSettings :: IO AppSettings
+getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
+
+-- | main function for use by yesod devel
+develMain :: IO ()
+develMain = develMainHelper getApplicationDev
+
+-- | The @main@ function for an executable running this site.
+appMain :: IO ()
+appMain = do
+    -- Get the settings from all relevant sources
+    settings <- loadYamlSettingsArgs
+        -- fall back to compile-time values, set to [] to require values at runtime
+        [configSettingsYmlValue]
+
+        -- allow environment variables to override
+        useEnv
+
+    -- Generate the foundation from the settings
+    foundation <- makeFoundation settings
+    
+    -- Generate a WAI Application from the foundation
+    app <- makeApplication foundation
+
+    -- Run the application with Warp
+    runSettings (warpSettings foundation) app
+
+
+--------------------------------------------------------------
+-- Functions for DevelMain.hs (a way to run the app from GHCi)
+--------------------------------------------------------------
+getApplicationRepl :: IO (Int, App, Application)
+getApplicationRepl = do
+    settings <- getAppSettings
+    foundation <- makeFoundation settings
+    wsettings <- getDevSettings $ warpSettings foundation
+    app1 <- makeApplication foundation
+    return (getPort wsettings, foundation, app1)
+
+shutdownApp :: App -> IO ()
+shutdownApp _ = return ()
+
+
+---------------------------------------------
+-- Functions for use in development with GHCi
+---------------------------------------------
+
+-- | Run a handler
+handler :: Handler a -> IO a
+handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
+
+-- | Run DB queries
+db :: ReaderT SqlBackend Handler a -> IO a
+db = handler . runDB
--- a/src/Foundation.hs
+++ b/src/Foundation.hs
@ -0,0 +1,193 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE InstanceSigs #-}
+
+module Foundation where
+
+import Import.NoFoundation
+import Data.Kind            (Type)
+import Database.Persist.Sql (ConnectionPool, runSqlPool)
+import Text.Hamlet          (hamletFile)
+import Text.Jasmine         (minifym)
+import Control.Monad.Logger (LogSource)
+
+import Yesod.Default.Util   (addStaticContentExternal)
+import Yesod.Core.Types     (Logger)
+import qualified Yesod.Core.Unsafe as Unsafe
+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
+-- keep settings and values requiring initialization before your application
+-- starts running, such as database connections. Every handler will have
+-- access to the data present here.
+data App = App
+    { appSettings    :: AppSettings
+    , appStatic      :: Static -- ^ Settings for static file serving.
+    , appConnPool    :: ConnectionPool -- ^ Database connection pool.
+    , appHttpManager :: Manager
+    , appLogger      :: Logger
+    }
+
+data MenuItem = MenuItem
+    { menuItemLabel :: Text
+    , menuItemRoute :: Route App
+    , menuItemAccessCallback :: Bool
+    }
+
+data MenuTypes
+    = NavbarLeft MenuItem
+    | NavbarRight MenuItem
+
+-- This is where we define all of the routes in our application. For a full
+-- explanation of the syntax, please see:
+-- http://www.yesodweb.com/book/routing-and-handlers
+--
+-- Note that this is really half the story; in Application.hs, mkYesodDispatch
+-- generates the rest of the code. Please see the following documentation
+-- for an explanation for this split:
+-- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules
+--
+-- This function also generates the following type synonyms:
+-- type Handler = HandlerFor App
+-- type Widget = WidgetFor App ()
+mkYesodData "App" $(parseRoutesFile "config/routes.yesodroutes")
+
+-- | A convenient synonym for creating forms.
+type Form x = Html -> MForm (HandlerFor App) (FormResult x, Widget)
+
+-- | A convenient synonym for database access functions.
+type DB a = forall (m :: Type -> Type).
+    (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,
+    -- see: https://github.com/yesodweb/yesod/wiki/Overriding-approot
+    approot :: Approot App
+    approot = ApprootRequest $ \app req ->
+        case appRoot $ appSettings app of
+            Nothing -> getApprootText guessApproot app req
+            Just root -> root
+
+    -- Store session data on the client in encrypted cookies,
+    -- default session idle timeout is 120 minutes
+    makeSessionBackend :: App -> IO (Maybe SessionBackend)
+    makeSessionBackend _ = Just <$> defaultClientSessionBackend
+        120    -- timeout in minutes
+        "config/client_session_key.aes"
+
+    -- 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.
+    -- Some users may also want to add the defaultCsrfMiddleware, which:
+    --   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.
+    -- 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.
+    yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
+    yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
+
+    defaultLayout :: Widget -> Handler Html
+    defaultLayout widget = do
+        master <- getYesod
+        mmsg <- getMessage
+
+        mcurrentRoute <- getCurrentRoute
+
+        -- We break up the default layout into two components:
+        -- default-layout is the contents of the body tag, and
+        -- default-layout-wrapper is the entire page. Since the final
+        -- value passed to hamletToRepHtml cannot be a widget, this allows
+        -- you to use normal widget features in default-layout.
+
+        pc <- widgetToPageContent $ do
+            $(widgetFile "default-layout")
+        withUrlRenderer $(hamletFile "templates/default-layout-wrapper.hamlet")
+
+    isAuthorized
+        :: Route App  -- ^ The route the user is visiting.
+        -> Bool       -- ^ Whether or not this is a "write" request.
+        -> Handler AuthResult
+    -- Routes not requiring authentication.
+    -- 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
+    -- 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
+    runDB :: SqlPersistT Handler a -> Handler a
+    runDB action = do
+        master <- getYesod
+        runSqlPool action $ appConnPool master
+
+instance YesodPersistRunner App where
+    getDBRunner :: Handler (DBRunner App, Handler ())
+    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 _ _ = 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 = appHttpManager
+
+unsafeHandler :: App -> Handler a -> IO a
+unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
+
+-- Note: Some functionality previously present in the scaffolding has been
+-- moved to documentation in the Wiki. Following are some hopefully helpful
+-- links:
+--
+-- 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
--- a/src/Handler/Common.hs
+++ b/src/Handler/Common.hs
@ -0,0 +1,22 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+-- | Common handler functions.
+module Handler.Common where
+
+import Data.FileEmbed (embedFile)
+import Import
+
+-- These handlers embed files in the executable at compile time to avoid a
+-- runtime dependency, and for efficiency.
+
+getFaviconR :: Handler TypedContent
+getFaviconR = do cacheSeconds $ 60 * 60 * 24 * 30 -- cache for a month
+                 return $ TypedContent "image/x-icon"
+                        $ toContent $(embedFile "config/favicon.ico")
+
+getRobotsR :: Handler TypedContent
+getRobotsR = return $ TypedContent typePlain
+                    $ toContent $(embedFile "config/robots.txt")
--- a/src/Handler/Home.hs
+++ b/src/Handler/Home.hs
@ -0,0 +1,41 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+module Handler.Home where
+
+import Import
+import Yesod.Form.Bootstrap3 (BootstrapFormLayout (..), renderBootstrap3)
+import Text.Julius (RawJS (..))
+
+-- Define our data that will be used for creating the form.
+data FileForm = FileForm
+    { fileInfo :: FileInfo
+    , fileDescription :: Text
+    }
+
+-- This is a handler function for the GET request method on the HomeR
+-- resource pattern. All of your resource patterns are defined in
+-- config/routes.yesodroutes
+--
+-- The majority of the code you will write in Yesod lives in these handler
+-- functions. You can spread them across multiple files if you are so
+-- inclined, or create a single monolithic file.
+
+
+sampleForm :: Form FileForm
+sampleForm = renderBootstrap3 BootstrapBasicForm $ FileForm
+    <$> fileAFormReq "Choose a file"
+    <*> areq textField textSettings Nothing
+    -- Add attributes like the placeholder and CSS classes.
+    where textSettings = FieldSettings
+            { fsLabel = "What's on the file?"
+            , fsTooltip = Nothing
+            , fsId = Nothing
+            , fsName = Nothing
+            , fsAttrs =
+                [ ("class", "form-control")
+                , ("placeholder", "File description")
+                ]
+            }
--- a/src/Handler/TodoEntry.hs
+++ b/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
--- a/src/Import.hs
+++ b/src/Import.hs
@ -0,0 +1,6 @@
+module Import
+    ( module Import
+    ) where
+
+import Foundation            as Import
+import Import.NoFoundation   as Import
--- a/src/Import/NoFoundation.hs
+++ b/src/Import/NoFoundation.hs
@ -0,0 +1,11 @@
+{-# LANGUAGE CPP #-}
+module Import.NoFoundation
+    ( module Import
+    ) where
+
+import ClassyPrelude.Yesod   as Import
+import Model                 as Import
+import Settings              as Import
+import Settings.StaticFiles  as Import
+import Yesod.Core.Types      as Import (loggerSet)
+import Yesod.Default.Config2 as Import
--- a/src/Model.hs
+++ b/src/Model.hs
@ -0,0 +1,25 @@
+{-# LANGUAGE EmptyDataDecls             #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GADTs                      #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE NoImplicitPrelude          #-}
+{-# LANGUAGE OverloadedStrings          #-}
+{-# LANGUAGE TemplateHaskell            #-}
+{-# LANGUAGE TypeFamilies               #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE StandaloneDeriving         #-}
+{-# LANGUAGE UndecidableInstances       #-}
+{-# LANGUAGE DataKinds                  #-}
+module Model where
+
+import ClassyPrelude.Yesod
+import Database.Persist.Quasi
+import Text.Read
+
+-- You can define all of your database entities in the entities file.
+-- You can find more information on persistent and how to declare entities
+-- at:
+-- http://www.yesodweb.com/book/persistent/
+share [mkPersist sqlSettings, mkMigrate "migrateAll"]
+    $(persistFileWith lowerCaseSettings "config/models.persistentmodels")
--- a/src/Settings.hs
+++ b/src/Settings.hs
@ -0,0 +1,148 @@
+{-# LANGUAGE CPP               #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
+-- | Settings are centralized, as much as possible, into this file. This
+-- includes database connection settings, static file locations, etc.
+-- In addition, you can configure a number of different aspects of Yesod
+-- by overriding methods in the Yesod typeclass. That instance is
+-- declared in the Foundation.hs file.
+module Settings where
+
+import ClassyPrelude.Yesod
+import qualified Control.Exception as Exception
+import Data.Aeson                  (Result (..), fromJSON, withObject, (.!=),
+                                    (.:?))
+import Data.FileEmbed              (embedFile)
+import Data.Yaml                   (decodeEither')
+import Database.Persist.Sqlite     (SqliteConf)
+import Language.Haskell.TH.Syntax  (Exp, Name, Q)
+import Network.Wai.Handler.Warp    (HostPreference)
+import Yesod.Default.Config2       (applyEnvValue, configSettingsYml)
+import Yesod.Default.Util          (WidgetFileSettings, widgetFileNoReload,
+                                    widgetFileReload)
+
+-- | Runtime settings to configure this application. These settings can be
+-- loaded from various sources: defaults, environment variables, config files,
+-- theoretically even a database.
+data AppSettings = AppSettings
+    { appStaticDir              :: String
+    -- ^ Directory from which to serve static files.
+    , appDatabaseConf           :: SqliteConf
+    -- ^ Configuration settings for accessing the database.
+    , appRoot                   :: Maybe Text
+    -- ^ Base for all generated URLs. If @Nothing@, determined
+    -- from the request headers.
+    , appHost                   :: HostPreference
+    -- ^ Host/interface the server should bind to.
+    , appPort                   :: Int
+    -- ^ Port to listen on
+    , appIpFromHeader           :: Bool
+    -- ^ Get the IP address from the header when logging. Useful when sitting
+    -- behind a reverse proxy.
+
+    , appDetailedRequestLogging :: Bool
+    -- ^ Use detailed request logging system
+    , appShouldLogAll           :: Bool
+    -- ^ Should all log messages be displayed?
+    , appReloadTemplates        :: Bool
+    -- ^ Use the reload version of templates
+    , appMutableStatic          :: Bool
+    -- ^ Assume that files in the static dir may change after compilation
+    , appSkipCombining          :: Bool
+    -- ^ Perform no stylesheet/script combining
+
+    -- Example app-specific configuration values.
+    , appCopyright              :: Text
+    -- ^ Copyright text to appear in the footer of the page
+    , appAnalytics              :: Maybe Text
+    -- ^ Google Analytics code
+
+    , appAuthDummyLogin         :: Bool
+    -- ^ Indicate if auth dummy login should be enabled.
+    }
+
+instance FromJSON AppSettings where
+    parseJSON = withObject "AppSettings" $ \o -> do
+        let defaultDev =
+#ifdef DEVELOPMENT
+                True
+#else
+                False
+#endif
+        appStaticDir              <- o .: "static-dir"
+        appDatabaseConf           <- o .: "database"
+        appRoot                   <- o .:? "approot"
+        appHost                   <- fromString <$> o .: "host"
+        appPort                   <- o .: "port"
+        appIpFromHeader           <- o .: "ip-from-header"
+
+        dev                       <- o .:? "development"      .!= defaultDev
+
+        appDetailedRequestLogging <- o .:? "detailed-logging" .!= dev
+        appShouldLogAll           <- o .:? "should-log-all"   .!= dev
+        appReloadTemplates        <- o .:? "reload-templates" .!= dev
+        appMutableStatic          <- o .:? "mutable-static"   .!= dev
+        appSkipCombining          <- o .:? "skip-combining"   .!= dev
+
+        appCopyright              <- o .:  "copyright"
+        appAnalytics              <- o .:? "analytics"
+
+        appAuthDummyLogin         <- o .:? "auth-dummy-login"      .!= dev
+
+        return AppSettings {..}
+
+-- | Settings for 'widgetFile', such as which template languages to support and
+-- default Hamlet settings.
+--
+-- For more information on modifying behavior, see:
+--
+-- https://github.com/yesodweb/yesod/wiki/Overriding-widgetFile
+widgetFileSettings :: WidgetFileSettings
+widgetFileSettings = def
+
+-- | How static files should be combined.
+combineSettings :: CombineSettings
+combineSettings = def
+
+-- The rest of this file contains settings which rarely need changing by a
+-- user.
+
+widgetFile :: String -> Q Exp
+widgetFile = (if appReloadTemplates compileTimeAppSettings
+                then widgetFileReload
+                else widgetFileNoReload)
+              widgetFileSettings
+
+-- | Raw bytes at compile time of @config/settings.yml@
+configSettingsYmlBS :: ByteString
+configSettingsYmlBS = $(embedFile configSettingsYml)
+
+-- | @config/settings.yml@, parsed to a @Value@.
+configSettingsYmlValue :: Value
+configSettingsYmlValue = either Exception.throw id
+                       $ decodeEither' configSettingsYmlBS
+
+-- | A version of @AppSettings@ parsed at compile time from @config/settings.yml@.
+compileTimeAppSettings :: AppSettings
+compileTimeAppSettings =
+    case fromJSON $ applyEnvValue False mempty configSettingsYmlValue of
+        Error e -> error e
+        Success settings -> settings
+
+-- The following two functions can be used to combine multiple CSS or JS files
+-- at compile time to decrease the number of http requests.
+-- Sample usage (inside a Widget):
+--
+-- > $(combineStylesheets 'StaticR [style1_css, style2_css])
+
+combineStylesheets :: Name -> [Route Static] -> Q Exp
+combineStylesheets = combineStylesheets'
+    (appSkipCombining compileTimeAppSettings)
+    combineSettings
+
+combineScripts :: Name -> [Route Static] -> Q Exp
+combineScripts = combineScripts'
+    (appSkipCombining compileTimeAppSettings)
+    combineSettings
--- a/src/Settings/StaticFiles.hs
+++ b/src/Settings/StaticFiles.hs
@ -0,0 +1,39 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell   #-}
+module Settings.StaticFiles where
+
+import Settings     (appStaticDir, compileTimeAppSettings)
+import Yesod.Static (staticFiles)
+
+-- This generates easy references to files in the static directory at compile time,
+-- giving you compile-time verification that referenced files exist.
+-- Warning: any files added to your static directory during run-time can't be
+-- accessed this way. You'll have to use their FilePath or URL to access them.
+--
+-- For example, to refer to @static/js/script.js@ via an identifier, you'd use:
+--
+--     js_script_js
+--
+-- If the identifier is not available, you may use:
+--
+--     StaticFile ["js", "script.js"] []
+staticFiles (appStaticDir compileTimeAppSettings)
+
+-- If you prefer to updating the references by force
+--  -- especially when you are devloping like `stack exec -- yesod devel` --
+-- you can update references by chaning file stamp.
+--
+-- On linux or Unix-like system, you can use
+--     shell> touch /Path/To/Settings/StaticFiles.hs
+--
+-- or save without changes on your favorite editor.
+-- so yesod devel will re-compile automatically and generate the refereces
+-- including new one.
+--
+-- In this way you can use on your shakespearean template(s)
+-- Let's say you have image on "yourStaticDir/img/background-1.jpg"
+-- you can use the reference of the file on shakespearean templates like bellow
+--
+--     /* note: `-' becomes '_' as well */
+--     @{StaticR img_background_1_jpg}