diff --git a/INSTALL.md b/INSTALL.md index d892fd5..81918e7 100644 --- a/INSTALL.md +++ b/INSTALL.md @@ -16,7 +16,7 @@ The `back/config.json` file contains the config (it will be created at the first # How to install locally -First install NPM (important!). Then do: +First install NPM (important!) and `libpq`. Then do: $ make back $ make back/run @@ -31,7 +31,7 @@ Create a droplet with Ubuntu. Install Stack (this command will import a GPG key, $ curl -sSL https://get.haskellstack.org/ | sh -Install NPM. +Install NPM and `libpq`. Clone and build `guide`: diff --git a/README.md b/README.md index 12454b5..bb7c277 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ The beta version is running at [guide.aelve.com](https://guide.aelve.com). The most complete section yet is [the one about lenses](https://guide.aelve.com/haskell/lenses-sth6l9jl). -Installation instructions and the explanation of config variables (in `config.json`) are here: [INSTALL.md](INSTALL.md). Don't be afraid to install it locally – it's very easy! You don't need to set up any databases or anything like that, and you can get a full copy of the data from the site by simply cloning it from Github. +Installation instructions and the explanation of config variables (in `config.json`) are here: [INSTALL.md](INSTALL.md). ## Contributing diff --git a/back/guide.cabal b/back/guide.cabal index cd22270..130496f 100644 --- a/back/guide.cabal +++ b/back/guide.cabal @@ -56,6 +56,8 @@ library Guide.Api.Error Guide.Api.Utils Guide.Api.Guider + Guide.Db + Guide.Db.Schema Guide.Logger Guide.Logger.Types Guide.Logger.Functions @@ -129,6 +131,7 @@ library , friendly-time == 0.4.* , hashable , haskell-src-meta + , hasql , http-api-data , http-client , http-client-tls diff --git a/back/src/Guide/Db.hs b/back/src/Guide/Db.hs new file mode 100644 index 0000000..b43e29a --- /dev/null +++ b/back/src/Guide/Db.hs @@ -0,0 +1,7 @@ +module Guide.Db +( + module Guide.Db.Schema +) +where + +import Guide.Db.Schema diff --git a/back/src/Guide/Db/Schema.hs b/back/src/Guide/Db/Schema.hs new file mode 100644 index 0000000..4a5620a --- /dev/null +++ b/back/src/Guide/Db/Schema.hs @@ -0,0 +1,221 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} + + +module Guide.Db.Schema +( + setupDatabase, +) +where + +import Imports + +import Hasql.Session (Session) +import NeatInterpolation +import Hasql.Connection (Connection, Settings) +import Hasql.Statement (Statement (..)) + +import qualified Hasql.Session as HS +import qualified Hasql.Connection as HC +import qualified Hasql.Encoders as HE +import qualified Hasql.Decoders as HD + + +-- | List of all migrations. +migrations :: [(Int32, Session ())] +migrations = + [ (0, v0) + ] + +-- | Prepare the database for use by Guide. +-- +-- Determines which migrations have to be run, and runs them. Errors out if +-- any migrations fail. +-- +-- Note: 'setupDatabase' uses @"guide"@ as the database name, but it does +-- not create a database if it does not exist yet. You should create the +-- database manually by doing @CREATE DATABASE guide;@ or run Postgres with +-- @POSTGRES_DB=guide@ when running when running the app for the first time. +-- +-- TODO: check schema hash as well, not just schema version? +setupDatabase :: IO () +setupDatabase = do + conn <- connect + mbSchemaVersion <- run' getSchemaVersion conn + case mbSchemaVersion of + Nothing -> formatLn "No schema found. Creating tables and running all migrations." + Just v -> formatLn "Schema version is {}." v + let schemaVersion = fromMaybe (-1) mbSchemaVersion + for_ migrations $ \(migrationVersion, migration) -> + when (migrationVersion > schemaVersion) $ do + format "Migration {}: " migrationVersion + run' (migration >> setSchemaVersion migrationVersion) conn + formatLn "done." + +-- | Create a database connection (the destination is hard-coded for now). +-- +-- Throws an 'error' if the connection could not be established. +connect :: IO Connection +connect = do + HC.acquire connectionSettings >>= \case + Left Nothing -> error "connect: unknown exception" + Left (Just x) -> error ("connect: " ++ toString x) + Right conn -> pure conn + +-- | Connection settings +connectionSettings :: Settings +connectionSettings = HC.settings "localhost" 5432 dbUser dbPass dbName + +-- | Database user +dbUser :: ByteString +dbUser = "postgres" + +-- | Database password +dbPass :: ByteString +dbPass = "3" + +-- | Database name +dbName :: ByteString +dbName = "guide" + +---------------------------------------------------------------------------- +-- Utilities +---------------------------------------------------------------------------- + +-- | Like 'HS.run', but errors out in case of failure. +run' :: Session a -> Connection -> IO a +run' s c = either (error . show) pure =<< HS.run s c + +---------------------------------------------------------------------------- +-- Schema version table +---------------------------------------------------------------------------- + +-- | Get schema version (i.e. the version of the last migration that was +-- run). +-- +-- If the @schema_version@ table doesn't exist, creates it. +getSchemaVersion :: Session (Maybe Int32) +getSchemaVersion = do + HS.sql $ toByteString [text| + CREATE TABLE IF NOT EXISTS schema_version ( + name text PRIMARY KEY, + version integer + ); + INSERT INTO schema_version (name, version) + VALUES ('main', null) + ON CONFLICT DO NOTHING; + |] + let sql = "SELECT (version) FROM schema_version WHERE name = 'main'" + encoder = HE.noParams + decoder = HD.singleRow (HD.column (HD.nullable HD.int4)) + HS.statement () (Statement sql encoder decoder False) + +-- | Set schema version. +-- +-- Assumes the @schema_version@ table exists. +setSchemaVersion :: Int32 -> Session () +setSchemaVersion version = do + let sql = "UPDATE schema_version SET version = $1 WHERE name = 'main'" + encoder = HE.param (HE.nullable HE.int4) + decoder = HD.noResult + HS.statement (Just version) (Statement sql encoder decoder True) + +---------------------------------------------------------------------------- +-- Version 0 +---------------------------------------------------------------------------- + +-- | Schema version 0: initial schema. +v0 :: Session () +v0 = do + v0_createTypeProCon + v0_createTableCategories + v0_createTableItems + v0_createTableTraits + v0_createTableUsers + v0_createTablePendingEdits + +-- | Create an enum type for trait type ("pro" or "con"). +v0_createTypeProCon :: Session () +v0_createTypeProCon = HS.sql $ toByteString [text| + CREATE TYPE trait_type AS ENUM ('pro', 'con'); + |] + +-- | Create table @traits@, corresponding to 'Guide.Types.Core.Trait'. +v0_createTableTraits :: Session () +v0_createTableTraits = HS.sql $ toByteString [text| + CREATE TABLE traits ( + uid text PRIMARY KEY, -- Unique trait ID + content text NOT NULL, -- Trait content as Markdown + deleted boolean -- Whether the trait is deleted + DEFAULT false + NOT NULL, + type_ trait_type NOT NULL, -- Trait type (pro or con) + item_uid text -- Item that the trait belongs to + REFERENCES items (uid) + ON DELETE CASCADE + ); + |] + +-- | Create table @items@, corresponding to 'Guide.Types.Core.Item'. +v0_createTableItems :: Session () +v0_createTableItems = HS.sql $ toByteString [text| + CREATE TABLE items ( + uid text PRIMARY KEY, -- Unique item ID + name text NOT NULL, -- Item title + created timestamp NOT NULL, -- When the item was created + group_ text, -- Optional group + link text, -- Optional URL + hackage text, -- Package name on Hackage + summary text NOT NULL, -- Item summary as Markdown + ecosystem text NOT NULL, -- The ecosystem section + notes text NOT NULL, -- The notes section + deleted boolean -- Whether the item is deleted + DEFAULT false + NOT NULL, + category_uid text -- Category that the item belongs to + REFERENCES categories (uid) + ON DELETE CASCADE + ); + |] + +-- | Create table @categories@, corresponding to 'Guide.Types.Core.Category'. +v0_createTableCategories :: Session () +v0_createTableCategories = HS.sql $ toByteString [text| + CREATE TABLE categories ( + uid text PRIMARY KEY, -- Unique category ID + title text NOT NULL, -- Category title + created timestamp NOT NULL, -- When the category was created + group_ text NOT NULL, -- "Grandcategory" + status_ text NOT NULL, -- Category status ("in progress", etc); the list of + -- possible statuses is defined by backend + notes text NOT NULL, -- Category notes as Markdown + enabled_sections text[] -- Item sections to show to users; the list of + NOT NULL -- possible section names is defined by backend + ); + |] + +-- | Create table @users@, storing user data. +v0_createTableUsers :: Session () +v0_createTableUsers = HS.sql $ toByteString [text| + CREATE TABLE users ( + uid text PRIMARY KEY, -- Unique user ID + name text NOT NULL, -- User name + email text NOT NULL, -- User email + password_scrypt text, -- User password (scrypt-ed) + is_admin boolean -- Whether the user is admin + DEFAULT false + NOT NULL + ); + |] + +-- | Create table @pending_edits@, storing users' edits and metadata about +-- them (who made the edit, when, etc). +v0_createTablePendingEdits :: Session () +v0_createTablePendingEdits = HS.sql $ toByteString [text| + CREATE TABLE pending_edits ( + uid bigserial PRIMARY KEY, -- Unique id + edit json NOT NULL, -- Edit in JSON format + ip inet, -- IP address of edit maker + time_ timestamp NOT NULL -- When the edit was created + ); + |] diff --git a/shell.nix b/shell.nix index 05f692d..72ed477 100644 --- a/shell.nix +++ b/shell.nix @@ -3,6 +3,6 @@ with import { }; haskell.lib.buildStackProject { name = "guide"; inherit ghc; - buildInputs = [ git ncurses zlib ]; + buildInputs = [ git ncurses zlib postgresql ]; LANG = "en_US.UTF-8"; } diff --git a/stack.yaml b/stack.yaml index 956c8a9..3d19727 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,6 +20,7 @@ extra-deps: - stm-containers-0.2.16 - lzma-clib-5.2.2 - regex-1.0.1.5 +- hasql-1.4 # Old versions from LTS 12+ (can and should be upgraded) - megaparsec-6.5.0