diff --git a/README.org b/README.org new file mode 100644 --- /dev/null +++ b/README.org @@ -0,0 +1,67 @@ +* Yggdrasil Schema + +#+begin_html +
+Haskell +SQLite +Nix +
+#+end_html + +Yggdrasil Schema is a Haskell-based tool for managing database migrations. +Inspired by tools like Flyway, or Liquibase, it automates the process of applying migrations, keeping track of which migrations have been executed, and ensuring they only run once. + +Yggdrasil Schema is designed to be simple, extensible, and adaptable to various storage engines. + +Initially, it supports SQLite, but its architecture is open for future extensions to support additional storage engines. +As of now available as library only, in the future also as CLI standalone tool (with optparse-applicative). + +#+begin_html +
+ +
+#+end_html + +** Features + +- Automatically applies missing migrations to your database +- Tracks migration history to ensure each migration is run exactly once +- Written in Haskell with a focus on functional programming principles +- Supports SQLite out of the box, other storage engines should be easy to add, and we are open for contributions + +** Usage + +Once installed, you can use Yggdrasil to apply migrations to your database. + +By default, Yggdrasil SQLite branch looks for migration files in the ~./resources/migrations/sqlite/~ directory. + +*NOTE* : Keep in mind this slash ( / ) at the end is very important. + +All you need is a directory with migration files. +The only requirement in naming the files is that they start with a number and a dash, so that the order can be determined. + +Examples of valid files: ~0-init-my-database.sql~ , ~100-another migration with spaces.txt~ + +To get things working properly, please ensure that your first migration, called something like ~0-yggdrasil.sql~ contains the following: +#+begin_src sql +CREATE TABLE yggdrasil ( + identifier TEXT NOT NULL PRIMARY KEY, + order_value INTEGER NOT NULl, + file_name TEXT NOT NULL, + ran_at TEXT NOT NULL +); + +#+end_src + +** Extending Yggdrasil + +Yggdrasil is built with extension in mind. You can easily add support for other databases by implementing a new storage engine backend. + +** Contributing + +We welcome contributions from the community. Whether it's bug fixes, new features, or documentation improvements, feel free to open a pull request or an issue. + +** License + +This project is licensed under the GNU Lesser GPL License v3. See the COPYING file for more details. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple + +main :: IO () +main = defaultMain diff --git a/src/Yggdrasil.hs b/src/Yggdrasil.hs new file mode 100644 --- /dev/null +++ b/src/Yggdrasil.hs @@ -0,0 +1,129 @@ +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} + +module Yggdrasil where + +import Control.Exception +import Data.List (minimumBy) +import Data.List.NonEmpty qualified as NE +import Data.Text qualified as T +import Data.Time +import Data.UUID.V4 +import Database.SQLite.Simple +import NeatInterpolation +import Optics +import Relude +import System.Directory + +data YggdrasilEngine = SQLite | PostgreSQL | MySQL deriving (Generic, Eq, Show) + +data Yggdrasil = Yggdrasil + { databaseFilePath :: Text, + migrationsDirectoryPath :: Text, + runMigrations :: Bool, + engine :: YggdrasilEngine + } + deriving (Generic, Eq, Show) + +makeFieldLabelsNoPrefix ''Yggdrasil + +data RanMigration = RanMigration Text Int Text UTCTime + deriving (Generic, Eq, Show) + +instance FromRow RanMigration where + fromRow = RanMigration <$> field <*> field <*> field <*> field + +defaultYggdrasil :: Yggdrasil +defaultYggdrasil = + Yggdrasil + { databaseFilePath = "./resources/test/db.sqlite", + migrationsDirectoryPath = "./resources/migrations/sqlite/", + runMigrations = True, + engine = SQLite + } + +runYggdrasil :: (MonadIO m) => Yggdrasil -> m () +runYggdrasil yggdrasil = when (yggdrasil ^. #runMigrations) $ do + sortedFiles <- getSortedMigrationFiles yggdrasil + case nonEmpty sortedFiles of + Nothing -> error "No valid migration files found!" + Just ordersAndFiles -> do + ranMigrations <- liftIO $ catch (getRanMigrations yggdrasil) handler + + let execReqHighest = minimumBy (comparing Down) $ NE.map fst ordersAndFiles + isThereHigher = isJust . find (\p -> fst p > execReqHighest) $ ranMigrations + when isThereHigher $ error "Detected a migration order mismatch! History contains newer items than in migrations folder!" + + let toRun = NE.filter (\t -> isNothing $ find (== t) ranMigrations) ordersAndFiles + + case nonEmpty toRun of + Nothing -> print ("All migrations up to date!" :: String) + Just toRun' -> do + _ <- print ("About to run migrations!" :: String) + _ <- print toRun' + mapM_ (runMigration yggdrasil) toRun' + where + handler :: SQLError -> IO [(Int, Text)] + handler _ = pure [] + +getSortedMigrationFiles :: (MonadIO m) => Yggdrasil -> m [(Int, Text)] +getSortedMigrationFiles yggdrasil = do + files <- liftIO $ listDirectory (fromString . T.unpack $ yggdrasil ^. #migrationsDirectoryPath) + let rawFs = mapMaybe (explodeMigrationPath . T.pack) files + rawFilesWithOrder = mapMaybe (liftTupleMaybeFromFst . toIntOrder) rawFs + sortedFiles = sortOn fst rawFilesWithOrder + pure sortedFiles + +toIntOrder :: (Text, Text) -> (Maybe Int, Text) +toIntOrder = first (readMaybe . T.unpack) + +explodeMigrationPath :: Text -> Maybe (Text, Text) +explodeMigrationPath filePath = + let k = (fmap head . nonEmpty . T.split (== '-')) filePath + in liftTupleMaybeFromFst (k, filePath) + +liftTupleMaybeFromFst :: (Maybe a, b) -> Maybe (a, b) +liftTupleMaybeFromFst (Nothing, _) = Nothing +liftTupleMaybeFromFst (Just j, x) = Just (j, x) + +parseTextToSqlStatements :: Text -> [Text] +parseTextToSqlStatements = filter (/= "") . map T.strip . T.split (== ';') + +runMigration :: (MonadIO m) => Yggdrasil -> (Int, Text) -> m () +runMigration yggdrasil (ord', fPath) = do + f <- readFileBS (T.unpack (yggdrasil ^. #migrationsDirectoryPath <> fPath)) + let maybeFileContents = decodeUtf8' f + case maybeFileContents of + Left e -> print e >> error (show e) -- migration errors should be critical + Right fileContents' -> do + conn <- liftIO $ open (T.unpack $ yggdrasil ^. #databaseFilePath) + -- run statements from parsed file in order + _ <- + liftIO + $ mapM + (\qqq -> execute_ conn (fromString . T.unpack $ qqq)) + (parseTextToSqlStatements fileContents') + -- record in migrations table that we ran migration so as to not run again + someUUID <- liftIO nextRandom + now <- liftIO getCurrentTime + -- TODO: add the Yggdrasil versio number when as library + _ <- liftIO $ execute conn (fromString . T.unpack $ insertYggdrasilMigrationQuery) (T.pack . show $ someUUID, ord', fPath, now) + _ <- liftIO $ close conn + pure () + where + insertYggdrasilMigrationQuery = + [trimming| + INSERT INTO yggdrasil (identifier, order_value, file_name, ran_at) VALUES (?,?,?,?) + |] + +getRanMigrations :: (MonadIO m) => Yggdrasil -> m [(Int, Text)] +getRanMigrations yggdrasil = do + conn <- liftIO $ open (fromString . T.unpack $ yggdrasil ^. #databaseFilePath) + (ms :: [RanMigration]) <- liftIO $ catch (query_ conn "SELECT identifier, order_value, file_name, ran_at from yggdrasil") handler + pure . sortOn fst . map mapRanMigration $ ms + where + mapRanMigration (RanMigration _ orderValue fileName _) = (orderValue, fileName) + handler :: SQLError -> IO [RanMigration] + handler _ = pure [] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,7 @@ +import Relude +import Test.Hspec +import Yggdrasil.Test.Yggdrasil + +main :: IO () +main = hspec $ do + yggdrasilSpec diff --git a/test/Yggdrasil/Test/Yggdrasil.hs b/test/Yggdrasil/Test/Yggdrasil.hs new file mode 100644 --- /dev/null +++ b/test/Yggdrasil/Test/Yggdrasil.hs @@ -0,0 +1,71 @@ +module Yggdrasil.Test.Yggdrasil where + +import Data.Text qualified as T +import Data.UUID.V4 +import Relude +import System.Directory +import Test.Hspec +import Yggdrasil + +yggdrasilSpec :: SpecWith () +yggdrasilSpec = describe "yggdrasil" $ do + it "can parse sql DDL statements for SQLite" $ do + f <- readFileBS "./resources/test/migration-files/1-some-valid-sql.sql" + case decodeUtf8' f of + Left e -> print e >> error (show e) + Right t -> do + let parsed = parseTextToSqlStatements t + length parsed `shouldBe` 3 + it "can explode migration filename properly" $ do + explodeMigrationPath "0-init.sql" `shouldBe` Just ("0", "0-init.sql") + explodeMigrationPath "999999-init.sql" `shouldBe` Just ("999999", "999999-init.sql") + explodeMigrationPath "1-init🔗❤️👍.sql" `shouldBe` Just ("1", "1-init🔗❤️👍.sql") + explodeMigrationPath "23-init with spaces and weird symbols$.sql" `shouldBe` Just ("23", "23-init with spaces and weird symbols$.sql") + it "gets files in the right order" $ do + xs <- getSortedMigrationFiles defaultYggdrasil {migrationsDirectoryPath = "./resources/test/migration-files/"} + xs `shouldBe` [(0, "0-yggdrasil.sql"), (1, "1-some-valid-sql.sql"), (2, "2-more-valid-sql-$$.sql"), (3, "3-empty.sql")] + it "does run migrations correctly on clean DB" $ do + someUUID <- liftIO nextRandom + let dbPath = "./resources/test/" <> (T.pack . show $ someUUID) <> ".sqlite" + yggdrasil = + Yggdrasil + { databaseFilePath = dbPath, + migrationsDirectoryPath = "./resources/test/migration-files/", + engine = SQLite, + runMigrations = True + } + _ <- runYggdrasil yggdrasil + ms <- getRanMigrations yggdrasil + _ <- liftIO $ removeFile (fromString . T.unpack $ dbPath) + ms `shouldBe` [(0, "0-yggdrasil.sql"), (1, "1-some-valid-sql.sql"), (2, "2-more-valid-sql-$$.sql"), (3, "3-empty.sql")] + + it "does skip migrations correctly on used DB" $ do + someUUID <- liftIO nextRandom + let dbPath = "./resources/test/" <> (T.pack . show $ someUUID) <> ".sqlite" + yggdrasil = + Yggdrasil + { databaseFilePath = dbPath, + migrationsDirectoryPath = "./resources/test/migration-files/", + engine = SQLite, + runMigrations = True + } + _ <- runMigration yggdrasil (0, "0-yggdrasil.sql") + _ <- runMigration yggdrasil (1, "1-some-valid-sql.sql") + _ <- runYggdrasil yggdrasil + ms <- getRanMigrations yggdrasil + _ <- liftIO $ removeFile (fromString . T.unpack $ dbPath) + ms `shouldBe` [(0, "0-yggdrasil.sql"), (1, "1-some-valid-sql.sql"), (2, "2-more-valid-sql-$$.sql"), (3, "3-empty.sql")] + it "does not do anything when runMigrations is false" $ do + someUUID <- liftIO nextRandom + let dbPath = "./resources/test/" <> (T.pack . show $ someUUID) <> ".sqlite" + yggdrasil = + Yggdrasil + { databaseFilePath = dbPath, + migrationsDirectoryPath = "./resources/test/migration-files/", + engine = SQLite, + runMigrations = False + } + _ <- runYggdrasil yggdrasil + ms <- getRanMigrations yggdrasil + _ <- liftIO $ removeFile (fromString . T.unpack $ dbPath) + ms `shouldBe` [] diff --git a/yggdrasil-schema.cabal b/yggdrasil-schema.cabal new file mode 100644 --- /dev/null +++ b/yggdrasil-schema.cabal @@ -0,0 +1,131 @@ +cabal-version: 1.12 + +name: yggdrasil-schema +version: 1.0.0.0 +description: Please see the README at +homepage: https://github.com/jjba23/yggdrasil-schema +bug-reports: https://github.com/jjba23/yggdrasil-schema/issues +author: Josep Bigorra +maintainer: Josep Bigorra +copyright: 2024 Josep Bigorra +license: LGPL-3 +build-type: Simple + +extra-source-files: + README.org + +source-repository head + type: git + location: https://github.com/jjba23/yggdrasil-schema + +library + exposed-modules: + Yggdrasil + other-modules: + Paths_yggdrasil_schema + hs-source-dirs: + src + ghc-options: -Wall -threaded + default-extensions: + DataKinds + DefaultSignatures + DuplicateRecordFields + EmptyDataDecls + ExistentialQuantification + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + InstanceSigs + KindSignatures + LambdaCase + MultiWayIf + NamedFieldPuns + NoImplicitPrelude + OverloadedStrings + PartialTypeSignatures + RecordWildCards + TypeFamilies + ViewPatterns + + build-depends: + aeson + , async + , base < 5 + , bytestring + , keys + , mtl + , optics + , optparse-applicative + , relude + , time + , text + , containers + , filepath + , directory + , random + , uuid + , neat-interpolation + , sqlite-simple + default-language: GHC2021 + + +test-suite yggdrasil-schema-spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_yggdrasil_schema + Yggdrasil.Test.Yggdrasil + hs-source-dirs: + test + ghc-options: -Wall -threaded -rtsopts "-with-rtsopts=-T -N" + default-extensions: + DataKinds + DefaultSignatures + DuplicateRecordFields + EmptyDataDecls + ExistentialQuantification + FlexibleContexts + FlexibleInstances + FunctionalDependencies + GADTs + InstanceSigs + KindSignatures + LambdaCase + MultiWayIf + NamedFieldPuns + NoImplicitPrelude + OverloadedStrings + PartialTypeSignatures + RecordWildCards + TypeFamilies + ViewPatterns + + build-depends: + aeson + , async + , base < 5 + , bytestring + , keys + , mtl + , optics + , optparse-applicative + , relude + , random + , time + , text + , containers + , filepath + , directory + , uuid + , neat-interpolation + , sqlite-simple + , hspec + , QuickCheck + , tasty + , tasty-hspec + , yggdrasil-schema + default-language: GHC2021 + + +