{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
-- |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.Catch (MonadMask)
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Trans.Control (MonadBaseControl)
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
  { ConnInfo -> Text
connHost     :: Text
  -- ^Hostname or IP address of the PostgreSQL server.
  , ConnInfo -> Word16
connPort     :: Word16
  -- ^Port number the PostgreSQL server is running on (usually @5432@).
  , ConnInfo -> Text
connUser     :: Text
  -- ^What user to connect to the database as.
  , ConnInfo -> Text
connPassword :: Text
  -- ^What password to connect to the database with.
  , ConnInfo -> Text
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 -> [(ByteString, ByteString)]
commonParams (ConnInfo {Word16
Text
connDbName :: Text
connPassword :: Text
connUser :: Text
connPort :: Word16
connHost :: Text
connDbName :: ConnInfo -> Text
connPassword :: ConnInfo -> Text
connUser :: ConnInfo -> Text
connPort :: ConnInfo -> Word16
connHost :: ConnInfo -> Text
..}) =
  [ (ByteString
"host",   forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connHost)
  , (ByteString
"port",   forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => a -> Text
tshow forall a b. (a -> b) -> a -> b
$ Word16
connPort)
  , (ByteString
"user",   forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connUser)
  , (ByteString
"dbname", forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connDbName)
  ]

-- |Given a list of key/value pairs, make up a @key1=value1 key2=value2@ string that PostgreSQL expects.
asConnString :: [(ByteString, ByteString)] -> ByteString
asConnString :: [(ByteString, ByteString)] -> ByteString
asConnString = ByteString -> [ByteString] -> ByteString
BSC8.intercalate ByteString
" " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\ (ByteString
key, ByteString
val) -> ByteString
key forall a. Semigroup a => a -> a -> a
<> ByteString
"=" forall a. Semigroup a => a -> a -> a
<> ByteString
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 -> ByteString
connInfoAsConnString connInfo :: ConnInfo
connInfo@(ConnInfo { Text
connPassword :: Text
connPassword :: ConnInfo -> Text
connPassword }) =
  [(ByteString, ByteString)] -> ByteString
asConnString ((ByteString
"password", forall textual binary. Utf8 textual binary => textual -> binary
encodeUtf8 Text
connPassword) forall a. a -> [a] -> [a]
: ConnInfo -> [(ByteString, ByteString)]
commonParams ConnInfo
connInfo)

-- |Given a 'ConnInfo' make up the log-safe connection string to show to humans, which omits the password.
connInfoAsLogString :: ConnInfo -> Text
connInfoAsLogString :: ConnInfo -> Text
connInfoAsLogString =
  forall textual binary. Utf8 textual binary => binary -> textual
decodeUtf8 forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [(ByteString, ByteString)] -> ByteString
asConnString forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ConnInfo -> [(ByteString, ByteString)]
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 (MigrationType -> MigrationType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrationType -> MigrationType -> Bool
$c/= :: MigrationType -> MigrationType -> Bool
== :: MigrationType -> MigrationType -> Bool
$c== :: MigrationType -> MigrationType -> Bool
Eq, Int -> MigrationType -> ShowS
[MigrationType] -> ShowS
MigrationType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrationType] -> ShowS
$cshowList :: [MigrationType] -> ShowS
show :: MigrationType -> String
$cshow :: MigrationType -> String
showsPrec :: Int -> MigrationType -> ShowS
$cshowsPrec :: Int -> MigrationType -> ShowS
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
  { Migration -> Text
_migrationSchema  :: Text
  -- ^Schema for the migration to run in, which also qualifies the migration key."
  , Migration -> Text
_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.
  , Migration -> MigrationType
_migrationType    :: MigrationType
  -- ^What type of migration this is.
  , Migration -> forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck   :: forall m. MonadMigration m => Maybe (m ())
  -- ^Optional action to execute before the primary execution to verify preconditions.
  , Migration -> forall (m :: * -> *). MonadMigration m => m ()
_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 -> Text
migrationQualifiedKey (Migration { Text
_migrationSchema :: Text
_migrationSchema :: Migration -> Text
_migrationSchema, Text
_migrationKey :: Text
_migrationKey :: Migration -> Text
_migrationKey }) =
  Text
_migrationSchema forall a. Semigroup a => a -> a -> a
<> Text
"." forall a. Semigroup a => a -> a -> a
<> Text
_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 :: Text
-> Text
-> (forall (m :: * -> *). MonadMigration m => m ())
-> Migration
schemaMigration Text
schema Text
key forall (m :: * -> *). MonadMigration m => m ()
execute = Migration
  { _migrationSchema :: Text
_migrationSchema  = Text
schema
  , _migrationKey :: Text
_migrationKey     = Text
key
  , _migrationType :: MigrationType
_migrationType    = MigrationType
MigrationSchema
  , _migrationCheck :: forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck   = forall a. Maybe a
Nothing
  , _migrationExecute :: forall (m :: * -> *). MonadMigration m => m ()
_migrationExecute = forall (m :: * -> *). MonadMigration m => m ()
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 :: Text
-> Text
-> (forall (m :: * -> *). MonadMigration m => m ())
-> Migration
seedDataMigration Text
schema Text
key forall (m :: * -> *). MonadMigration m => m ()
execute = Migration
  { _migrationSchema :: Text
_migrationSchema  = Text
schema
  , _migrationKey :: Text
_migrationKey     = Text
key
  , _migrationType :: MigrationType
_migrationType    = MigrationType
MigrationSeedData
  , _migrationCheck :: forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck   = forall a. Maybe a
Nothing
  , _migrationExecute :: forall (m :: * -> *). MonadMigration m => m ()
_migrationExecute = forall (m :: * -> *). MonadMigration m => m ()
execute
  }

-- |Attach a check function to a 'Migration'.
withCheck :: Migration -> (forall m. MonadMigration m => m ()) -> Migration
withCheck :: Migration
-> (forall (m :: * -> *). MonadMigration m => m ()) -> Migration
withCheck Migration
m forall (m :: * -> *). MonadMigration m => m ()
c = Migration
m { _migrationCheck :: forall (m :: * -> *). MonadMigration m => Maybe (m ())
_migrationCheck = forall a. a -> Maybe a
Just forall (m :: * -> *). MonadMigration m => m ()
c }