packages feed

moto-postgresql 0.0.1 → 0.0.2

raw patch · 5 files changed

+99/−18 lines, 5 filesdep +df1dep +di-df1dep +textsetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: df1, di-df1, text

API changes (from Hackage documentation)

- Moto.PostgreSQL: withRegistry :: (MonadIO m, MonadMask m) => ByteString -> (Registry -> m a) -> m a
+ Moto.PostgreSQL: instance GHC.Classes.Eq Moto.PostgreSQL.ConnectionURI
+ Moto.PostgreSQL: instance GHC.Exception.Type.Exception Moto.PostgreSQL.Err_PgEnvVar
+ Moto.PostgreSQL: instance GHC.Show.Show Moto.PostgreSQL.ConnectionURI
+ Moto.PostgreSQL: instance GHC.Show.Show Moto.PostgreSQL.Err_PgEnvVar

Files

+ CHANGELOG.md view
@@ -0,0 +1,10 @@+# Version 0.0.2++* Unexported `Moto.PostgreSQL.withRegistry`. See issue #19.++* Made compatible with `di-df1` version `1.2`.+++# Version 0.0.1++* Initial version.
+ README.md view
@@ -0,0 +1,5 @@+moto-postgresql+===============++This library provides a PostgreSQL-based migrations registry for the+`moto` migrations library.
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
lib/Moto/PostgreSQL.hs view
@@ -4,28 +4,37 @@  module Moto.PostgreSQL   ( registryConf-  , withRegistry   ) where  import qualified Control.Exception.Safe as Ex import Control.Monad.IO.Class (MonadIO, liftIO) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as B8-import Data.Foldable (foldlM)+import Data.Foldable (foldlM, for_) import qualified Data.List as List+import qualified Data.Text as T+import qualified Data.Text.Encoding as T import qualified Database.PostgreSQL.Simple as Pg import qualified Database.PostgreSQL.Simple.FromRow as Pg import qualified Database.PostgreSQL.Simple.FromField as Pg import qualified Database.PostgreSQL.Simple.ToRow as Pg import qualified Database.PostgreSQL.Simple.ToField as Pg import qualified Database.PostgreSQL.Simple.Types as Pg+import qualified Di.Df1 as Di import qualified Moto import qualified Moto.Registry as Moto+import qualified System.Environment as IO  -------------------------------------------------------------------------------- +-- | PostgreSQL connection URI.+--+-- See https://www.postgresql.org/docs/current/static/libpq-connect.html#LIBPQ-CONNSTRING+newtype ConnectionURI = ConnectionURI B.ByteString+  deriving (Eq, Show)+ -- | Command-line configuration for a 'Moto.Registry' stored in an append-only--- table in a PostgreSQL database, as supported by 'withRegistry'.+-- table in a PostgreSQL database. -- -- The table name shall be @registry@, inside a schema named @moto@. registryConf :: Moto.RegistryConf@@ -33,11 +42,7 @@   { Moto.registryConf_help =       "URI to the database where registry is stored. \       \See https://www.postgresql.org/docs/current/static/libpq-connect.html#LIBPQ-CONNSTRING"-  , Moto.registryConf_parse = \s -> do-      case any (flip List.isPrefixOf s) ["postgres://", "postgresql://"] of-        False -> Left "Registry URI should start with 'postgresql://' \-                      \or 'postgres://'"-        True -> Right (B8.pack s)+  , Moto.registryConf_parse = Right . ConnectionURI . T.encodeUtf8 . T.pack   , Moto.registryConf_with = withRegistry   } @@ -47,14 +52,21 @@ -- The table name shall be @registry@, inside a schema named @moto@. withRegistry   :: (MonadIO m, Ex.MonadMask m)-  => B.ByteString-  -- ^ PostgreSQL [connection string](https://www.postgresql.org/docs/current/static/libpq-connect.html#LIBPQ-CONNSTRING).+  => Di.Df1+  -> ConnectionURI   -> (Moto.Registry -> m a)   -> m a-withRegistry cs k = Ex.bracket-  (liftIO (Pg.connectPostgreSQL cs)) -- TODO don't let env vars affect this-  (liftIO . Pg.close)+withRegistry di0 (ConnectionURI cu) k = Ex.bracket+  (liftIO $ do+     checkPgEnvVars di0+     Di.debug_ di0 "Connecting to PostgreSQL database..."+     Pg.connectPostgreSQL cu)+  (\conn -> liftIO $ do+     Di.debug_ di0 "Closing connection to PostgreSQL database..."+     Pg.close conn)   (\conn -> k =<< liftIO (do+     Di.debug_ di0 "Creating necessary tables, if any, \+                   \and acquiring exclusive registry lock..."      -- Lock to prevent multiple executions of this program to touch the table.      -- Then get our initial state, creating our table if necessary.      logs :: [LogV1] <- Pg.query_ conn@@ -69,6 +81,7 @@         \ , dir text NULL );\         \SET client_min_messages = notice;\n\         \SELECT act, t, mid, dir FROM moto.registry ORDER BY ord ASC;"+     Di.debug_ di0 "Loading state from registry..."      state0 :: Moto.State <- either Ex.throwM pure $ do         foldlM Moto.updateState Moto.emptyState (map unLogV1 logs)      Moto.newAppendOnlyRegistry state0 $ \log_ -> do@@ -120,4 +133,53 @@           Pg.Null <- Pg.field           pure (Moto.Log_Commit t)       s -> fail ("bad action: " ++ show (s :: String))++--------------------------------------------------------------------------------++checkPgEnvVars :: Di.Df1 -> IO ()+checkPgEnvVars di0 = do+  for_ pgEnvVars $ \(ne, ncs) -> do+     yev <- IO.lookupEnv ne+     for_ yev $ \ev -> do+        let ex = Err_PgEnvVar ne ncs+        Di.error di0 (Ex.displayException ex)+        Ex.throwM ex++data Err_PgEnvVar = Err_PgEnvVar String String+  deriving (Show)++instance Ex.Exception Err_PgEnvVar where+  displayException (Err_PgEnvVar ne ncs) =+    "Detected '" <> ne <> "' environment variable. We don't like this, we \+    \could be accidentally using another PostgreSQL database configuration. \+    \Please set '" <> ncs <> "' in the connection string instead."++-- | A map from PG* environment variables to their connection string+-- counterpart.+pgEnvVars :: [(String, String)]+pgEnvVars =+  [ ("PGHOST", "host")+  , ("PGHOSTADDR", "hostaddr")+  , ("PGPORT", "port")+  , ("PGDATABASE", "dbname")+  , ("PGUSER", "user")+  , ("PGPASSWORD", "password")+  , ("PGPASSFILE", "passfile")+  , ("PGSERVICE", "service")+  , ("PGOPTIONS", "options")+  , ("PGAPPNAME", "application_name")+  , ("PGSSLMODE", "sslmode")+  , ("PGREQUIRESSL", "requiressl")+  , ("PGSSLCOMPRESSION", "sslcompression")+  , ("PGSSLCERT", "sslcert")+  , ("PGSSLKEY", "sslkey")+  , ("PGSSLROOTCERT", "sslrootcert")+  , ("PGSSLCRL", "sslcrl")+  , ("PGREQUIREPEER", "requirepeer")+  , ("PGKRBSRVNAME", "krbsrvname")+  , ("PGGSSLIB", "gsslib")+  , ("PGCONNECT_TIMEOUT", "connect_timeout")+  , ("PGCLIENTENCODING", "client_encoding")+  , ("PGTARGETSESSIONATTRS", "target_session_attrs")+  ] 
moto-postgresql.cabal view
@@ -1,13 +1,16 @@ name: moto-postgresql-version: 0.0.1+version: 0.0.2 synopsis: PostgreSQL-based migrations registry for moto. license: Apache-2.0 license-file: LICENSE.txt+extra-source-files: README.md CHANGELOG.md author: Renzo Carbonara maintainer: ren@ren!zone category: Database build-type: Simple cabal-version: >=2.0+homepage: https://gitlab.com/k0001/moto+bug-reports: https://gitlab.com/k0001/moto/issues  library   hs-source-dirs: lib@@ -17,6 +20,9 @@   build-depends:       base (>=4.6 && <5.0),       bytestring,-      postgresql-simple,+      df1,+      di-df1,       moto,-      safe-exceptions+      postgresql-simple,+      safe-exceptions,+      text