
   0 | module Oracle.Migration.Runner
   1 | 
   2 | import Data.List
   3 | import Oracle
   4 | import Oracle.Types.Migration
   5 | 
   6 | %default total
   7 | 
   8 | ||| Ensure that the migration history table exists.
   9 | |||
  10 | ||| The migration table is created automatically the first time any migration
  11 | ||| operation is performed.
  12 | |||
  13 | export covering
  14 | ensureMigrationTable : Connection -> IO (Either OracleError ())
  15 | ensureMigrationTable conn = do
  16 |   result <- queryRaw conn
  17 |                      """
  18 |                      SELECT table_name
  19 |                      FROM user_tables
  20 |                      WHERE table_name = 'IDRIS_ORACLE_MIGRATIONS'
  21 |                      """
  22 |                      []
  23 | 
  24 |   case result of
  25 |     Left err   =>
  26 |       pure (Left err)
  27 |     Right rows =>
  28 |       case rows of
  29 |         [] =>
  30 |           execute_
  31 |             conn
  32 |             """
  33 |             CREATE TABLE idris_oracle_migrations (
  34 |                 version      NUMBER PRIMARY KEY,
  35 |                 description  VARCHAR2(4000) NOT NULL,
  36 |                 applied_at   TIMESTAMP DEFAULT CURRENT_TIMESTAMP NOT NULL
  37 |             )
  38 |             """
  39 |             []
  40 |         _  =>
  41 |           pure (Right ())
  42 | 
  43 | ||| Retrieve all migrations that have already been applied.
  44 | |||
  45 | ||| Results are ordered by migration version.
  46 | |||
  47 | export covering
  48 | listAppliedMigrations : Connection -> IO (Either OracleError (List MigrationInfo))
  49 | listAppliedMigrations conn =
  50 |   ensureMigrationTable conn
  51 |   >>== \_ => do
  52 |   result <- queryRaw conn
  53 |                      """
  54 |                      SELECT
  55 |                          version,
  56 |                          description,
  57 |                          TO_CHAR(
  58 |                              applied_at,
  59 |                              'YYYY-MM-DD"T"HH24:MI:SS.FF9'
  60 |                          )
  61 |                      FROM idris_oracle_migrations
  62 |                      ORDER BY version
  63 |                      """
  64 |                      []
  65 |   case result of
  66 |     Left err   =>
  67 |       pure (Left err)
  68 |     Right rows =>
  69 |       decodeRows rows
  70 |   where
  71 |     decodeRow : List OracleValue -> Either OracleError MigrationInfo
  72 |     decodeRow [ OracleNumber version
  73 |               , OracleString description
  74 |               , OracleString appliedAt
  75 |               ]   =
  76 |       Right $
  77 |         MkMigrationInfo
  78 |           (cast version)
  79 |           description
  80 |           appliedAt
  81 |     decodeRow row =
  82 |       Left $
  83 |         MkOracleError
  84 |           (-1)
  85 |           ("Invalid migration history row: " ++ show row)
  86 |           "Oracle.Migration.Runner.listAppliedMigrations"
  87 |           False
  88 |     decodeRows : List (List OracleValue) -> IO (Either OracleError (List MigrationInfo))
  89 |     decodeRows []            =
  90 |       pure (Right [])
  91 |     decodeRows (row :: rows) =
  92 |       case decodeRow row of
  93 |         Left err   =>
  94 |           pure (Left err)
  95 |         Right info => do
  96 |           rest <- decodeRows rows
  97 |           case rest of
  98 |             Left err    =>
  99 |               pure (Left err)
 100 |             Right infos =>
 101 |               pure (Right (info :: infos))
 102 | 
 103 | ||| Return migrations that have been defined by the application but have not yet been applied.
 104 | |||
 105 | export covering
 106 | pendingMigrations : Connection -> List Migration -> IO (Either OracleError (List Migration))
 107 | pendingMigrations conn migrations = do
 108 |   result <- listAppliedMigrations conn
 109 |   case result of
 110 |     Left err      =>
 111 |       pure (Left err)
 112 |     Right applied =>
 113 |       pure $
 114 |         Right $
 115 |           filter
 116 |             (\migration => not (isMigrationApplied migration applied))
 117 |             (sortBy compareMigrationVersion migrations)
 118 |   where
 119 |     compareMigrationVersion : Migration -> Migration -> Ordering
 120 |     compareMigrationVersion a b =
 121 |       compare (migrationversion a) (migrationversion b)
 122 | 
 123 | ||| Return the current migration status.
 124 | |||
 125 | ||| `MigrationPending` indicates a migration exists in the supplied application migration set but has not been applied.
 126 | |||
 127 | ||| `MigrationApplied` indicates both the migration definition and its persisted migration record exist.
 128 | |||
 129 | ||| `MigrationMissing` indicates a migration was previously applied but its definition is no longer present in the supplied migration set.
 130 | |||
 131 | export covering
 132 | migrationStatus : Connection -> List Migration -> IO (Either OracleError (List MigrationStatus))
 133 | migrationStatus conn migrations = do
 134 |   result <- listAppliedMigrations conn
 135 |   case result of
 136 |     Left err      =>
 137 |       pure (Left err)
 138 |     Right applied => do
 139 |       let migrationstatuses =
 140 |             map (\migration =>
 141 |                   case findApplied migration applied of
 142 |                     Nothing   =>
 143 |                       MigrationPending migration
 144 |                     Just info =>
 145 |                       MigrationApplied migration info
 146 |                 )
 147 |               (sortBy compareMigrationVersion migrations)
 148 |       let missingstatuses   =
 149 |             map
 150 |               MigrationMissing
 151 |               ( filter
 152 |                   (\info => not (containsVersion info migrations))
 153 |                    applied
 154 |               )
 155 |       pure $
 156 |         Right $
 157 |           migrationstatuses ++ missingstatuses
 158 |   where
 159 |     compareMigrationVersion : Migration -> Migration -> Ordering
 160 |     compareMigrationVersion a b =
 161 |       compare (migrationversion a) (migrationversion b)
 162 |     findApplied : Migration -> List MigrationInfo -> Maybe MigrationInfo
 163 |     findApplied migration []                                =
 164 |       Nothing
 165 |     findApplied migration (migrationinfo :: migrationinfos) =
 166 |       case sameMigrationVersion migration migrationinfo of
 167 |         True  =>
 168 |           Just migrationinfo
 169 |         False =>
 170 |           findApplied migration migrationinfos
 171 |     containsVersion : MigrationInfo -> List Migration -> Bool
 172 |     containsVersion migrationinfo []               =
 173 |       False
 174 |     containsVersion migrationinfo (migration :: migrations) =
 175 |       case migrationinfoversion migrationinfo == migrationversion migration of
 176 |         True =>
 177 |           True
 178 |         False =>
 179 |           containsVersion migrationinfo migrations
 180 | 
 181 | ||| Record a successfully applied migration.
 182 | |||
 183 | recordMigration : Connection -> Migration -> IO (Either OracleError ())
 184 | recordMigration conn migration =
 185 |   execute_
 186 |     conn
 187 |     """
 188 |     INSERT INTO idris_oracle_migrations
 189 |     (
 190 |         version,
 191 |         description,
 192 |         applied_at
 193 |     )
 194 |     VALUES
 195 |     (
 196 |         :version,
 197 |         :description,
 198 |         CURRENT_TIMESTAMP
 199 |     )
 200 |     """
 201 |     [ MkBindParameter
 202 |         ":version"
 203 |         (OracleNumber (cast (migrationversion migration)))
 204 |     , MkBindParameter
 205 |         ":description"
 206 |         (OracleString (migrationname migration))
 207 |     ]
 208 | 
 209 | ||| Remove a migration from the migration history.
 210 | |||
 211 | removeMigrationRecord : Connection -> Migration -> IO (Either OracleError ())
 212 | removeMigrationRecord conn migration =
 213 |   execute_
 214 |     conn
 215 |     """
 216 |     DELETE FROM idris_oracle_migrations
 217 |     WHERE version = :version
 218 |     """
 219 |     [ MkBindParameter
 220 |         ":version"
 221 |         (OracleNumber (cast (migrationversion migration)))
 222 |     ]
 223 | 
 224 | ||| Execute all pending migrations in ascending version order.
 225 | |||
 226 | ||| Each migration is applied by invoking its `up` action.
 227 | |||
 228 | ||| The migration is recorded in the migration history only after `up` succeeds.
 229 | |||
 230 | ||| The operation commits after each successfully applied migration.
 231 | |||
 232 | ||| This ensures that the migration history cannot claim that a migration succeeded when its database changes were rolled back.
 233 | |||
 234 | export covering
 235 | runMigrations : Connection -> List Migration -> IO (Either OracleError ())
 236 | runMigrations conn migrations = do
 237 |   pendingresult <- pendingMigrations conn migrations
 238 |   case pendingresult of
 239 |     Left err      =>
 240 |       pure (Left err)
 241 |     Right pending =>
 242 |       runPending conn pending
 243 |   where
 244 |     runPending : Connection -> List Migration -> IO (Either OracleError ())
 245 |     runPending _    []                        =
 246 |       pure (Right ())
 247 |     runPending conn (migration :: migrations) = do
 248 |       result <- (migrationup migration) conn
 249 |       case result of
 250 |         Left err =>
 251 |           pure (Left err)
 252 |         Right () => do
 253 |           recordresult <- recordMigration conn migration
 254 |           case recordresult of
 255 |             Left err =>
 256 |               pure (Left err)
 257 |             Right () => do
 258 |               commitresult <- commit conn
 259 |               case commitresult of
 260 |                 Left err =>
 261 |                   pure (Left err)
 262 |                 Right () =>
 263 |                   runPending conn migrations
 264 | 
 265 | ||| Roll back the most recently applied migration.
 266 | |||
 267 | ||| The supplied migration list is used to find the executable rollback action corresponding to the most recently applied migration.
 268 | |||
 269 | ||| Fails if:
 270 | ||| * No migrations have been applied.
 271 | ||| * The latest applied migration has no corresponding definition in the supplied migration list.
 272 | |||
 273 | ||| The migration history record is removed only after the rollback action succeeds.
 274 | |||
 275 | export covering
 276 | rollbackMigration : Connection -> List Migration -> IO (Either OracleError ())
 277 | rollbackMigration conn migrations = do
 278 |   appliedresult <- listAppliedMigrations conn
 279 |   case appliedresult of
 280 |     Left err =>
 281 |       pure (Left err)
 282 |     Right [] =>
 283 |       pure $
 284 |         Left $
 285 |           MkOracleError
 286 |             (-1)
 287 |             "No migrations have been applied"
 288 |             "Oracle.Migration.Runner.rollbackMigration"
 289 |             False
 290 |     Right applied =>
 291 |       case latestMigration applied of
 292 |         Nothing =>
 293 |           pure $
 294 |             Left $
 295 |               MkOracleError
 296 |                 (-1)
 297 |                 "Unable to determine latest migration"
 298 |                 "Oracle.Migration.Runner.rollbackMigration"
 299 |                 False
 300 |         Just latest        =>
 301 |           case findMigration latest migrations of
 302 |             Nothing =>
 303 |               pure $
 304 |                 Left $
 305 |                   MkOracleError
 306 |                     (-1)
 307 |                     ( "Migration definition not found for applied version "
 308 |                       ++ show (migrationinfoversion latest)
 309 |                     )
 310 |                     "Oracle.Migration.Runner.rollbackMigration"
 311 |                     False
 312 |             Just migration =>
 313 |               rollback conn migration
 314 |   where
 315 |     latestMigration : List MigrationInfo -> Maybe MigrationInfo
 316 |     latestMigration []              =
 317 |       Nothing
 318 |     latestMigration (info :: infos) =
 319 |       Just $
 320 |         foldl
 321 |           (\current, candidate =>
 322 |             case migrationinfoversion candidate > migrationinfoversion current of
 323 |               True  =>
 324 |                 candidate
 325 |               False =>
 326 |                 current
 327 |           )
 328 |           info
 329 |           infos
 330 |     findMigration : MigrationInfo -> List Migration -> Maybe Migration
 331 |     findMigration _ []                                    =
 332 |       Nothing
 333 |     findMigration migrationinfo (migration :: migrations) =
 334 |       case migrationinfoversion migrationinfo == migrationversion migration of
 335 |         True  =>
 336 |           Just migration
 337 |         False =>
 338 |           findMigration migrationinfo migrations
 339 |     rollback : Connection -> Migration -> IO (Either OracleError ())
 340 |     rollback conn migration = do
 341 |       result <- (migrationdown migration) conn
 342 |       case result of
 343 |         Left err =>
 344 |           pure (Left err)
 345 |         Right () => do
 346 |           removeResult <- removeMigrationRecord conn migration
 347 |           case removeResult of
 348 |             Left err =>
 349 |               pure (Left err)
 350 |             Right () =>
 351 |               commit conn
 352 |