{-# LANGUAGE OverloadedLabels #-}

module Mensam.Server.Database.Migration where

import Mensam.Server.Application.SeldaPool.Class
import Mensam.Server.Database.Extra qualified as Selda
import Mensam.Server.Database.Schema

import Control.Monad.IO.Class
import Control.Monad.Logger.CallStack
import Control.Monad.Trans.Class
import Data.Foldable
import Data.Kind
import Data.Map.Strict qualified as M
import Data.Text qualified as T
import Data.Time qualified as T
import Database.Selda qualified as Selda
import Database.Selda.Unsafe qualified as Selda.Unsafe

migrateDatabase ::
  forall m.
  ( MonadIO m
  , MonadLogger m
  , MonadSeldaPool m
  ) =>
  SeldaTransactionT m ()
migrateDatabase :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrateDatabase = do
  [(ID DbMigration, Text)]
appliedMigrationKeys <- do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Looking up migrations that have already been applied."
    [DbMigration]
dbMigrations <- Query (Backend (SeldaTransactionT m)) (Row SQLite DbMigration)
-> SeldaTransactionT m [Res (Row SQLite DbMigration)]
forall (m :: * -> *) a.
(MonadSelda m, Result a) =>
Query (Backend m) a -> m [Res a]
Selda.query (Query (Backend (SeldaTransactionT m)) (Row SQLite DbMigration)
 -> SeldaTransactionT m [Res (Row SQLite DbMigration)])
-> Query (Backend (SeldaTransactionT m)) (Row SQLite DbMigration)
-> SeldaTransactionT m [Res (Row SQLite DbMigration)]
forall a b. (a -> b) -> a -> b
$ do
      Row SQLite DbMigration
dbMigration <- Table DbMigration -> Query SQLite (Row SQLite DbMigration)
forall a s. Relational a => Table a -> Query s (Row s a)
Selda.select Table DbMigration
tableMigration
      Col SQLite UTCTime -> Order -> Query SQLite ()
forall s t a.
(Same s t, SqlType a) =>
Col s a -> Order -> Query t ()
Selda.order (Row SQLite DbMigration
dbMigration Row SQLite DbMigration
-> Selector DbMigration UTCTime -> Col SQLite UTCTime
forall a s t. SqlType a => Row s t -> Selector t a -> Col s a
Selda.! Selector DbMigration UTCTime
#dbMigration_time_applied) Order
Selda.Asc
      Row SQLite DbMigration -> Query SQLite (Row SQLite DbMigration)
forall a. a -> Query SQLite a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Row SQLite DbMigration
dbMigration
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"These migrations have already been applied: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([DbMigration] -> String
forall a. Show a => a -> String
show [DbMigration]
dbMigrations)
    let toKey :: DbMigration -> (ID DbMigration, Text)
toKey DbMigration
dbMigration = (DbMigration -> ID DbMigration
dbMigration_id DbMigration
dbMigration, DbMigration -> Text
dbMigration_name DbMigration
dbMigration)
    [(ID DbMigration, Text)]
-> SeldaTransactionT m [(ID DbMigration, Text)]
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(ID DbMigration, Text)]
 -> SeldaTransactionT m [(ID DbMigration, Text)])
-> [(ID DbMigration, Text)]
-> SeldaTransactionT m [(ID DbMigration, Text)]
forall a b. (a -> b) -> a -> b
$ (DbMigration -> (ID DbMigration, Text))
-> [DbMigration] -> [(ID DbMigration, Text)]
forall a b. (a -> b) -> [a] -> [b]
map DbMigration -> (ID DbMigration, Text)
toKey [DbMigration]
dbMigrations
  let
    migrationMap ::
      forall n.
      ( MonadIO n
      , MonadLogger n
      , MonadSeldaPool n
      ) =>
      M.Map (Selda.ID DbMigration, T.Text) (SeldaTransactionT n ())
    migrationMap :: forall (n :: * -> *).
(MonadIO n, MonadLogger n, MonadSeldaPool n) =>
Map (ID DbMigration, Text) (SeldaTransactionT n ())
migrationMap =
      (SeldaTransactionT n ()
 -> SeldaTransactionT n () -> SeldaTransactionT n ())
-> [((ID DbMigration, Text), SeldaTransactionT n ())]
-> Map (ID DbMigration, Text) (SeldaTransactionT n ())
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
M.fromListWith (String
-> SeldaTransactionT n ()
-> SeldaTransactionT n ()
-> SeldaTransactionT n ()
forall a. HasCallStack => String -> a
error String
"Multiple migrations have the same identifier and name.") ([((ID DbMigration, Text), SeldaTransactionT n ())]
 -> Map (ID DbMigration, Text) (SeldaTransactionT n ()))
-> [((ID DbMigration, Text), SeldaTransactionT n ())]
-> Map (ID DbMigration, Text) (SeldaTransactionT n ())
forall a b. (a -> b) -> a -> b
$
        (Migration -> ((ID DbMigration, Text), SeldaTransactionT n ()))
-> [Migration]
-> [((ID DbMigration, Text), SeldaTransactionT n ())]
forall a b. (a -> b) -> [a] -> [b]
map (\Migration
migration -> ((Migration -> ID DbMigration
migrationId Migration
migration, Migration -> Text
migrationName Migration
migration), Migration
-> forall (m :: * -> *).
   (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
   SeldaTransactionT m ()
migrationWork Migration
migration)) [Migration]
migrations
    migrationsToApply :: [((ID DbMigration, Text), SeldaTransactionT m ())]
migrationsToApply =
      Map (ID DbMigration, Text) (SeldaTransactionT m ())
-> [((ID DbMigration, Text), SeldaTransactionT m ())]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map (ID DbMigration, Text) (SeldaTransactionT m ())
 -> [((ID DbMigration, Text), SeldaTransactionT m ())])
-> Map (ID DbMigration, Text) (SeldaTransactionT m ())
-> [((ID DbMigration, Text), SeldaTransactionT m ())]
forall a b. (a -> b) -> a -> b
$
        ((ID DbMigration, Text)
 -> Map (ID DbMigration, Text) (SeldaTransactionT m ())
 -> Map (ID DbMigration, Text) (SeldaTransactionT m ()))
-> Map (ID DbMigration, Text) (SeldaTransactionT m ())
-> [(ID DbMigration, Text)]
-> Map (ID DbMigration, Text) (SeldaTransactionT m ())
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ID DbMigration, Text)
-> Map (ID DbMigration, Text) (SeldaTransactionT m ())
-> Map (ID DbMigration, Text) (SeldaTransactionT m ())
forall k a. Ord k => k -> Map k a -> Map k a
M.delete Map (ID DbMigration, Text) (SeldaTransactionT m ())
forall (n :: * -> *).
(MonadIO n, MonadLogger n, MonadSeldaPool n) =>
Map (ID DbMigration, Text) (SeldaTransactionT n ())
migrationMap [(ID DbMigration, Text)]
appliedMigrationKeys
    unknownMigrationKeysAlreadyApplied :: [(ID DbMigration, Text)]
unknownMigrationKeysAlreadyApplied =
      (((ID DbMigration, Text), ()) -> (ID DbMigration, Text))
-> [((ID DbMigration, Text), ())] -> [(ID DbMigration, Text)]
forall a b. (a -> b) -> [a] -> [b]
map ((ID DbMigration, Text), ()) -> (ID DbMigration, Text)
forall a b. (a, b) -> a
fst ([((ID DbMigration, Text), ())] -> [(ID DbMigration, Text)])
-> [((ID DbMigration, Text), ())] -> [(ID DbMigration, Text)]
forall a b. (a -> b) -> a -> b
$
        Map (ID DbMigration, Text) () -> [((ID DbMigration, Text), ())]
forall k a. Map k a -> [(k, a)]
M.toAscList (Map (ID DbMigration, Text) () -> [((ID DbMigration, Text), ())])
-> Map (ID DbMigration, Text) () -> [((ID DbMigration, Text), ())]
forall a b. (a -> b) -> a -> b
$
          ((ID DbMigration, Text)
 -> Map (ID DbMigration, Text) () -> Map (ID DbMigration, Text) ())
-> Map (ID DbMigration, Text) ()
-> [(ID DbMigration, Text)]
-> Map (ID DbMigration, Text) ()
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (ID DbMigration, Text)
-> Map (ID DbMigration, Text) () -> Map (ID DbMigration, Text) ()
forall k a. Ord k => k -> Map k a -> Map k a
M.delete ([((ID DbMigration, Text), ())] -> Map (ID DbMigration, Text) ()
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([((ID DbMigration, Text), ())] -> Map (ID DbMigration, Text) ())
-> [((ID DbMigration, Text), ())] -> Map (ID DbMigration, Text) ()
forall a b. (a -> b) -> a -> b
$ (,()) ((ID DbMigration, Text) -> ((ID DbMigration, Text), ()))
-> [(ID DbMigration, Text)] -> [((ID DbMigration, Text), ())]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ID DbMigration, Text)]
appliedMigrationKeys) (Map (ID DbMigration, Text) (SeldaTransactionT m ())
-> [(ID DbMigration, Text)]
forall k a. Map k a -> [k]
M.keys (forall (n :: * -> *).
(MonadIO n, MonadLogger n, MonadSeldaPool n) =>
Map (ID DbMigration, Text) (SeldaTransactionT n ())
migrationMap @m))
  case [(ID DbMigration, Text)]
unknownMigrationKeysAlreadyApplied of
    [] -> do
      [((ID DbMigration, Text), SeldaTransactionT m ())]
migrationsToApply [((ID DbMigration, Text), SeldaTransactionT m ())]
-> (((ID DbMigration, Text), SeldaTransactionT m ())
    -> SeldaTransactionT m ())
-> SeldaTransactionT m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
`for_` \((ID DbMigration
identifier, Text
name), SeldaTransactionT m ()
work) -> do
        m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Applying migration: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ((ID DbMigration, Text) -> String
forall a. Show a => a -> String
show (ID DbMigration
identifier, Text
name))
        SeldaTransactionT m ()
work
        UTCTime
currentTime <- IO UTCTime -> SeldaTransactionT m UTCTime
forall a. IO a -> SeldaTransactionT m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
T.getCurrentTime
        m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Setting migration as done."
        Table DbMigration -> DbMigration -> SeldaTransactionT m ()
forall (m :: * -> *) a.
(MonadSelda m, MonadThrow m, Relational a) =>
Table a -> a -> m ()
Selda.insertOne Table DbMigration
tableMigration (DbMigration -> SeldaTransactionT m ())
-> DbMigration -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$
          MkDbMigration
            { dbMigration_id :: ID DbMigration
dbMigration_id = ID DbMigration
identifier
            , dbMigration_name :: Text
dbMigration_name = Text
name
            , dbMigration_time_applied :: UTCTime
dbMigration_time_applied = UTCTime
currentTime
            }
        () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    [(ID DbMigration, Text)]
_ -> do
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logWarn (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Unknown migrations have already been applied to the database: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([(ID DbMigration, Text)] -> String
forall a. Show a => a -> String
show [(ID DbMigration, Text)]
unknownMigrationKeysAlreadyApplied)
      m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError Text
"Database is in an unknown state. Let's stop here to prevent undefined behaviour."
      String -> SeldaTransactionT m ()
forall a. HasCallStack => String -> a
error String
"Unknown migrations have been applied before. Database is in an unknown state."
  () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

type Migration :: Type
data Migration = MkMigration
  { Migration -> ID DbMigration
migrationId :: Selda.ID DbMigration
  , Migration -> Text
migrationName :: T.Text
  , Migration
-> forall (m :: * -> *).
   (MonadIO m, MonadLogger m, MonadSeldaPool m) =>
   SeldaTransactionT m ()
migrationWork ::
      forall m.
      ( MonadIO m
      , MonadLogger m
      , MonadSeldaPool m
      ) =>
      SeldaTransactionT m ()
  }

migrations :: [Migration]
migrations :: [Migration]
migrations =
  [ MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
0
      , migrationName :: Text
migrationName = Text
"exampleJustLog"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"I am logging."
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
1
      , migrationName :: Text
migrationName = Text
"exampleDoNothing"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = () -> SeldaTransactionT m ()
forall a. a -> SeldaTransactionT m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
2
      , migrationName :: Text
migrationName = Text
"exampleAddColumn"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork =
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE user\n\
            \ADD COLUMN address TEXT"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
3
      , migrationName :: Text
migrationName = Text
"exampleDropColumn"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork =
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE user\n\
            \DROP COLUMN address"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
4
      , migrationName :: Text
migrationName = Text
"addSpacePassword"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork =
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space\n\
            \ADD COLUMN password_hash TEXT"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
5
      , migrationName :: Text
migrationName = Text
"addSpaceOwner"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"First add a column without the `NOT NULL` constraint."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space\n\
            \ADD COLUMN owner REFERENCES \"user\"(\"id\")"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Set the correct values to the new owner column."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"UPDATE space\n\
            \SET owner = user\n\
            \FROM (SELECT * FROM space_user ORDER BY id)\n\
            \WHERE space = space.id"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Clean up orphaned spaces without owner."
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Spaces without members will now be deleted permanently."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"DELETE FROM space_role_permission\n\
            \WHERE id IN\n\
            \(\n\
            \    SELECT space_role_permission.id\n\
            \    FROM space_role_permission\n\
            \    JOIN space_role ON space_role_permission.role = space_role.id\n\
            \    JOIN space ON space_role.space = space.id\n\
            \    WHERE space.owner IS NULL\n\
            \)"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"DELETE FROM space_role\n\
            \WHERE id IN\n\
            \(\n\
            \    SELECT space_role.id\n\
            \    FROM space_role\n\
            \    JOIN space ON space_role.space = space.id\n\
            \    WHERE space.owner IS NULL\n\
            \)"
          -- There should be no `space_user`s because otherwise the space would have an `owner` now.
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"DELETE FROM space_user\n\
            \WHERE id IN\n\
            \(\n\
            \    SELECT space_user.id\n\
            \    FROM space_user\n\
            \    JOIN space ON space_user.space = space.id\n\
            \    WHERE space.owner IS NULL\n\
            \)"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"DELETE FROM reservation\n\
            \WHERE id IN\n\
            \(\n\
            \    SELECT reservation.id\n\
            \    FROM reservation\n\
            \    JOIN desk ON reservation.desk = desk.id\n\
            \    JOIN space ON desk.space = space.id\n\
            \    WHERE space.owner IS NULL\n\
            \)"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"DELETE FROM desk\n\
            \WHERE id IN\n\
            \(\n\
            \    SELECT desk.id\n\
            \    FROM desk\n\
            \    JOIN space ON desk.space = space.id\n\
            \    WHERE space.owner IS NULL\n\
            \)"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"DELETE FROM space\n\
            \WHERE owner IS NULL"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"The complicated logic is done. Now we have to redo most of the schema to get a `FOREIGN KEY` constraint on the owner column."

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Declare a bunch of tables as temporary."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space\n\
            \RENAME TO space_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space_user\n\
            \RENAME TO space_user_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space_role\n\
            \RENAME TO space_role_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space_role_permission\n\
            \RENAME TO space_role_permission_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE desk\n\
            \RENAME TO desk_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE reservation\n\
            \RENAME TO reservation_temp"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"And now recreate all tables that depend on each other."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"CREATE TABLE \"space\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"name\" TEXT NOT NULL UNIQUE, \"timezone\" TEXT NOT NULL, \"visibility\" TEXT NOT NULL, \"password_hash\" TEXT, \"owner\" NOT NULL REFERENCES \"user\"(\"id\"), UNIQUE(\"name\"))"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"CREATE TABLE \"space_user\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"space\" INTEGER NOT NULL, \"user\" INTEGER NOT NULL, \"role\" INTEGER NOT NULL, UNIQUE(\"space\", \"user\"), CONSTRAINT \"fk0_space\" FOREIGN KEY (\"space\") REFERENCES \"space\"(\"id\"), CONSTRAINT \"fk1_user\" FOREIGN KEY (\"user\") REFERENCES \"user\"(\"id\"))"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"CREATE TABLE \"space_role\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"space\" INTEGER NOT NULL, \"name\" TEXT NOT NULL, \"accessibility\" TEXT NOT NULL, UNIQUE(\"space\", \"name\"), CONSTRAINT \"fk0_space\" FOREIGN KEY (\"space\") REFERENCES \"space\"(\"id\"))"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"CREATE TABLE \"space_role_permission\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"role\" INTEGER NOT NULL, \"permission\" TEXT NOT NULL, UNIQUE(\"role\", \"permission\"), CONSTRAINT \"fk0_role\" FOREIGN KEY (\"role\") REFERENCES \"space_role\"(\"id\"))"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"CREATE TABLE \"desk\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"space\" INTEGER NOT NULL, \"name\" TEXT NOT NULL, UNIQUE(\"space\", \"name\"), CONSTRAINT \"fk0_space\" FOREIGN KEY (\"space\") REFERENCES \"space\"(\"id\"))"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"CREATE TABLE \"reservation\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"desk\" INTEGER NOT NULL, \"user\" INTEGER NOT NULL, \"time_begin\" DATETIME NOT NULL, \"time_end\" DATETIME NOT NULL, \"status\" TEXT NOT NULL, CONSTRAINT \"fk0_desk\" FOREIGN KEY (\"desk\") REFERENCES \"desk\"(\"id\"), CONSTRAINT \"fk1_user\" FOREIGN KEY (\"user\") REFERENCES \"user\"(\"id\"))"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Insert all rows from the old tables into the new tables."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO space\n\
            \SELECT * FROM space_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO space_user\n\
            \SELECT * FROM space_user_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO space_role\n\
            \SELECT * FROM space_role_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO space_role_permission\n\
            \SELECT * FROM space_role_permission_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO desk\n\
            \SELECT * FROM desk_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO reservation\n\
            \SELECT * FROM reservation_temp"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Drop the temporary tables."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"DROP TABLE reservation_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"DROP TABLE desk_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"DROP TABLE space_role_permission_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"DROP TABLE space_role_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"DROP TABLE space_user_temp"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"DROP TABLE space_temp"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"The `owner` column has been successfully added to the `space` table."
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
6
      , migrationName :: Text
migrationName = Text
"addRoleAccessibilityJoinableWithPassword"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork =
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"UPDATE space_role\n\
            \SET accessibility = 'joinable_with_password'\n\
            \FROM (SELECT id AS space_id, password_hash AS space_password_hash FROM space)\n\
            \WHERE space_role.space = space_id\n\
            \AND space_password_hash IS NOT NULL\n\
            \AND space_role.accessibility = 'joinable'"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
7
      , migrationName :: Text
migrationName = Text
"addRolePasswordHash"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Create new `password_hash` column for `space_role`."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space_role\n\
            \ADD COLUMN password_hash TEXT"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Set the correct values to the new `password_hash` column."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"UPDATE space_role\n\
            \SET password_hash = space.password_hash\n\
            \FROM space\n\
            \WHERE space_role.space = space.id\n\
            \AND space_role.accessibility = 'joinable_with_password'"

          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Delete old `password_hash` column from `space`."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space\n\
            \DROP COLUMN password_hash"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
8
      , migrationName :: Text
migrationName = Text
"fixSpaceOwner"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Fixing the space owner column. One of the previous migrations set regular members as owners. We are setting the owner column to be an admin if possible."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"UPDATE space\n\
            \SET owner = user\n\
            \FROM (\n\
            \    SELECT space_user.space AS space, space_user.user AS user\n\
            \    FROM space_user\n\
            \    JOIN space_role\n\
            \    WHERE space_user.role = space_role.id\n\
            \    AND space_role.name = 'Admin'\n\
            \    ORDER BY space_user.id DESC\n\
            \)\n\
            \WHERE space = space.id"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
9
      , migrationName :: Text
migrationName = Text
"addSpaceEditPermission"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Space admins should have the 'edit_space' permission."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO space_role_permission (role, permission)\n\
            \SELECT role AS role, 'edit_space' AS permission\n\
            \FROM space_role_permission\n\
            \WHERE space_role_permission.permission = 'edit_desk'\n\
            \ON CONFLICT DO NOTHING"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
10
      , migrationName :: Text
migrationName = Text
"addRoleEditPermission"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Space admins should have the 'edit_role' permission."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO space_role_permission (role, permission)\n\
            \SELECT role AS role, 'edit_role' AS permission\n\
            \FROM space_role_permission\n\
            \WHERE space_role_permission.permission = 'edit_space'\n\
            \ON CONFLICT DO NOTHING"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
11
      , migrationName :: Text
migrationName = Text
"deleteSpaceUsersWithForeignRole"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Due to an oversight it was possible to join a space with the role of a different space."
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"All space users with foreign roles will be removed permanently."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"DELETE FROM space_user\n\
            \WHERE space_user.space NOT IN (\n\
            \  SELECT space_role.space\n\
            \  FROM space_role\n\
            \  WHERE id = space_user.role\n\
            \)"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
12
      , migrationName :: Text
migrationName = Text
"addUserEditPermission"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Space admins should have the 'edit_user' permission."
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"INSERT INTO space_role_permission (role, permission)\n\
            \SELECT role AS role, 'edit_user' AS permission\n\
            \FROM space_role_permission\n\
            \WHERE space_role_permission.permission = 'edit_space'\n\
            \ON CONFLICT DO NOTHING"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
13
      , migrationName :: Text
migrationName = Text
"addUserProfilePicture"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE user\n\
            \ADD COLUMN picture_jpeg BLOB"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
14
      , migrationName :: Text
migrationName = Text
"addDeskLocation"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE desk\n\
            \ADD COLUMN position_x DOUBLE PRECISION"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE desk\n\
            \ADD COLUMN position_y DOUBLE PRECISION"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE desk\n\
            \ADD COLUMN direction DOUBLE PRECISION"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE desk\n\
            \ADD COLUMN size_width DOUBLE PRECISION"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE desk\n\
            \ADD COLUMN size_depth DOUBLE PRECISION"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
15
      , migrationName :: Text
migrationName = Text
"addUserEmailNotificationOption"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE user\n\
            \ADD COLUMN email_notifications BOOLEAN NOT NULL DEFAULT FALSE"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
16
      , migrationName :: Text
migrationName = Text
"addSpacePicture"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space\n\
            \ADD COLUMN picture_jpeg BLOB"
      }
  , MkMigration
      { migrationId :: ID DbMigration
migrationId = Int64 -> ID DbMigration
forall a. Int64 -> ID a
Selda.toId Int64
17
      , migrationName :: Text
migrationName = Text
"renameSpaceRoleToRole"
      , migrationWork :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadSeldaPool m) =>
SeldaTransactionT m ()
migrationWork = do
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space_role\n\
            \RENAME TO role"
          QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm
            QueryFragment
"ALTER TABLE space_role_permission\n\
            \RENAME TO role_permission"
      }
  ]

createDatabase ::
  ( MonadSeldaPool m
  , MonadLogger m
  ) =>
  m ()
createDatabase :: forall (m :: * -> *). (MonadSeldaPool m, MonadLogger m) => m ()
createDatabase = do
  Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating database."
  SeldaResult ()
result <- SeldaTransactionT m () -> m (SeldaResult ())
forall a. SeldaTransactionT m a -> m (SeldaResult a)
forall (m :: * -> *) a.
MonadSeldaPool m =>
SeldaTransactionT m a -> m (SeldaResult a)
runSeldaTransactionT (SeldaTransactionT m () -> m (SeldaResult ()))
-> SeldaTransactionT m () -> m (SeldaResult ())
forall a b. (a -> b) -> a -> b
$ do
    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'migration'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"migration\"(\"id\" INTEGER  NOT NULL, \"name\" TEXT NOT NULL UNIQUE, \"time_applied\" DATETIME NOT NULL, UNIQUE(\"name\"), PRIMARY KEY(\"id\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'jwk'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"jwk\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"jwk\" BLOB NOT NULL UNIQUE, \"created\" DATETIME NOT NULL, UNIQUE(\"jwk\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'user'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"user\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"name\" TEXT NOT NULL UNIQUE, \"password_hash\" TEXT NOT NULL, \"email\" TEXT NOT NULL, \"email_visibility\" TEXT NOT NULL, \"email_validated\" BOOLEAN NOT NULL, UNIQUE(\"name\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'confirmation'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"confirmation\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"user\" INTEGER NOT NULL, \"secret\" TEXT NOT NULL, \"expired\" DATETIME NOT NULL, \"effect\" TEXT NOT NULL, UNIQUE(\"secret\", \"user\"), CONSTRAINT \"fk0_user\" FOREIGN KEY (\"user\") REFERENCES \"user\"(\"id\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'session'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"session\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"user\" INTEGER NOT NULL, \"time_created\" DATETIME NOT NULL, \"time_expired\" DATETIME NULL, CONSTRAINT \"fk0_user\" FOREIGN KEY (\"user\") REFERENCES \"user\"(\"id\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'space'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"space\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"name\" TEXT NOT NULL UNIQUE, \"timezone\" TEXT NOT NULL, \"visibility\" TEXT NOT NULL, UNIQUE(\"name\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'space_role'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"space_role\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"space\" INTEGER NOT NULL, \"name\" TEXT NOT NULL, \"accessibility\" TEXT NOT NULL, UNIQUE(\"space\", \"name\"), CONSTRAINT \"fk0_space\" FOREIGN KEY (\"space\") REFERENCES \"space\"(\"id\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'space_role_permission'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"space_role_permission\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"role\" INTEGER NOT NULL, \"permission\" TEXT NOT NULL, UNIQUE(\"role\", \"permission\"), CONSTRAINT \"fk0_role\" FOREIGN KEY (\"role\") REFERENCES \"space_role\"(\"id\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'space_user'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"space_user\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"space\" INTEGER NOT NULL, \"user\" INTEGER NOT NULL, \"role\" INTEGER NOT NULL, UNIQUE(\"space\", \"user\"), CONSTRAINT \"fk0_space\" FOREIGN KEY (\"space\") REFERENCES \"space\"(\"id\"), CONSTRAINT \"fk1_user\" FOREIGN KEY (\"user\") REFERENCES \"user\"(\"id\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'desk'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"desk\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"space\" INTEGER NOT NULL, \"name\" TEXT NOT NULL, UNIQUE(\"space\", \"name\"), CONSTRAINT \"fk0_space\" FOREIGN KEY (\"space\") REFERENCES \"space\"(\"id\"))"

    m () -> SeldaTransactionT m ()
forall (m :: * -> *) a. Monad m => m a -> SeldaTransactionT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> SeldaTransactionT m ()) -> m () -> SeldaTransactionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logDebug Text
"Creating table 'reservation'."
    QueryFragment -> SeldaTransactionT m ()
forall (m :: * -> *). MonadSelda m => QueryFragment -> m ()
Selda.Unsafe.rawStm QueryFragment
"CREATE TABLE \"reservation\"(\"id\" INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, \"desk\" INTEGER NOT NULL, \"user\" INTEGER NOT NULL, \"time_begin\" DATETIME NOT NULL, \"time_end\" DATETIME NOT NULL, \"status\" TEXT NOT NULL, CONSTRAINT \"fk0_desk\" FOREIGN KEY (\"desk\") REFERENCES \"desk\"(\"id\"), CONSTRAINT \"fk1_user\" FOREIGN KEY (\"user\") REFERENCES \"user\"(\"id\"))"

  case SeldaResult ()
result of
    SeldaSuccess () -> Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logInfo Text
"Created database."
    SeldaFailure SomeException
err -> Text -> m ()
forall (m :: * -> *). (HasCallStack, MonadLogger m) => Text -> m ()
logError (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Failed to create database: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (SomeException -> String
forall a. Show a => a -> String
show SomeException
err)