parse from postgres uri to ConnectionPool config

spago.dhall

@@ -2,40 +2,38 @@
 Welcome to a Spago project!
 You can edit this file as you like.
 -}
-{ name =
-    "postgresql-client"
+{ name = "postgresql-client"
 , license = "BSD-3-Clause"
 , dependencies =
-    [ "aff"
-    , "arrays"
-    , "argonaut"
-    , "assert"
-    , "bifunctors"
-    , "bytestrings"
-    , "console"
-    , "datetime"
-    , "decimals"
-    , "effect"
-    , "either"
-    , "exceptions"
-    , "foldable-traversable"
-    , "foreign"
-    , "foreign-generic"
-    , "foreign-object"
-    , "js-date"
-    , "lists"
-    , "maybe"
-    , "newtype"
-    , "nullable"
-    , "prelude"
-    , "psci-support"
-    , "test-unit"
-    , "transformers"
-    , "tuples"
-    ]
-, packages =
-    ./packages.dhall
+  [ "aff"
+  , "argonaut"
+  , "arrays"
+  , "assert"
+  , "bifunctors"
+  , "bytestrings"
+  , "console"
+  , "datetime"
+  , "decimals"
+  , "effect"
+  , "either"
+  , "exceptions"
+  , "foldable-traversable"
+  , "foreign"
+  , "foreign-generic"
+  , "foreign-object"
+  , "js-date"
+  , "lists"
+  , "maybe"
+  , "newtype"
+  , "nullable"
+  , "prelude"
+  , "psci-support"
+  , "string-parsers"
+  , "test-unit"
+  , "transformers"
+  , "tuples"
+  ]
+, packages = ./packages.dhall
 , repository = "https://github.com/rightfold/purescript-postgresql-client.git"
-, sources =
-    [ "src/**/*.purs", "test/**/*.purs" ]
+, sources = [ "src/**/*.purs", "test/**/*.purs" ]
 }

src/Database/PostgreSQL.purs

@@ -9,11 +9,13 @@ module Database.PostgreSQL
 , Connection
 , ConnectResult
 , Query(..)
+, PgConnectionUri
 , newPool
 , connect
 , withConnection
 , withTransaction
 , defaultPoolConfiguration
+, getDefaultPoolConfigurationByUri
 , command
 , execute
 , query
@@ -28,12 +30,14 @@ import Data.Bifunctor (lmap)
 import Data.Either (Either(..), either, hush)
 import Data.Generic.Rep (class Generic)
 import Data.Generic.Rep.Show (genericShow)
+import Data.Int (fromString)
 import Data.Maybe (Maybe(..), maybe)
 import Data.Newtype (class Newtype)
 import Data.Nullable (Nullable, toMaybe, toNullable)
 import Data.String (Pattern(..))
 import Data.String as String
-import Data.Traversable (traverse)
+import Data.String.CodeUnits (singleton)
+import Data.Traversable (foldMap, traverse)
 import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), Row10(..), Row11(..), Row12(..), Row13(..), Row14(..), Row15(..), Row16(..), Row17(..), Row18(..), Row19(..), Row2(..), Row3(..), Row4(..), Row5(..), Row6(..), Row7(..), Row8(..), Row9(..), fromSQLRow, toSQLRow) as Row
 import Database.PostgreSQL.Row (class FromSQLRow, class ToSQLRow, Row0(..), Row1(..), fromSQLRow, toSQLRow)
 import Database.PostgreSQL.Value (class FromSQLValue)
@@ -44,6 +48,9 @@ import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
 import Effect.Class (liftEffect)
 import Effect.Exception (Error)
 import Foreign (Foreign)
+import Text.Parsing.StringParser (runParser)
+import Text.Parsing.StringParser.CodePoints (anyChar, char, string)
+import Text.Parsing.StringParser.Combinators (many, manyTill)
 
 type Database = String
 
@@ -69,6 +76,27 @@ defaultPoolConfiguration database =
     , user: Nothing
     }
 
+type PgConnectionUri = String
+
+-- | Get the default pool configuration from postgres connection uri
+getDefaultPoolConfigurationByUri :: PgConnectionUri -> Maybe PoolConfiguration
+getDefaultPoolConfigurationByUri uri = hush $ flip runParser uri do
+  _ <- string "postgres://"
+  user <- tillChar (char ':')
+  password <- tillChar (char '@')
+  host <- tillChar (char ':')
+  port <- tillChar (char '/')
+  database <- many anyChar
+  pure { database: toStr database
+       , host: Just $ toStr host
+       , idleTimeoutMillis: Nothing
+       , max: Nothing
+       , password: Just $ toStr password
+       , port: fromString $ toStr port
+       , user: Just $ toStr user }
+  where tillChar = manyTill anyChar
+        toStr = foldMap singleton
+
 -- | PostgreSQL connection pool.
 foreign import data Pool :: Type
 

test/Main.purs

@@ -22,13 +22,14 @@ import Data.Maybe (Maybe(..), fromJust)
 import Data.Newtype (unwrap)
 import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested ((/\))
+import Database.PostgreSQL (PgConnectionUri, getDefaultPoolConfigurationByUri)
 import Database.PostgreSQL.PG (Connection, PGError(..), Pool, PoolConfiguration, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), command, execute, newPool, onIntegrityError, query, scalar)
 import Effect (Effect)
 import Effect.Aff (Aff, error, launchAff)
 import Effect.Class (liftEffect)
 import Effect.Exception (message)
-import Foreign.Object (fromFoldable) as Object
 import Foreign.Object (Object)
+import Foreign.Object (fromFoldable) as Object
 import Global.Unsafe (unsafeStringify)
 import Math ((%))
 import Partial.Unsafe (unsafePartial)
@@ -357,6 +358,11 @@ main = do
               Left (ProgrammingError { code, message }) -> equal code "3D000"
               _ -> Test.Unit.failure "PostgreSQL error was expected"
 
+          Test.Unit.test "get pool configuration from postgres uri" do
+            equal (getDefaultPoolConfigurationByUri validUriToPoolConfigs.uri) (Just validUriToPoolConfigs.poolConfig)
+            equal (getDefaultPoolConfigurationByUri notValidConnUri) Nothing
+
+
 config :: PoolConfiguration
 config =
   { user: Nothing
@@ -375,3 +381,18 @@ noSuchDatabaseConfig =
 cannotConnectConfig :: PoolConfiguration
 cannotConnectConfig =
   config { host = Just "127.0.0.1", port = Just 45287 }
+
+validUriToPoolConfigs :: { uri :: PgConnectionUri, poolConfig :: PoolConfiguration }
+validUriToPoolConfigs = {
+  uri: "postgres://urllgqrivcyako:c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"
+  , poolConfig: { database: "e7cecg4nirunpo"
+                , host: Just "ec2-79-124-25-231.eu-west-1.compute.amazonaws.com"
+                , idleTimeoutMillis: Nothing
+                , max: Nothing
+                , password: Just "c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969"
+                , port: Just 5432
+                , user: Just "urllgqrivcyako" }
+  }
+
+notValidConnUri :: PgConnectionUri
+notValidConnUri = "postgres://urllgqrivcyakoc52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"