Use SERIAL for users id field; general cleanup

This commit is contained in:
James Eversole 2024-10-14 13:05:17 -05:00
parent a7836ad08f
commit 0808fe130a
3 changed files with 38 additions and 41 deletions

View File

@ -19,7 +19,8 @@ import Servant hiding ((:>), throwError)
-- --
-- Core data types -- Core data types
-- --
type AppEff = Eff '[ Logger type AppEff =
Eff '[ Logger
, Database , Database
, Reader AppEnv , Reader AppEnv
, Error ServerError , Error ServerError

View File

@ -70,8 +70,8 @@ runDatabaseIO = interpret $ \_ -> \case
init = do init = do
AppEnv { pool } <- ask AppEnv { pool } <- ask
liftWithPool pool $ \conn -> do liftWithPool pool $ \conn -> do
execute_ conn tableUsers execute_ conn createUsersTable
execute_ conn tableLogs execute_ conn createLogsTable
pure () pure ()
read :: (ToField a, FromRow b, DatabaseExeEffects es) read :: (ToField a, FromRow b, DatabaseExeEffects es)
@ -112,14 +112,14 @@ writeUser name = ("INSERT INTO users (name) VALUES (?);", Only name)
deleteUser :: UserId -> (Query, UserId) deleteUser :: UserId -> (Query, UserId)
deleteUser userId = ("DELETE FROM users WHERE id = ?;", userId) deleteUser userId = ("DELETE FROM users WHERE id = ?;", userId)
tableUsers :: Query createUsersTable :: Query
tableUsers = "CREATE TABLE IF NOT EXISTS users ( \ createUsersTable = "CREATE TABLE IF NOT EXISTS users ( \
\id integer NOT NULL, \ \ id SERIAL PRIMARY KEY, \
\ name character varying(255) NOT NULL \ \ name character varying(255) NOT NULL \
\);" \);"
tableLogs :: Query createLogsTable :: Query
tableLogs = "CREATE TABLE IF NOT EXISTS logs ( \ createLogsTable = "CREATE TABLE IF NOT EXISTS logs ( \
\ id SERIAL PRIMARY KEY, \ \ id SERIAL PRIMARY KEY, \
\ level VARCHAR(10) NOT NULL, \ \ level VARCHAR(10) NOT NULL, \
\ message TEXT NOT NULL, \ \ message TEXT NOT NULL, \

View File

@ -22,25 +22,21 @@ main :: IO ()
main = do main = do
pool <- createConnectionPool pool <- createConnectionPool
let env = AppEnv { pool = pool } let env = AppEnv { pool = pool }
runEffStack env $ databaseInit runAppEff env $ databaseInit
run port . serve proxy $ app env run port . serve proxy $ app env
app :: AppEnv -> Server AppAPI app :: AppEnv -> Server AppAPI
app env = transformEff env app env = hoistServer proxy (Handler . ExceptT . runAppEff env) handlers
$ rootHandler
handlers :: ServerT AppAPI AppEff
handlers = rootHandler
:<|> userListHandler :<|> userListHandler
:<|> userGetHandler :<|> userGetHandler
:<|> userPostHandler :<|> userPostHandler
:<|> userDeleteHandler :<|> userDeleteHandler
transformEff :: AppEnv -> ServerT AppAPI AppEff -> ServerT AppAPI Handler runAppEff :: AppEnv -> AppEff a -> IO (Either ServerError a)
transformEff env = hoistServer proxy runAppEff env = runEff
$ Handler
. ExceptT
. runEffStack env
runEffStack :: AppEnv -> AppEff a -> IO (Either ServerError a)
runEffStack env = runEff
. runErrorNoCallStack . runErrorNoCallStack
. runReader env . runReader env
. runDatabaseIO . runDatabaseIO