diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index 6cf3240..1a04b0e 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -29,19 +29,19 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.1 + - compiler: ghc-9.6.3 compilerKind: ghc - compilerVersion: 9.6.1 + compilerVersion: 9.6.3 setup-method: ghcup allow-failure: false - - compiler: ghc-9.4.4 + - compiler: ghc-9.4.7 compilerKind: ghc - compilerVersion: 9.4.4 + compilerVersion: 9.4.7 setup-method: ghcup allow-failure: false - - compiler: ghc-9.2.7 + - compiler: ghc-9.2.8 compilerKind: ghc - compilerVersion: 9.2.7 + compilerVersion: 9.2.8 setup-method: ghcup allow-failure: false - compiler: ghc-9.0.2 @@ -66,8 +66,9 @@ jobs: apt-get update apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 postgresql-client mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" + "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) env: @@ -82,10 +83,12 @@ jobs: echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER - HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" - echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" diff --git a/postgresql-migration.cabal b/postgresql-migration.cabal index 762598d..155afe3 100644 --- a/postgresql-migration.cabal +++ b/postgresql-migration.cabal @@ -12,9 +12,9 @@ copyright: 2014-2021, Andreas Meingast category: Database build-type: Simple description: A PostgreSQL-simple schema migration utility -tested-with: GHC==9.6.1 - GHC==9.4.4 - GHC==9.2.7 +tested-with: GHC==9.6.3 + GHC==9.4.7 + GHC==9.2.8 GHC==9.0.2 GHC==8.8.4 GHC==8.6.5 diff --git a/src/Database/PostgreSQL/Simple/Migration.hs b/src/Database/PostgreSQL/Simple/Migration.hs index a8b5561..0dea598 100644 --- a/src/Database/PostgreSQL/Simple/Migration.hs +++ b/src/Database/PostgreSQL/Simple/Migration.hs @@ -62,7 +62,7 @@ import Database.PostgreSQL.Simple ( Connection import Database.PostgreSQL.Simple.FromRow (FromRow (..), field) import Database.PostgreSQL.Simple.ToField (ToField (..)) import Database.PostgreSQL.Simple.ToRow (ToRow (..)) -import Database.PostgreSQL.Simple.Types (Query (..)) +import Database.PostgreSQL.Simple.Types (Query (..), Identifier) import Database.PostgreSQL.Simple.Util (existsTable) import System.Directory (listDirectory) import System.FilePath (()) @@ -176,22 +176,24 @@ executeMigration con opts name contents = doStepTransaction opts con $ do when (verbose opts) $ optLogWriter opts $ Right ("Executing:\t" <> fromString name) void $ execute_ con (Query contents) when (verbose opts) $ optLogWriter opts $ Right ("Adding '" <> fromString name <> "' to schema_migrations with checksum '" <> fromString (show checksum) <> "'") - void $ execute con q (name, checksum) + void $ execute con q (migrationsTableName opts, name, checksum) when (verbose opts) $ optLogWriter opts $ Right ("Executed:\t" <> fromString name) pure MigrationSuccess ScriptModified eva -> do when (verbose opts) $ optLogWriter opts $ Left ("Fail:\t" <> fromString name <> "\n" <> scriptModifiedErrorMessage eva) pure (MigrationError name) where - q = "insert into " <> Query (optTableName opts) <> "(filename, checksum) values(?, ?)" + q = "insert into ? (filename, checksum) values(?, ?)" -- | Initializes the database schema with a helper table containing -- meta-information about executed migrations. initializeSchema :: Connection -> MigrationOptions -> IO () initializeSchema con opts = do when (verbose opts) $ optLogWriter opts $ Right "Initializing schema" - void . doStepTransaction opts con . execute_ con $ mconcat - [ "create table if not exists " <> Query (optTableName opts) <> " " + void . doStepTransaction opts con $ execute con q (Only $ migrationsTableName opts) + where + q = mconcat + [ "create table if not exists ? " , "( filename varchar(512) not null" , ", checksum varchar(32) not null" , ", executed_at timestamp without time zone not null default now() " @@ -252,7 +254,7 @@ executeValidation con opts cmd = doStepTransaction opts con $ -- will be executed and its meta-information will be recorded. checkScript :: Connection -> MigrationOptions -> ScriptName -> Checksum -> IO CheckScriptResult checkScript con opts name fileChecksum = - query con q (Only name) >>= \case + query con q (migrationsTableName opts, name) >>= \case [] -> pure ScriptNotExecuted Only dbChecksum:_ | fileChecksum == dbChecksum -> @@ -261,7 +263,7 @@ checkScript con opts name fileChecksum = pure $ ScriptModified (ExpectedVsActual {evaExpected = dbChecksum, evaActual = fileChecksum}) where q = mconcat - [ "select checksum from " <> Query (optTableName opts) <> " " + [ "select checksum from ? " , "where filename = ? limit 1" ] @@ -373,6 +375,11 @@ defaultOptions = , optTransactionControl = TransactionPerRun } +-- Wrap the name of the table that stores migrations into Identifier, +-- to ensure it's properly escaped (prevent SQL injection via optTableName) +migrationsTableName :: MigrationOptions -> Identifier +migrationsTableName = fromString . BS8.unpack . optTableName + verbose :: MigrationOptions -> Bool verbose o = optVerbose o == Verbose diff --git a/stack.yaml b/stack.yaml index 8ed3709..9bd35a6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,7 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-20.21 +resolver: lts-20.26 # User packages to be built. # Various formats can be used as shown in the example below. diff --git a/stack.yaml.lock b/stack.yaml.lock index ae3d6f5..ea5a850 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -6,7 +6,7 @@ packages: [] snapshots: - completed: - sha256: 401a0e813162ba62f04517f60c7d25e93a0f867f94a902421ebf07d1fb5a8c46 - size: 650044 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/21.yaml - original: lts-20.21 + sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2 + size: 650475 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/26.yaml + original: lts-20.26 diff --git a/test/Database/PostgreSQL/Simple/TransactionPerStepTest.hs b/test/Database/PostgreSQL/Simple/TransactionPerStepTest.hs index 84a70df..1a95b55 100644 --- a/test/Database/PostgreSQL/Simple/TransactionPerStepTest.hs +++ b/test/Database/PostgreSQL/Simple/TransactionPerStepTest.hs @@ -13,6 +13,7 @@ module Database.PostgreSQL.Simple.TransactionPerStepTest where +import Data.Foldable (traverse_) import Database.PostgreSQL.Simple (Connection, execute_) import Database.PostgreSQL.Simple.Migration (MigrationCommand (..), MigrationOptions (..), @@ -22,7 +23,7 @@ import Database.PostgreSQL.Simple.Migration (MigrationCommand (..), runMigrations, defaultOptions) import Database.PostgreSQL.Simple.Util (existsTable) -import Test.Hspec (Spec, describe, it, shouldBe, shouldThrow, anyException, afterAll_) +import Test.Hspec (Spec, describe, it, shouldBe, shouldThrow, shouldReturn, anyException, afterAll_) migrationSpec :: Connection -> Spec migrationSpec con = afterAll_ cleanup $ describe "Migrations" $ do @@ -61,15 +62,19 @@ migrationSpec con = afterAll_ cleanup $ describe "Migrations" $ do r <- existsTable con "trn2" r `shouldBe` True + it "does not allow SQL injection via table name option" $ do + let opts = defaultOptions{optTableName = "tricked_you (gotcha int); --"} + runMigrations con opts [MigrationInitialization] `shouldReturn` MigrationSuccess + existsTable con "tricked_you" `shouldReturn` False + existsTable con "tricked_you (gotcha int); --" `shouldReturn` True where runMigration' = runMigration con defaultOptions{optTransactionControl = NoNewTransaction} - -- Cleanup - cleanup = do - _ <- execute_ con "drop table if exists trn2" - _ <- execute_ con "drop table if exists schema_migrations" - pure () - - + cleanup = + traverse_ (execute_ con) + [ "drop table if exists trn2" + , "drop table if exists schema_migrations" + , "drop table if exists \"tricked_you (gotcha int); --\"" + ]