feat: add SQLite database support
- Add sqlite-simple dependency - Create Sis.Database module with openDatabase (creates parent dir, enables WAL + FK) - Add --db-path CLI option (default data/sis.db) - Format all Haskell sources with fourmolu - Fix hlint suggestions in Sis.Server
This commit is contained in:
@@ -0,0 +1,45 @@
|
|||||||
|
* TODO SQLite database support
|
||||||
|
|
||||||
|
Let's add database support using sqlite-simple . On startup we should
|
||||||
|
create a SQLite database if none exists. Right now we have no tables,
|
||||||
|
but we'll add one in the next task.
|
||||||
|
|
||||||
|
* TODO User signup and login
|
||||||
|
User signup should be basic sign-up. Ask the user their full name,
|
||||||
|
email and password. We'll send them a verification email to confirm
|
||||||
|
their email address and at that point ask for their password. We
|
||||||
|
should use standard encryption approaches for storing their hashed
|
||||||
|
password with the https://hackage.haskell.org/package/password
|
||||||
|
library.
|
||||||
|
|
||||||
|
We should support allowing users to log in and show them a basic
|
||||||
|
welcome page with "Welcome <full name> - <household>" and nothing else once they
|
||||||
|
sign in.
|
||||||
|
|
||||||
|
Otherwise, logged out users should be shown a sign-in form with a link to a separate sign-up form.
|
||||||
|
|
||||||
|
Logged in users should see a log out button, too.
|
||||||
|
|
||||||
|
We should create a rudimentary session infrastructure. Ensure we use http-only cookies for our session token.
|
||||||
|
|
||||||
|
** Households
|
||||||
|
When a user signs up, as part of sign-up we should ask them for the
|
||||||
|
name of their Household. All users will belong a single Household and
|
||||||
|
a Household may have more than one user.
|
||||||
|
|
||||||
|
The Household will ultimately be where tasks/chores are stored.
|
||||||
|
* TODO User invite
|
||||||
|
An existing user should be able to invite a new user by email to their household.
|
||||||
|
|
||||||
|
When the invited user signs up we should not ask them for a Household name but instead make them a member of the Household they were invited to.
|
||||||
|
* TODO Basic chores
|
||||||
|
|
||||||
|
We should create a new table to store chores in the database. Each chore belongs to a household, has a name and an optional assigned-to user.
|
||||||
|
|
||||||
|
We should allow users to create a new chore and view their existing chores.
|
||||||
|
|
||||||
|
When creating a chore we should ask users for the chore name and an optional user to assign to that chore.
|
||||||
|
|
||||||
|
* TODO Chore schedules
|
||||||
|
|
||||||
|
TBD
|
||||||
@@ -17,6 +17,7 @@ build-type: Simple
|
|||||||
library
|
library
|
||||||
exposed-modules:
|
exposed-modules:
|
||||||
Sis
|
Sis
|
||||||
|
Sis.Database
|
||||||
Sis.Server
|
Sis.Server
|
||||||
Sis.Types
|
Sis.Types
|
||||||
other-modules:
|
other-modules:
|
||||||
|
|||||||
+8
-4
@@ -8,13 +8,17 @@ module Sis.Database (
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Database.SQLite.Simple qualified as SQL
|
import Database.SQLite.Simple qualified as SQL
|
||||||
|
import System.Directory (createDirectoryIfMissing)
|
||||||
|
import System.FilePath (takeDirectory)
|
||||||
|
|
||||||
-- | Open (or create) a SQLite database at the given path.
|
{- | Open (or create) a SQLite database at the given path.
|
||||||
--
|
|
||||||
-- Enables WAL journal mode for concurrent read performance and
|
Enables WAL journal mode for concurrent read performance and
|
||||||
-- enables foreign key enforcement.
|
enables foreign key enforcement.
|
||||||
|
-}
|
||||||
openDatabase :: FilePath -> IO SQL.Connection
|
openDatabase :: FilePath -> IO SQL.Connection
|
||||||
openDatabase path = do
|
openDatabase path = do
|
||||||
|
createDirectoryIfMissing True (takeDirectory path)
|
||||||
conn <- SQL.open path
|
conn <- SQL.open path
|
||||||
SQL.execute_ conn "PRAGMA journal_mode=WAL"
|
SQL.execute_ conn "PRAGMA journal_mode=WAL"
|
||||||
SQL.execute_ conn "PRAGMA foreign_keys=ON"
|
SQL.execute_ conn "PRAGMA foreign_keys=ON"
|
||||||
|
|||||||
+10
-8
@@ -9,10 +9,10 @@ Defines the API routes and wires them into a WAI 'Wai.Application'.
|
|||||||
Serves the Mithril SPA frontend from a static directory for all
|
Serves the Mithril SPA frontend from a static directory for all
|
||||||
non-API routes, with SPA-routing fallback to @index.html@.
|
non-API routes, with SPA-routing fallback to @index.html@.
|
||||||
-}
|
-}
|
||||||
module Sis.Server
|
module Sis.Server (
|
||||||
( app
|
app,
|
||||||
, sisRouter
|
sisRouter,
|
||||||
, HealthCheck (..)
|
HealthCheck (..),
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Beeline.Routing ((/-), (/:))
|
import Beeline.Routing ((/-), (/:))
|
||||||
@@ -22,14 +22,15 @@ import Control.Monad.IO.Class qualified as MIO
|
|||||||
import Control.Monad.Reader qualified as Reader
|
import Control.Monad.Reader qualified as Reader
|
||||||
import Data.ByteString qualified as BS
|
import Data.ByteString qualified as BS
|
||||||
import Data.Map.Strict qualified as Map
|
import Data.Map.Strict qualified as Map
|
||||||
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Text qualified as T
|
import Data.Text qualified as T
|
||||||
import Data.Text.Encoding qualified as TE
|
import Data.Text.Encoding qualified as TE
|
||||||
import Data.Void (Void, absurd)
|
import Data.Void (Void, absurd)
|
||||||
import Network.HTTP.Types qualified as HTTP
|
import Network.HTTP.Types qualified as HTTP
|
||||||
import Network.Wai qualified as Wai
|
import Network.Wai qualified as Wai
|
||||||
import Shrubbery qualified as S
|
import Shrubbery qualified as S
|
||||||
import System.FilePath ((</>))
|
|
||||||
import System.Directory (doesFileExist)
|
import System.Directory (doesFileExist)
|
||||||
|
import System.FilePath ((</>))
|
||||||
|
|
||||||
import Orb qualified
|
import Orb qualified
|
||||||
|
|
||||||
@@ -103,14 +104,15 @@ serveStaticOrSpa staticDir request respond = do
|
|||||||
let relPath = case path of
|
let relPath = case path of
|
||||||
'/' : rest -> rest
|
'/' : rest -> rest
|
||||||
other -> other
|
other -> other
|
||||||
let candidate = if null relPath || not (hasExtension relPath)
|
let candidate =
|
||||||
|
if null relPath || not (hasExtension relPath)
|
||||||
then "index.html"
|
then "index.html"
|
||||||
else relPath
|
else relPath
|
||||||
let filePath = staticDir </> candidate
|
let filePath = staticDir </> candidate
|
||||||
exists <- doesFileExist filePath
|
exists <- doesFileExist filePath
|
||||||
if exists
|
if exists
|
||||||
then do
|
then do
|
||||||
let mime = maybe "application/octet-stream" id (mimeType candidate)
|
let mime = fromMaybe "application/octet-stream" (mimeType candidate)
|
||||||
respond $ Wai.responseFile HTTP.status200 [("Content-Type", mime)] filePath Nothing
|
respond $ Wai.responseFile HTTP.status200 [("Content-Type", mime)] filePath Nothing
|
||||||
else
|
else
|
||||||
respond notFoundResponse
|
respond notFoundResponse
|
||||||
@@ -185,7 +187,7 @@ healthCheckHandler =
|
|||||||
. Orb.addResponseSchema500 Orb.internalServerErrorSchema
|
. Orb.addResponseSchema500 Orb.internalServerErrorSchema
|
||||||
$ Orb.noResponseBodies
|
$ Orb.noResponseBodies
|
||||||
, Orb.mkPermissionAction =
|
, Orb.mkPermissionAction =
|
||||||
\_request -> NoPermissions
|
const NoPermissions
|
||||||
, Orb.handleRequest =
|
, Orb.handleRequest =
|
||||||
\_request () -> Orb.return200 (Orb.SuccessMessage "ok")
|
\_request () -> Orb.return200 (Orb.SuccessMessage "ok")
|
||||||
}
|
}
|
||||||
|
|||||||
Reference in New Issue
Block a user