-- |Module containing externally useful types for Refurb, most notably the 'Migration' type. module Refurb.Types ( ConnInfo(..) , connInfoAsConnString, connInfoAsLogString , MigrationType(..) , MonadMigration , Migration(..), migrationSchema, migrationKey, migrationType, migrationCheck, migrationExecute, migrationQualifiedKey , schemaMigration, seedDataMigration, withCheck ) where import ClassyPrelude import Control.Lens.TH (makeLenses) import Control.Monad.Logger (MonadLogger) import qualified Data.ByteString.Char8 as BSC8 import Data.Word (Word16) import qualified Database.PostgreSQL.Simple as PG -- |Structure with connection information for connecting to the database. data ConnInfo = ConnInfo { connHost :: Text -- ^Hostname or IP address of the PostgreSQL server. , connPort :: Word16 -- ^Port number the PostgreSQL server is running on (usually @5432@). , connUser :: Text -- ^What user to connect to the database as. , connPassword :: Text -- ^What password to connect to the database with. , connDbName :: Text -- ^What database in the PostgreSQL server to attach to. } -- |Given a 'ConnInfo' generate the connection string pairs that are shared between the loggable and real version, that is all of them except password. commonParams :: ConnInfo -> [(ByteString, ByteString)] commonParams (ConnInfo {..}) = [ ("host", encodeUtf8 connHost) , ("port", encodeUtf8 . tshow $ connPort) , ("user", encodeUtf8 connUser) , ("dbname", encodeUtf8 connDbName) ] -- |Given a list of key/value pairs, make up a @key1=value1 key2=value2@ string that PostgreSQL expects. asConnString :: [(ByteString, ByteString)] -> ByteString asConnString = BSC8.intercalate " " . map (\ (key, val) -> key <> "=" <> val) -- |Given a 'ConnInfo' make up the real connection string to pass when connecting to the database. Includes password, so never log this. connInfoAsConnString :: ConnInfo -> ByteString connInfoAsConnString connInfo@(ConnInfo { connPassword }) = asConnString (("password", encodeUtf8 connPassword) : commonParams connInfo) -- |Given a 'ConnInfo' make up the log-safe connection string to show to humans, which omits the password. connInfoAsLogString :: ConnInfo -> Text connInfoAsLogString = decodeUtf8 . asConnString . commonParams -- |Enumeration of the types of migration that are known about. data MigrationType = MigrationSchema -- ^Migration that updates the schema of the database and should be run everywhere. | MigrationSeedData -- ^Migration that installs or replaces data for testing purposes and should never be run in production. deriving (Eq, Show) -- |Constraint for actions run in the context of a migration, with access to underlying IO, PostgreSQL connection, and logging. type MonadMigration m = (MonadBaseControl IO m, MonadMask m, MonadReader PG.Connection m, MonadLogger m) -- |Data type of a migration, with its key, type, and actions. data Migration = Migration { _migrationSchema :: Text -- ^Schema for the migration to run in, which also qualifies the migration key." , _migrationKey :: Text -- ^Unique key to identify this migration among all known migrations. Never reuse keys, as they're the only link between the stored migration log and known -- migrations. , _migrationType :: MigrationType -- ^What type of migration this is. , _migrationCheck :: forall m. MonadMigration m => Maybe (m ()) -- ^Optional action to execute before the primary execution to verify preconditions. , _migrationExecute :: forall m. MonadMigration m => m () -- ^Main migration action, such as creating tables or updating data. } -- |The fully qualified key of the migration, schema.key migrationQualifiedKey :: Migration -> Text migrationQualifiedKey (Migration { _migrationSchema, _migrationKey }) = _migrationSchema <> "." <> _migrationKey makeLenses ''Migration -- |Helper to construct a 'MigrationSchema' type 'Migration' with the given execution action and no check action. schemaMigration :: Text -> Text -> (forall m. MonadMigration m => m ()) -> Migration schemaMigration schema key execute = Migration { _migrationSchema = schema , _migrationKey = key , _migrationType = MigrationSchema , _migrationCheck = Nothing , _migrationExecute = execute } -- |Helper to construct a 'MigrationSeedData' type 'Migration' with the given execution action and no check action. seedDataMigration :: Text -> Text -> (forall m. MonadMigration m => m ()) -> Migration seedDataMigration schema key execute = Migration { _migrationSchema = schema , _migrationKey = key , _migrationType = MigrationSeedData , _migrationCheck = Nothing , _migrationExecute = execute } -- |Attach a check function to a 'Migration'. withCheck :: Migration -> (forall m. MonadMigration m => m ()) -> Migration withCheck m c = m { _migrationCheck = Just c }