module Data.CQRS.PostgreSQL.Internal.Migration
( applyMigrations
, uuid
) where
import Control.Monad (forM_, (>=>))
import Data.ByteString (ByteString)
import Data.CQRS.PostgreSQL.Internal.Utils (badQueryResultMsg, execSql, ioQuery, withTransaction, SqlValue(..))
import Data.UUID.Types (UUID)
import qualified Data.UUID.Types as U
import Data.Text.Encoding (decodeUtf8)
import Database.PostgreSQL.LibPQ (Connection)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.Combinators as SC
uuid :: ByteString -> UUID
uuid s =
case U.fromASCIIBytes s of
Nothing -> error $ "Invalid UUID string: " ++ show s
Just u -> u
applyMigrations :: Connection -> [(UUID, ByteString)] -> IO ()
applyMigrations c migrations = do
withTransaction c $ execSql c sqlCreateChangeSetTbl [ ]
forM_ migrations $ \(changeSetId, sql) -> do
let changeSetIdSql = SqlUUID $ Just changeSetId
let sqlText = decodeUtf8 sql
withTransaction c $ do
existingChangeSet <- ioQuery c sqlFindChangeSet [ changeSetIdSql ] $
SC.map (unpackChangeSet changeSetId) >=> Streams.read
case existingChangeSet of
Just (_, sqlText') | sqlText == sqlText' ->
return ()
Just _ ->
error $ "Migration error: Changeset SQL modified: UUID " ++ show changeSetId
Nothing -> do
execSql c sqlInsertChangeSet [ changeSetIdSql, SqlText $ Just sqlText ]
execSql c sql [ ]
where
unpackChangeSet _ [ SqlUUID (Just changeSetId), SqlText (Just sqlText) ] = (changeSetId, sqlText)
unpackChangeSet changeSetId columns = error $ badQueryResultMsg [show changeSetId] columns
sqlCreateChangeSetTbl =
"CREATE TABLE IF NOT EXISTS changeset ( \
\ changeset_id UUID PRIMARY KEY, \
\ sql TEXT NOT NULL \
\)"
sqlFindChangeSet =
"SELECT changeset_id, sql FROM changeset \
\ WHERE changeset_id = $1"
sqlInsertChangeSet =
"INSERT INTO changeset (changeset_id, sql) \
\ VALUES ($1, $2)"