packages feed

postgresql-connection-string (empty) → 0.1

raw patch · 16 files changed

+1996/−0 lines, 16 filesdep +QuickCheckdep +basedep +bytestring

Dependencies added: QuickCheck, base, bytestring, charset, containers, hashable, hspec, megaparsec, postgresql-connection-string, quickcheck-classes, text, text-builder

Files

+ CHANGELOG.md view
@@ -0,0 +1,42 @@+# 0.1.0.0++Initial release of postgresql-connection-string as a standalone library.++This library was extracted from the hasql project to provide a focused, reusable component for parsing and constructing PostgreSQL connection strings.++## Features++- Parse PostgreSQL connection URIs (`postgresql://` and `postgres://` schemes)+- Parse keyword/value format connection strings+- Construct connection strings programmatically using composable combinators+- Convert between URI and keyword/value formats+- Support for multiple host specifications (for failover/load balancing)+- Automatic percent-encoding/decoding of special characters+- Type-safe representation with `ConnectionString` data type++## API++### Constructors+- `hostAndPort` - Specify a host and optional port+- `user` - Set the username+- `password` - Set the password+- `dbname` - Set the database name+- `param` - Add a connection parameter++### Accessors+- `toHosts` - Get list of hosts and ports+- `toUser` - Get username+- `toPassword` - Get password+- `toDbname` - Get database name+- `toParams` - Get parameter map++### Rendering+- `toUrl` - Convert to URI format+- `toKeyValueString` - Convert to keyword/value format++### Parsing+- `parseText` - Parse from Text with error reporting+- `parserOf` - Get the underlying Megaparsec parser++### Transformations+- `interceptParam` - Extract and remove a parameter
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2025, Nikita Volkov++Permission is hereby granted, free of charge, to any person+obtaining a copy of this software and associated documentation+files (the "Software"), to deal in the Software without+restriction, including without limitation the rights to use,+copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the+Software is furnished to do so, subject to the following+conditions:++The above copyright notice and this permission notice shall be+included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,130 @@+# postgresql-connection-string++[![Hackage](https://img.shields.io/hackage/v/postgresql-connection-string.svg)](https://hackage.haskell.org/package/postgresql-connection-string)+[![Continuous Haddock](https://img.shields.io/badge/haddock-master-blue)](https://nikita-volkov.github.io/postgresql-connection-string/)++A Haskell library for parsing and constructing PostgreSQL connection strings.++## Overview++This library provides a type-safe way to work with PostgreSQL connection strings, supporting both the URI format and the keyword/value format as specified in the [PostgreSQL documentation](https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING).++## Features++- **URI Format Parsing**: Parse `postgresql://` and `postgres://` URIs+- **Keyword/Value Format**: Convert to PostgreSQL's keyword/value connection string format+- **Type-Safe Construction**: Build connection strings using composable constructors+- **Percent-Encoding**: Automatic handling of special characters in connection string components+- **Multiple Hosts**: Support for multiple host specifications (for failover/load balancing)+- **Query Parameters**: Full support for connection parameters as query strings++## Usage++### Parsing Connection Strings++```haskell+import PostgresqlConnectionString++-- Parse a URI format connection string+case parseText "postgresql://user:password@localhost:5432/mydb?application_name=myapp" of+  Left err -> putStrLn $ "Parse error: " <> err+  Right connStr -> do+    print $ toUser connStr        -- Just "user"+    print $ toDbname connStr      -- Just "mydb"+    print $ toHosts connStr       -- [("localhost", Just 5432)]+```++### Constructing Connection Strings++```haskell+import PostgresqlConnectionString++-- Build a connection string using combinators+let connStr = mconcat+      [ user "myuser"+      , password "secret"+      , hostAndPort "localhost" (Just 5432)+      , dbname "mydb"+      , param "application_name" "myapp"+      , param "connect_timeout" "10"+      ]++-- Convert to URI format+print $ toUrl connStr+-- "postgresql://myuser:secret@localhost:5432/mydb?application_name=myapp&connect_timeout=10"++-- Convert to keyword/value format+print $ toKeyValueString connStr+-- "host=localhost port=5432 user=myuser password=secret dbname=mydb application_name=myapp connect_timeout=10"+```++### Multiple Hosts++```haskell+-- Support for multiple hosts (failover/load balancing)+let connStr = mconcat+      [ hostAndPort "host1" (Just 5432)+      , hostAndPort "host2" (Just 5433)+      , dbname "mydb"+      ]++print $ toUrl connStr+-- "postgresql://host1:5432,host2:5433/mydb"+```++### Accessing Components++```haskell+-- Extract individual components+toHosts :: ConnectionString -> [(Text, Maybe Word16)]+toUser :: ConnectionString -> Maybe Text+toPassword :: ConnectionString -> Maybe Text+toDbname :: ConnectionString -> Maybe Text+toParams :: ConnectionString -> Map Text Text+```++### Transforming Connection Strings++```haskell+-- Intercept and remove a parameter+case interceptParam "application_name" connStr of+  Just (value, updatedConnStr) -> +    -- value is the parameter value, updatedConnStr has it removed+    processAppName value+  Nothing -> +    -- Parameter not found+    useDefault+```++## Installation++Add to your `package.yaml` or `.cabal` file:++```yaml+dependencies:+  - postgresql-connection-string+```++Or with cabal:++```cabal+build-depends:+  postgresql-connection-string+```++## Requirements++- GHC 8.10 or later+- Standard Haskell dependencies (see cabal file)++## Related Projects++This library was extracted from the [hasql](https://github.com/nikita-volkov/hasql) project to provide a standalone connection string parser and builder that can be used independently of the full hasql ecosystem.++## License++MIT License - see LICENSE file for details.++## Contributing++Contributions are welcome! Please feel free to submit pull requests or open issues on GitHub.
+ postgresql-connection-string.cabal view
@@ -0,0 +1,165 @@+cabal-version: 3.0+name: postgresql-connection-string+version: 0.1+category: Database, PostgreSQL+synopsis: PostgreSQL connection string type, parser and builder+description:+  A library for parsing and constructing PostgreSQL connection strings (URIs and keyword/value format).++  Supports the full PostgreSQL connection URI format as specified in+  <https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING the PostgreSQL documentation>,+  including:++  * User and password authentication++  * Single and multiple host specifications with optional ports++  * Database name specification++  * Connection parameters as query string++  * Percent-encoding for special characters++  The library provides both parsing (from Text to structured representation) and+  rendering (back to connection string format, either as URI or keyword/value pairs).++homepage: https://github.com/nikita-volkov/postgresql-connection-string+bug-reports: https://github.com/nikita-volkov/postgresql-connection-string/issues+author: Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>+copyright: (c) 2025, Nikita Volkov+license: MIT+license-file: LICENSE+extra-source-files:+  README.md++extra-doc-files:+  CHANGELOG.md++source-repository head+  type: git+  location: https://github.com/nikita-volkov/postgresql-connection-string++common base+  default-language: Haskell2010+  default-extensions:+    ApplicativeDo+    Arrows+    BangPatterns+    BlockArguments+    ConstraintKinds+    DataKinds+    DefaultSignatures+    DeriveAnyClass+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveTraversable+    DerivingVia+    DuplicateRecordFields+    EmptyDataDecls+    FlexibleContexts+    FlexibleInstances+    FunctionalDependencies+    GADTs+    GeneralizedNewtypeDeriving+    LambdaCase+    LiberalTypeSynonyms+    MultiParamTypeClasses+    MultiWayIf+    NamedFieldPuns+    NoImplicitPrelude+    NoMonomorphismRestriction+    NumericUnderscores+    OverloadedStrings+    PatternGuards+    QuasiQuotes+    RankNTypes+    RecordWildCards+    RoleAnnotations+    ScopedTypeVariables+    StandaloneDeriving+    StrictData+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    ViewPatterns++common test+  import: base+  ghc-options:+    -threaded+    -with-rtsopts=-N++library+  import: base+  hs-source-dirs: src/library+  exposed-modules:+    PostgresqlConnectionString++  other-modules:+    PostgresqlConnectionString.Parsers+    PostgresqlConnectionString.Types+    PostgresqlConnectionString.Types.Gens++  build-depends:+    QuickCheck >=2.14 && <2.16,+    charset ^>=0.3.12,+    containers >=0.6 && <0.9,+    megaparsec >=9.2.1 && <10.0,+    postgresql-connection-string:percent-encoding,+    postgresql-connection-string:platform,+    text >=1.2 && <3,+    text-builder >=1 && <1.1,++-- Replacement of the "base" library for all the sublibs here.+-- Covers such things as Prelude and shared utils.+library platform+  import: base+  hs-source-dirs: src/platform+  exposed-modules:+    Platform.Prelude++  build-depends:+    base >=4.13 && <5,+    bytestring >=0.10 && <0.13,+    hashable >=1.2 && <2,+    text >=1.2 && <3,+    text-builder >=1 && <1.1,++library percent-encoding+  import: base+  hs-source-dirs: src/percent-encoding+  exposed-modules:+    PercentEncoding++  other-modules:+    PercentEncoding.Charsets+    PercentEncoding.MonadPlus+    PercentEncoding.Parsers+    PercentEncoding.TextBuilders+    PercentEncoding.Utf8CharView++  build-depends:+    base >=4.13 && <5,+    bytestring >=0.10 && <0.13,+    charset ^>=0.3.12,+    megaparsec >=9.2.1 && <10.0,+    postgresql-connection-string:platform,+    text >=1.2 && <3,+    text-builder >=1 && <1.1,++test-suite library-tests+  import: test+  type: exitcode-stdio-1.0+  hs-source-dirs: src/library-tests+  main-is: Main.hs+  build-depends:+    QuickCheck >=2.14 && <2.16,+    containers >=0.6 && <0.9,+    hspec ^>=2.11.12,+    postgresql-connection-string,+    postgresql-connection-string:platform,+    quickcheck-classes >=0.6.5 && <0.7,+    text >=1.2 && <3,
+ src/library-tests/Main.hs view
@@ -0,0 +1,451 @@+module Main where++import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import Platform.Prelude+import qualified PostgresqlConnectionString as ConnectionString+import Test.Hspec+import Test.QuickCheck+import qualified Test.QuickCheck.Classes as Laws++main :: IO ()+main = hspec do+  describe "ConnectionString" do+    describe "roundtrip property" do+      it "toUrl . parse is identity for valid connection strings" do+        property \connStr ->+          let url = ConnectionString.toUrl connStr+           in case ConnectionString.parse url of+                Left err -> counterexample ("Parse error: " <> Text.unpack err <> "\nURL: " <> Text.unpack url) False+                Right parsed -> parsed === connStr++    describe "toUrl" do+      it "generates valid postgresql:// URLs" do+        property \connStr ->+          let url = ConnectionString.toUrl connStr+              urlStr = Text.unpack url+           in (url `elem` ["postgresql://", "postgres://"] || "postgresql://" `isPrefixOf` urlStr)+                & counterexample ("Generated URL: " <> Text.unpack url)++      it "encodes user correctly" do+        let connStr = ConnectionString.user "myuser"+            url = ConnectionString.toUrl connStr+        url `shouldBe` "postgresql://myuser@"++      it "encodes user and password correctly" do+        let connStr = mconcat [ConnectionString.user "myuser", ConnectionString.password "secret"]+            url = ConnectionString.toUrl connStr+        url `shouldBe` "postgresql://myuser:secret@"++      it "encodes host correctly" do+        let connStr = ConnectionString.host "localhost"+            url = ConnectionString.toUrl connStr+        url `shouldBe` "postgresql://localhost"++      it "encodes host with port correctly" do+        let connStr = ConnectionString.hostAndPort "localhost" 5433+            url = ConnectionString.toUrl connStr+        url `shouldBe` "postgresql://localhost:5433"++      it "encodes multiple hosts correctly" do+        let connStr = mconcat [ConnectionString.hostAndPort "host1" 123, ConnectionString.hostAndPort "host2" 456]+            url = ConnectionString.toUrl connStr+        url `shouldBe` "postgresql://host1:123,host2:456"++      it "encodes database name correctly" do+        let connStr = mconcat [ConnectionString.host "localhost", ConnectionString.dbname "mydb"]+            url = ConnectionString.toUrl connStr+        url `shouldBe` "postgresql://localhost/mydb"++      it "encodes parameters correctly" do+        let connStr = mconcat [ConnectionString.param "key1" "value1", ConnectionString.param "key2" "value2"]+            url = ConnectionString.toUrl connStr+        url `elem` ["postgresql://?key1=value1&key2=value2", "postgresql://?key2=value2&key1=value1"] `shouldBe` True++      it "encodes full connection string correctly" do+        let connStr =+              mconcat+                [ ConnectionString.user "user",+                  ConnectionString.password "secret",+                  ConnectionString.hostAndPort "localhost" 5433,+                  ConnectionString.dbname "mydb",+                  ConnectionString.param "connect_timeout" "10"+                ]+            url = ConnectionString.toUrl connStr+        url `shouldBe` "postgresql://user:secret@localhost:5433/mydb?connect_timeout=10"++    describe "parse" do+      it "parses minimal URL" do+        ConnectionString.parse "postgresql://"+          `shouldBe` Right mempty++      it "parses URL with host" do+        ConnectionString.parse "postgresql://localhost"+          `shouldBe` Right (ConnectionString.host "localhost")++      it "parses URL with host and port" do+        ConnectionString.parse "postgresql://localhost:5433"+          `shouldBe` Right (ConnectionString.hostAndPort "localhost" 5433)++      it "parses URL with host and database" do+        ConnectionString.parse "postgresql://localhost/mydb"+          `shouldBe` Right (mconcat [ConnectionString.host "localhost", ConnectionString.dbname "mydb"])++      it "parses URL with user" do+        ConnectionString.parse "postgresql://user@localhost"+          `shouldBe` Right (mconcat [ConnectionString.user "user", ConnectionString.host "localhost"])++      it "parses URL with user and password" do+        ConnectionString.parse "postgresql://user:secret@localhost"+          `shouldBe` Right (mconcat [ConnectionString.user "user", ConnectionString.password "secret", ConnectionString.host "localhost"])++      it "parses URL with parameters" do+        case ConnectionString.parse "postgresql://localhost?key1=value1&key2=value2" of+          Left err -> expectationFailure (Text.unpack err)+          Right cs ->+            ConnectionString.toParams cs `shouldBe` Map.fromList [("key1", "value1"), ("key2", "value2")]++      it "parses complex URL" do+        ConnectionString.parse "postgresql://user:secret@localhost:5433/mydb?connect_timeout=10&application_name=myapp"+          `shouldSatisfy` isRight++      it "parses URL with multiple hosts" do+        case ConnectionString.parse "postgresql://host1:123,host2:456/mydb" of+          Left err -> expectationFailure (Text.unpack err)+          Right cs ->+            ConnectionString.toHosts cs `shouldBe` [("host1", Just 123), ("host2", Just 456)]++    describe "Laws" do+      laws (Laws.semigroupLaws (Proxy @ConnectionString.ConnectionString))+      laws (Laws.monoidLaws (Proxy @ConnectionString.ConnectionString))++    describe "toKeyValueString" do+      it "generates minimal connection string" do+        let connStr = mempty+        ConnectionString.toKeyValueString connStr `shouldBe` ""++      it "encodes host correctly" do+        let connStr = ConnectionString.host "localhost"+        ConnectionString.toKeyValueString connStr `shouldBe` "host=localhost"++      it "encodes host with port correctly" do+        let connStr = ConnectionString.hostAndPort "localhost" 5433+        ConnectionString.toKeyValueString connStr `shouldBe` "host=localhost port=5433"++      it "encodes user correctly" do+        let connStr = ConnectionString.user "myuser"+        ConnectionString.toKeyValueString connStr `shouldBe` "user=myuser"++      it "encodes password correctly" do+        let connStr = ConnectionString.password "secret"+        ConnectionString.toKeyValueString connStr `shouldBe` "password=secret"++      it "encodes database name correctly" do+        let connStr = ConnectionString.dbname "mydb"+        ConnectionString.toKeyValueString connStr `shouldBe` "dbname=mydb"++      it "encodes parameters correctly" do+        let connStr = ConnectionString.param "connect_timeout" "10"+        ConnectionString.toKeyValueString connStr `shouldBe` "connect_timeout=10"++      it "encodes full connection string correctly" do+        let connStr =+              mconcat+                [ ConnectionString.hostAndPort "localhost" 5433,+                  ConnectionString.user "user",+                  ConnectionString.password "secret",+                  ConnectionString.dbname "mydb",+                  ConnectionString.param "connect_timeout" "10"+                ]+            result = ConnectionString.toKeyValueString connStr+        result `shouldBe` "host=localhost port=5433 user=user password=secret dbname=mydb connect_timeout=10"++      it "quotes values with spaces" do+        let connStr = ConnectionString.param "application_name" "my app"+        ConnectionString.toKeyValueString connStr `shouldBe` "application_name='my app'"++      it "quotes empty values" do+        let connStr = ConnectionString.user ""+        ConnectionString.toKeyValueString connStr `shouldBe` "user=''"++      it "escapes single quotes in values" do+        let connStr = ConnectionString.password "it's secret"+        ConnectionString.toKeyValueString connStr `shouldBe` "password='it\\'s secret'"++      it "escapes backslashes in values" do+        let connStr = ConnectionString.password "path\\to\\secret"+        ConnectionString.toKeyValueString connStr `shouldBe` "password='path\\\\to\\\\secret'"++      it "quotes values with equals signs" do+        let connStr = ConnectionString.param "options" "--key=value"+        ConnectionString.toKeyValueString connStr `shouldBe` "options='--key=value'"++      it "handles multiple parameters in stable order" do+        let connStr = mconcat [ConnectionString.param "key1" "value1", ConnectionString.param "key2" "value2"]+            result = ConnectionString.toKeyValueString connStr+        -- Map.toList should give us a consistent order+        result `elem` ["key1=value1 key2=value2", "key2=value2 key1=value1"] `shouldBe` True++      it "handles complex escaping scenarios" do+        let connStr = ConnectionString.password "a\\b'c d=e"+            result = ConnectionString.toKeyValueString connStr+        result `shouldBe` "password='a\\\\b\\'c d=e'"++      it "only includes first host (keyword/value format limitation)" do+        let connStr = mconcat [ConnectionString.hostAndPort "host1" 123, ConnectionString.hostAndPort "host2" 456]+            result = ConnectionString.toKeyValueString connStr+        result `shouldBe` "host=host1 port=123"++    describe "toKeyValueString roundtrip" do+      it "parse . toKeyValueString is identity for simple connection strings" do+        let connStr = mconcat [ConnectionString.hostAndPort "localhost" 5432, ConnectionString.user "user", ConnectionString.dbname "db"]+            kvString = ConnectionString.toKeyValueString connStr+        case ConnectionString.parse kvString of+          Left err -> expectationFailure ("Parse error: " <> Text.unpack err <> "\nKV String: " <> Text.unpack kvString)+          Right parsed -> parsed `shouldBe` connStr++      it "parse . toKeyValueString handles quoted values" do+        let connStr = mconcat [ConnectionString.user "my user", ConnectionString.password "secret"]+            kvString = ConnectionString.toKeyValueString connStr+        case ConnectionString.parse kvString of+          Left err -> expectationFailure ("Parse error: " <> Text.unpack err <> "\nKV String: " <> Text.unpack kvString)+          Right parsed -> parsed `shouldBe` connStr++      it "parse . toKeyValueString handles escaped quotes" do+        let connStr = ConnectionString.password "it's a secret"+            kvString = ConnectionString.toKeyValueString connStr+        case ConnectionString.parse kvString of+          Left err -> expectationFailure ("Parse error: " <> Text.unpack err <> "\nKV String: " <> Text.unpack kvString)+          Right parsed -> parsed `shouldBe` connStr++      it "parse . toKeyValueString handles escaped backslashes" do+        let connStr = ConnectionString.password "path\\to\\file"+            kvString = ConnectionString.toKeyValueString connStr+        case ConnectionString.parse kvString of+          Left err -> expectationFailure ("Parse error: " <> Text.unpack err <> "\nKV String: " <> Text.unpack kvString)+          Right parsed -> parsed `shouldBe` connStr++      it "parse . toKeyValueString handles full connection string" do+        let connStr =+              mconcat+                [ ConnectionString.hostAndPort "localhost" 5433,+                  ConnectionString.user "testuser",+                  ConnectionString.password "secret pass",+                  ConnectionString.dbname "testdb",+                  ConnectionString.param "connect_timeout" "10",+                  ConnectionString.param "application_name" "my app"+                ]+            kvString = ConnectionString.toKeyValueString connStr+        case ConnectionString.parse kvString of+          Left err -> expectationFailure ("Parse error: " <> Text.unpack err <> "\nKV String: " <> Text.unpack kvString)+          Right parsed -> parsed `shouldBe` connStr++      it "property: parse . toKeyValueString roundtrips for single-host connection strings" do+        property \connStr ->+          -- Only test connection strings with at most one host, since keyword/value format+          -- doesn't support multiple hosts. Create a new connection string with only first host.+          let hosts = ConnectionString.toHosts connStr+              user = ConnectionString.toUser connStr+              password = ConnectionString.toPassword connStr+              dbname = ConnectionString.toDbname connStr+              params = ConnectionString.toParams connStr+              singleHost = take 1 hosts+              connStrSingleHost =+                mconcat+                  [ foldMap ConnectionString.user user,+                    foldMap ConnectionString.password password,+                    mconcat (map (\(h, p) -> maybe (ConnectionString.host h) (ConnectionString.hostAndPort h) p) singleHost),+                    foldMap ConnectionString.dbname dbname,+                    mconcat (map (uncurry ConnectionString.param) (Map.toList params))+                  ]+              kvString = ConnectionString.toKeyValueString connStrSingleHost+              -- Skip empty connection strings as they don't roundtrip+              isEmpty = Text.null kvString+           in not isEmpty ==>+                case ConnectionString.parse kvString of+                  Left err -> counterexample ("Parse error: " <> Text.unpack err <> "\nKV String: " <> Text.unpack kvString) False+                  Right parsed -> parsed === connStrSingleHost++    describe "PostgreSQL documentation examples" do+      describe "parsing and serialization consistency" do+        it "host=localhost port=5432 dbname=mydb connect_timeout=10" do+          let input = "host=localhost port=5432 dbname=mydb connect_timeout=10"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toHosts cs `shouldBe` [("localhost", Just 5432)]+              ConnectionString.toDbname cs `shouldBe` Just "mydb"+              ConnectionString.toParams cs `shouldBe` Map.singleton "connect_timeout" "10"+              -- Roundtrip through URL+              let url = ConnectionString.toUrl cs+              case ConnectionString.parse url of+                Left err -> expectationFailure ("URL roundtrip parse error: " <> Text.unpack err)+                Right cs2 -> cs2 `shouldBe` cs++        it "postgresql://" do+          let input = "postgresql://"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              cs `shouldBe` mempty+              ConnectionString.toUrl cs `shouldBe` "postgresql://"++        it "postgresql://localhost" do+          let input = "postgresql://localhost"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toHosts cs `shouldBe` [("localhost", Nothing)]+              ConnectionString.toUrl cs `shouldBe` "postgresql://localhost"++        it "postgresql://localhost:5433" do+          let input = "postgresql://localhost:5433"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toHosts cs `shouldBe` [("localhost", Just 5433)]+              ConnectionString.toUrl cs `shouldBe` "postgresql://localhost:5433"++        it "postgresql://localhost/mydb" do+          let input = "postgresql://localhost/mydb"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toHosts cs `shouldBe` [("localhost", Nothing)]+              ConnectionString.toDbname cs `shouldBe` Just "mydb"+              ConnectionString.toUrl cs `shouldBe` "postgresql://localhost/mydb"++        it "postgresql://user@localhost" do+          let input = "postgresql://user@localhost"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toUser cs `shouldBe` Just "user"+              ConnectionString.toHosts cs `shouldBe` [("localhost", Nothing)]+              ConnectionString.toUrl cs `shouldBe` "postgresql://user@localhost"++        it "postgresql://user:secret@localhost" do+          let input = "postgresql://user:secret@localhost"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toUser cs `shouldBe` Just "user"+              ConnectionString.toPassword cs `shouldBe` Just "secret"+              ConnectionString.toHosts cs `shouldBe` [("localhost", Nothing)]+              ConnectionString.toUrl cs `shouldBe` "postgresql://user:secret@localhost"++        it "postgresql://other@localhost/otherdb?connect_timeout=10&application_name=myapp" do+          let input = "postgresql://other@localhost/otherdb?connect_timeout=10&application_name=myapp"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toUser cs `shouldBe` Just "other"+              ConnectionString.toHosts cs `shouldBe` [("localhost", Nothing)]+              ConnectionString.toDbname cs `shouldBe` Just "otherdb"+              ConnectionString.toParams cs `shouldBe` Map.fromList [("connect_timeout", "10"), ("application_name", "myapp")]+              -- Roundtrip+              let url = ConnectionString.toUrl cs+              case ConnectionString.parse url of+                Left err -> expectationFailure ("URL roundtrip parse error: " <> Text.unpack err)+                Right cs2 -> cs2 `shouldBe` cs++        it "postgresql://host1:123,host2:456/somedb?target_session_attrs=any&application_name=myapp" do+          let input = "postgresql://host1:123,host2:456/somedb?target_session_attrs=any&application_name=myapp"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toHosts cs `shouldBe` [("host1", Just 123), ("host2", Just 456)]+              ConnectionString.toDbname cs `shouldBe` Just "somedb"+              ConnectionString.toParams cs `shouldBe` Map.fromList [("target_session_attrs", "any"), ("application_name", "myapp")]+              -- Roundtrip+              let url = ConnectionString.toUrl cs+              case ConnectionString.parse url of+                Left err -> expectationFailure ("URL roundtrip parse error: " <> Text.unpack err)+                Right cs2 -> cs2 `shouldBe` cs++        it "postgresql://user@localhost:5433/mydb?options=-c%20synchronous_commit%3Doff" do+          let input = "postgresql://user@localhost:5433/mydb?options=-c%20synchronous_commit%3Doff"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toUser cs `shouldBe` Just "user"+              ConnectionString.toHosts cs `shouldBe` [("localhost", Just 5433)]+              ConnectionString.toDbname cs `shouldBe` Just "mydb"+              ConnectionString.toParams cs `shouldBe` Map.singleton "options" "-c synchronous_commit=off"+              -- Roundtrip+              let url = ConnectionString.toUrl cs+              case ConnectionString.parse url of+                Left err -> expectationFailure ("URL roundtrip parse error: " <> Text.unpack err)+                Right cs2 -> cs2 `shouldBe` cs++        it "postgresql:///dbname?host=/var/lib/postgresql" do+          let input = "postgresql:///dbname?host=/var/lib/postgresql"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toDbname cs `shouldBe` Just "dbname"+              ConnectionString.toParams cs `shouldBe` Map.singleton "host" "/var/lib/postgresql"+              -- Roundtrip+              let url = ConnectionString.toUrl cs+              case ConnectionString.parse url of+                Left err -> expectationFailure ("URL roundtrip parse error: " <> Text.unpack err)+                Right cs2 -> cs2 `shouldBe` cs++        it "postgresql://%2Fvar%2Flib%2Fpostgresql/dbname" do+          let input = "postgresql://%2Fvar%2Flib%2Fpostgresql/dbname"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              ConnectionString.toHosts cs `shouldBe` [("/var/lib/postgresql", Nothing)]+              ConnectionString.toDbname cs `shouldBe` Just "dbname"+              -- Roundtrip+              let url = ConnectionString.toUrl cs+              case ConnectionString.parse url of+                Left err -> expectationFailure ("URL roundtrip parse error: " <> Text.unpack err)+                Right cs2 -> cs2 `shouldBe` cs++        it "postgresql://host1:1,host2:2,host3:3/" do+          let input = "postgresql://host1:1,host2:2,host3:3/"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              -- Port names should be parsed as text, but will fail to parse as numbers+              -- This is a tricky case - the documentation shows port1, port2, port3 as placeholders+              -- Let's check what we get+              let hosts = ConnectionString.toHosts cs+              length hosts `shouldBe` 3+              -- For now, just verify it parses and roundtrips+              let url = ConnectionString.toUrl cs+              case ConnectionString.parse url of+                Left err -> expectationFailure ("URL roundtrip parse error: " <> Text.unpack err)+                Right cs2 -> cs2 `shouldBe` cs++        it "host=host1,host2,host3 port=1,2,3" do+          let input = "host=host1,host2,host3 port=1,2,3"+          case ConnectionString.parse input of+            Left err -> expectationFailure ("Parse error: " <> Text.unpack err)+            Right cs -> do+              -- In keyword/value format, multiple hosts are separated by commas in the value+              -- This is a special case that may not be supported yet+              -- For now, just verify it parses+              let hosts = ConnectionString.toHosts cs+              length hosts `shouldSatisfy` (> 0)++      describe "equivalence tests" do+        it "postgresql://host1:1,host2:2,host3:3/ is equivalent to host=host1,host2,host3 port=1,2,3" do+          let url = "postgresql://host1:1,host2:2,host3:3/"+              kv = "host=host1,host2,host3 port=1,2,3"+          case (ConnectionString.parse url, ConnectionString.parse kv) of+            (Right cs1, Right cs2) -> do+              -- They should represent the same connection+              -- At minimum, they should have the same number of hosts+              length (ConnectionString.toHosts cs1) `shouldBe` length (ConnectionString.toHosts cs2)+            (Left err, _) -> expectationFailure ("URL parse error: " <> Text.unpack err)+            (_, Left err) -> expectationFailure ("KV parse error: " <> Text.unpack err)++laws :: Laws.Laws -> Spec+laws (Laws.Laws className props) =+  describe className do+    forM_ props \(propName, prop) ->+      it propName do+        property prop
+ src/library/PostgresqlConnectionString.hs view
@@ -0,0 +1,514 @@+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Structured model of PostgreSQL connection string, with a DSL for construction, access, parsing and rendering.+--+-- It supports both the URI format (@postgresql:\/\/@ and @postgres:\/\/@) and the keyword\/value format+-- as specified in the PostgreSQL documentation:+-- <https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING>+--+-- = Usage+--+-- == Parsing Connection Strings+--+-- Parse a connection string from 'Text', validate it and access its components:+--+-- >>> toDbname <$> parse "postgresql://user:password@localhost:5432/mydb"+-- Right (Just "mydb")+--+-- Or use its 'IsString' instance for convenience (ignoring parse errors):+--+-- >>> toDbname "postgresql://user:password@localhost:5432/mydb"+-- Just "mydb"+--+-- == Constructing Connection Strings+--+-- Build connection strings using the 'Semigroup' instance and constructor functions:+--+-- >>> let connStr = mconcat [user "myuser", password "secret", hostAndPort "localhost" 5432, dbname "mydb"]+-- >>> toUrl connStr :: Text+-- "postgresql://myuser:secret@localhost:5432/mydb"+--+-- == Converting Between Formats+--+-- Convert to URI format:+--+-- >>> toUrl "host=localhost port=5432 user=user password=password dbname=mydb"+-- "postgresql://user:password@localhost:5432/mydb"+--+-- Convert to keyword\/value format (for use with libpq's PQconnectdb):+--+-- >>> toKeyValueString "postgresql://user:password@localhost:5432/mydb"+-- "host=localhost port=5432 user=user password=password dbname=mydb"+--+-- Note that these examples use the 'IsString' instance for brevity.+module PostgresqlConnectionString+  ( -- * Data Types+    ConnectionString,++    -- * Parsing+    parse,+    megaparsecOf,++    -- * Rendering+    toUrl,+    toKeyValueString,++    -- * Accessors+    toHosts,+    toUser,+    toPassword,+    toDbname,+    toParams,++    -- * Transformations+    interceptParam,++    -- * Constructors+    host,+    hostAndPort,+    user,+    password,+    dbname,+    param,+  )+where++import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import qualified PercentEncoding+import Platform.Prelude+import qualified PostgresqlConnectionString.Parsers as Parsers+import PostgresqlConnectionString.Types+import qualified Text.Megaparsec as Megaparsec+import qualified TextBuilder++instance IsString ConnectionString where+  fromString =+    either fromError id . parse . fromString+    where+      fromError = const mempty++instance Show ConnectionString where+  showsPrec d = showsPrec d . toUrl++-- * Accessors++-- | Extract the list of hosts and their optional ports from a connection string.+--+-- Each tuple contains a host (domain name or IP address) and an optional port number.+-- If no port is specified, 'Nothing' is returned for that host.+--+-- Examples:+--+-- >>> toHosts (hostAndPort "localhost" 5432)+-- [("localhost", Just 5432)]+--+-- >>> toHosts (mconcat [host "host1", hostAndPort "host2" 5433])+-- [("host1", Nothing), ("host2", Just 5433)]+toHosts :: ConnectionString -> [(Text, Maybe Word16)]+toHosts (ConnectionString _ _ hostspec _ _) =+  map (\(Host host port) -> (host, port)) hostspec++-- | Extract the username from a connection string, if present.+--+-- Examples:+--+-- >>> toUser (user "myuser")+-- Just "myuser"+--+-- >>> toUser mempty+-- Nothing+toUser :: ConnectionString -> Maybe Text+toUser (ConnectionString user _ _ _ _) = user++-- | Extract the password from a connection string, if present.+--+-- Examples:+--+-- >>> toPassword (password "secret")+-- Just "secret"+--+-- >>> toPassword mempty+-- Nothing+toPassword :: ConnectionString -> Maybe Text+toPassword (ConnectionString _ password _ _ _) = password++-- | Extract the database name from a connection string, if present.+--+-- Examples:+--+-- >>> toDbname (dbname "mydb")+-- Just "mydb"+--+-- >>> toDbname mempty+-- Nothing+toDbname :: ConnectionString -> Maybe Text+toDbname (ConnectionString _ _ _ dbname _) = dbname++-- | Extract the connection parameters as a 'Map' of key-value pairs.+--+-- These correspond to the query string parameters in the URI format,+-- or additional connection parameters in the keyword\/value format.+--+-- Examples:+--+-- >>> toParams (param "application_name" "myapp")+-- fromList [("application_name","myapp")]+--+-- >>> toParams (mconcat [param "connect_timeout" "10", param "application_name" "myapp"])+-- fromList [("application_name","myapp"),("connect_timeout","10")]+toParams :: ConnectionString -> Map.Map Text Text+toParams (ConnectionString _ _ _ _ paramspec) = paramspec++-- | Convert a connection string to the PostgreSQL URI format.+--+-- This produces a connection string in the form:+--+-- @+-- postgresql:\/\/[userspec\@][hostspec][\/dbname][?paramspec]+-- @+--+-- where:+--+-- * @userspec@ is @user[:password]@+-- * @hostspec@ is a comma-separated list of @host[:port]@ specifications+-- * @dbname@ is the database name+-- * @paramspec@ is a query string of connection parameters+--+-- All components are percent-encoded as necessary.+--+-- Examples:+--+-- >>> toUrl (mconcat [user "myuser", hostAndPort "localhost" 5432, dbname "mydb"])+-- "postgresql://myuser@localhost:5432/mydb"+--+-- >>> toUrl (mconcat [user "user", password "secret", host "localhost"])+-- "postgresql://user:secret@localhost"+--+-- >>> toUrl (mconcat [hostAndPort "host1" 5432, hostAndPort "host2" 5433, dbname "mydb"])+-- "postgresql://host1:5432,host2:5433/mydb"+toUrl :: ConnectionString -> Text+toUrl = TextBuilder.toText . renderConnectionString+  where+    renderConnectionString (ConnectionString user password hostspec dbname paramspec) =+      -- postgresql://[userspec@][hostspec][/dbname][?paramspec]+      mconcat+        [ "postgresql://",+          renderUserspec user password,+          TextBuilder.intercalateMap "," renderHost hostspec,+          foldMap (mappend "/" . PercentEncoding.encodeText) dbname,+          renderParamspec paramspec+        ]++    renderUserspec user password =+      case user of+        Nothing -> mempty+        Just user ->+          mconcat+            [ PercentEncoding.encodeText user,+              foldMap (mappend ":" . PercentEncoding.encodeText) password,+              "@"+            ]++    renderHost (Host host port) =+      mconcat+        [ PercentEncoding.encodeText host,+          foldMap renderPort port+        ]++    renderPort port =+      mconcat+        [ ":",+          TextBuilder.decimal port+        ]++    renderParamspec paramspec =+      case Map.toList paramspec of+        [] -> mempty+        list ->+          mconcat+            [ "?",+              TextBuilder.intercalateMap "&" renderParam list+            ]++    renderParam (key, value) =+      mconcat+        [ PercentEncoding.encodeText key,+          "=",+          PercentEncoding.encodeText value+        ]++-- | Convert a connection string to the PostgreSQL keyword/value format.+--+-- The keyword/value format is a space-separated list of key=value pairs.+-- Values containing spaces, quotes, backslashes, or equals signs are automatically+-- quoted with single quotes, and backslashes and single quotes within values are+-- escaped with backslashes.+--+-- Note: Only the first host from the hostspec is included, as the keyword/value+-- format does not support multiple hosts in the same way as the URI format.+--+-- Examples:+--+-- >>> toKeyValueString (mconcat [hostAndPort "localhost" 5432, user "postgres"])+-- "host=localhost port=5432 user=postgres"+--+-- >>> toKeyValueString (password "secret pass")+-- "password='secret pass'"+--+-- >>> toKeyValueString (password "it's a secret")+-- "password='it\\'s a secret'"+toKeyValueString :: ConnectionString -> Text+toKeyValueString (ConnectionString user password hostspec dbname paramspec) =+  (TextBuilder.toText . TextBuilder.intercalateMap " " id)+    ( catMaybes+        [ fmap (\h -> renderKeyValue "host" (renderHostForKeyValue h)) (listToMaybe hostspec),+          fmap (\p -> renderKeyValue "port" (TextBuilder.decimal p)) (listToMaybe hostspec >>= \(Host _ p) -> p),+          fmap (renderKeyValue "user" . TextBuilder.text) user,+          fmap (renderKeyValue "password" . TextBuilder.text) password,+          fmap (renderKeyValue "dbname" . TextBuilder.text) dbname+        ]+        <> map (\(k, v) -> renderKeyValue k (TextBuilder.text v)) (Map.toList paramspec)+    )+  where+    renderHostForKeyValue (Host host _) = TextBuilder.text host++    renderKeyValue key value =+      mconcat+        [ TextBuilder.text key,+          "=",+          escapeValue value+        ]++    -- Escape values according to the keyword/value format rules+    escapeValue :: TextBuilder -> TextBuilder+    escapeValue valueBuilder =+      let value = TextBuilder.toText valueBuilder+       in if needsQuoting value+            then mconcat ["'", TextBuilder.text (escapeForQuoted value), "'"]+            else TextBuilder.text value++    -- Check if a value needs quoting+    needsQuoting :: Text -> Bool+    needsQuoting value =+      Text.null value+        || Text.any (\c -> c == ' ' || c == '\'' || c == '\\' || c == '=') value++    -- Escape backslashes and single quotes for quoted values+    escapeForQuoted :: Text -> Text+    escapeForQuoted = Text.concatMap escapeChar+      where+        escapeChar '\\' = "\\\\"+        escapeChar '\'' = "\\'"+        escapeChar c = Text.singleton c++-- * Transformations++-- | Extract a parameter by key and remove it from the connection string.+--+-- If the parameter is found, returns 'Just' with a tuple of the parameter's value+-- and the updated connection string (with the parameter removed).+-- If the parameter is not found, returns 'Nothing'.+--+-- This is useful for extracting connection parameters that need special handling+-- before passing the connection string to PostgreSQL.+--+-- Examples:+--+-- >>> let connStr = mconcat [param "application_name" "myapp", param "connect_timeout" "10"]+-- >>> interceptParam "application_name" connStr+-- Just ("myapp", "postgresql://?connect_timeout=10")+--+-- >>> interceptParam "nonexistent" connStr+-- Nothing+interceptParam ::+  -- | The key of the parameter to intercept.+  Text ->+  ConnectionString ->+  Maybe (Text, ConnectionString)+interceptParam key (ConnectionString user password hostspec dbname paramspec) =+  let (foundValue, updatedParamspec) =+        Map.alterF+          ( \case+              Just value -> (Just value, Nothing)+              Nothing -> (Nothing, Nothing)+          )+          key+          paramspec+   in do+        value <- foundValue+        pure (value, ConnectionString user password hostspec dbname updatedParamspec)++-- * Parsing++-- | Parse a connection string from 'Text'.+--+-- Supports both URI format and keyword\/value format connection strings:+--+-- URI format examples:+--+-- >>> parse "postgresql://localhost"+-- Right ...+--+-- >>> parse "postgresql://user:password@localhost:5432/mydb"+-- Right ...+--+-- >>> parse "postgres://host1:5432,host2:5433/mydb?connect_timeout=10"+-- Right ...+--+-- Keyword\/value format examples:+--+-- >>> parse "host=localhost port=5432 user=postgres"+-- Right ...+--+-- >>> parse "host=localhost dbname=mydb"+-- Right ...+--+-- Returns 'Left' with an error message if parsing fails:+--+-- >>> parse "invalid://connection"+-- Left "parse error message"+parse :: Text -> Either Text ConnectionString+parse input =+  Megaparsec.parse megaparsecOf "" input+    & first (fromString . Megaparsec.errorBundlePretty)++-- | Get the Megaparsec parser of connection strings.+--+-- This allows you to use the connection string parser as part of a larger+-- Megaparsec parser combinator setup.+--+-- The parser accepts both URI format (@postgresql:\/\/@ or @postgres:\/\/@)+-- and keyword\/value format connection strings.+megaparsecOf :: Megaparsec.Parsec Void Text ConnectionString+megaparsecOf = Parsers.getConnectionString++-- * Constructors++-- | Create a connection string with a single host and without specifying a port.+--+-- Multiple hosts can be specified by combining multiple 'host' or 'hostAndPort' values+-- using the 'Semigroup' instance.+--+-- When you need to specify a port, use 'hostAndPort' instead.+host :: Text -> ConnectionString+host hostname =+  ConnectionString+    Nothing+    Nothing+    [Host hostname Nothing]+    Nothing+    Map.empty++-- | Create a connection string with a single host and port.+--+-- Multiple hosts can be specified by combining multiple 'hostAndPort' or 'host' values+-- using the 'Semigroup' instance.+--+-- Examples:+--+-- >>> toUrl (host "localhost")+-- "postgresql://localhost"+--+-- >>> toUrl (hostAndPort "localhost" 5432)+-- "postgresql://localhost:5432"+--+-- >>> toUrl (mconcat [hostAndPort "host1" 5432, hostAndPort "host2" 5433])+-- "postgresql://host1:5432,host2:5433"+hostAndPort :: Text -> Word16 -> ConnectionString+hostAndPort host port =+  ConnectionString+    Nothing+    Nothing+    [Host host (Just port)]+    Nothing+    Map.empty++-- | Create a connection string with a username.+--+-- Examples:+--+-- >>> toUrl (user "myuser")+-- "postgresql://myuser@"+--+-- >>> toUrl (mconcat [user "myuser", host "localhost"])+-- "postgresql://myuser@localhost"+user :: Text -> ConnectionString+user username =+  ConnectionString+    (Just username)+    Nothing+    []+    Nothing+    Map.empty++-- | Create a connection string with a password.+--+-- Note: Passwords are typically used together with usernames.+--+-- Examples:+--+-- >>> toUrl (mconcat [user "myuser", password "secret"])+-- "postgresql://myuser:secret@"+--+-- >>> toUrl (mconcat [user "myuser", password "secret", host "localhost"])+-- "postgresql://myuser:secret@localhost"+password :: Text -> ConnectionString+password pwd =+  ConnectionString+    Nothing+    (Just pwd)+    []+    Nothing+    Map.empty++-- | Create a connection string with a database name.+--+-- Examples:+--+-- >>> toUrl (dbname "mydb")+-- "postgresql:///mydb"+--+-- >>> toUrl (mconcat [host "localhost", dbname "mydb"])+-- "postgresql://localhost/mydb"+dbname :: Text -> ConnectionString+dbname db =+  ConnectionString+    Nothing+    Nothing+    []+    (Just db)+    Map.empty++-- | Create a connection string with a single connection parameter.+--+-- Connection parameters are arbitrary key-value pairs that configure+-- the PostgreSQL connection. Common parameters include:+--+-- * @application_name@ - Sets the application name+-- * @connect_timeout@ - Connection timeout in seconds+-- * @options@ - Command-line options for the server+-- * @sslmode@ - SSL mode (@disable@, @require@, @verify-ca@, @verify-full@)+--+-- See the PostgreSQL documentation for a complete list:+-- <https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-PARAMKEYWORDS>+--+-- Examples:+--+-- >>> toUrl (param "application_name" "myapp")+-- "postgresql://?application_name=myapp"+--+-- >>> toUrl (mconcat [host "localhost", param "connect_timeout" "10"])+-- "postgresql://localhost?connect_timeout=10"+--+-- >>> toUrl (mconcat [param "application_name" "myapp", param "connect_timeout" "10"])+-- "postgresql://?application_name=myapp&connect_timeout=10"+param :: Text -> Text -> ConnectionString+param key value =+  ConnectionString+    Nothing+    Nothing+    []+    Nothing+    (Map.singleton key value)
+ src/library/PostgresqlConnectionString/Parsers.hs view
@@ -0,0 +1,243 @@+{-# OPTIONS_GHC -Wno-unused-do-bind #-}++module PostgresqlConnectionString.Parsers where++import qualified Data.CharSet as CharSet+import qualified Data.Map.Strict as Map+import qualified Data.Text as Text+import qualified PercentEncoding+import Platform.Prelude hiding (many, some, try)+import PostgresqlConnectionString.Types+import Text.Megaparsec+import Text.Megaparsec.Char+import Text.Megaparsec.Char.Lexer++type P = Parsec Void Text++getConnectionString :: P ConnectionString+getConnectionString =+  asum+    [ getUriConnectionString,+      getKeyValueConnectionString+    ]++getUriConnectionString :: P ConnectionString+getUriConnectionString = do+  asum+    [ try (string' "postgresql://"),+      try (string' "postgres://")+    ]+  asum+    [ do+        unqualifiedWord <- try getWord+        asum+          [ do+              try (char ':')+              -- We still don't know if this is user:password@ or host:port+              asum+                [ do+                    password <- try do+                      label "Password" getWord <* char '@'+                    -- Definitely user:password@ pattern+                    let user = unqualifiedWord+                    continueFromHostspec (Just user) (Just password) [],+                  do+                    port <- try do+                      p <- decimal <?> "Port"+                      -- Ensure we're followed by valid continuation (not more alphanumeric)+                      notFollowedBy alphaNumChar+                      return p+                    let host = unqualifiedWord+                    continueAfterHostspec Nothing Nothing [Host host (Just port)]+                ],+            do+              try (char '@')+              -- Definitely user@ pattern+              let user = unqualifiedWord+              continueFromHostspec (Just user) Nothing [],+            do+              -- Definitely host pattern+              let host = unqualifiedWord+              continueAfterHostspec Nothing Nothing [Host host Nothing]+          ],+      do+        try (char '/')+        continueFromDbname Nothing Nothing [],+      do+        try (char '?')+        continueFromParams Nothing Nothing [] Nothing,+      pure (ConnectionString Nothing Nothing [] Nothing Map.empty)+    ]++getKeyValueConnectionString :: P ConnectionString+getKeyValueConnectionString = do+  params <- getKeyValueParams+  -- Extract known connection parameters+  let user = Map.lookup "user" params+      password = Map.lookup "password" params+      dbname = Map.lookup "dbname" params+      hostText = Map.lookup "host" params+      portText = Map.lookup "port" params+      -- Remove extracted params from the map+      remainingParams =+        ( Map.delete "user"+            . Map.delete "password"+            . Map.delete "dbname"+            . Map.delete "host"+            . Map.delete "port"+        )+          params++      -- Parse hosts if present - handle comma-separated hosts and ports+      hosts = case hostText of+        Nothing -> []+        Just h ->+          let hostList = Text.splitOn "," h+              portList = maybe [] (Text.splitOn ",") portText+              -- Pair up hosts with ports, padding with Nothing if needed+              pairs = zipWith (\host mPort -> (host, mPort)) hostList (map Just portList ++ repeat Nothing)+           in map (\(host, mPortText) -> Host host (mPortText >>= parsePort)) pairs++  pure (ConnectionString user password hosts dbname remainingParams)+  where+    parsePort :: Text -> Maybe Word16+    parsePort t = case reads (Text.unpack t) of+      [(n, "")] -> Just n+      _ -> Nothing++getKeyValueParams :: P (Map.Map Text Text)+getKeyValueParams = do+  firstParam <- getKeyValueParam+  restParams <- many do+    space1+    getKeyValueParam+  pure (Map.fromList (firstParam : restParams))++getKeyValueParam :: P (Text, Text)+getKeyValueParam = do+  key <- some (satisfy (\c -> c /= '=' && c /= ' '))+  char '='+  value <- getKeyValueParamValue+  pure (fromString key, fromString value)++getKeyValueParamValue :: P String+getKeyValueParamValue =+  asum+    [ do+        -- Quoted value+        char '\''+        chars <- many do+          asum+            [ do+                -- Escaped quote+                try (string "\\'")+                pure '\'',+              do+                -- Escaped backslash+                try (string "\\\\")+                pure '\\',+              satisfy (/= '\'')+            ]+        char '\''+        pure chars,+      -- Unquoted value+      some (satisfy (\c -> c /= ' ' && c /= '\n'))+    ]++getWord :: P Text+getWord = PercentEncoding.parser (flip CharSet.member controlCharset)+  where+    controlCharset = CharSet.fromList ":@?/=&,"++getParamValue :: P Text+getParamValue = PercentEncoding.parser (flip CharSet.member paramControlCharset)+  where+    paramControlCharset = CharSet.fromList "&"++continueAfterHostspec :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString+continueAfterHostspec user password hosts = do+  asum+    [ do+        try (char '/')+        continueFromDbname user password hosts,+      do+        try (char '?')+        continueFromParams user password hosts Nothing,+      do+        try (char ',')+        continueFromHostspec user password hosts,+      pure (ConnectionString user password hosts Nothing Map.empty)+    ]++continueFromHostspec :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString+continueFromHostspec user password hosts = do+  -- Check if there's actually a host to parse+  asum+    [ do+        try (char '/')+        continueFromDbname user password hosts,+      do+        try (char '?')+        continueFromParams user password hosts Nothing,+      do+        -- Parse first host+        firstHost <- getHost++        -- Parse additional hosts (comma-separated)+        moreHosts <- many do+          try (char ',')+          getHost++        let allHosts = hosts <> [firstHost] <> moreHosts++        asum+          [ do+              try (char '/')+              continueFromDbname user password allHosts,+            do+              try (char '?')+              continueFromParams user password allHosts Nothing,+            pure (ConnectionString user password allHosts Nothing Map.empty)+          ],+      pure (ConnectionString user password hosts Nothing Map.empty)+    ]++getHost :: P Host+getHost = do+  host <- getWord+  port <- optional do+    -- Try to parse as numeric port+    try do+      char ':'+    label "Port" decimal <* notFollowedBy alphaNumChar+  pure (Host host port)++continueFromDbname :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString+continueFromDbname user password hosts = do+  dbname <- optional getWord+  asum+    [ do+        try (char '?')+        continueFromParams user password hosts dbname,+      pure (ConnectionString user password hosts dbname Map.empty)+    ]++continueFromParams :: Maybe Text -> Maybe Text -> [Host] -> Maybe Text -> P ConnectionString+continueFromParams user password hosts dbname = do+  params <- getParams+  pure (ConnectionString user password hosts dbname params)++getParams :: P (Map.Map Text Text)+getParams = do+  firstParam <- getParam+  restParams <- many do+    char '&'+    getParam+  pure (Map.fromList (firstParam : restParams))++getParam :: P (Text, Text)+getParam = do+  key <- getWord+  char '='+  value <- getParamValue+  pure (key, value)
+ src/library/PostgresqlConnectionString/Types.hs view
@@ -0,0 +1,81 @@+-- |+-- Module: PostgresqlConnectionString.Types+-- Description: Core data types for PostgreSQL connection strings+--+-- This module defines the internal representation of PostgreSQL connection strings.+-- Users typically don't need to import this module directly; use "ConnectionString" instead.+module PostgresqlConnectionString.Types where++import qualified Data.Map.Strict as Map+import Platform.Prelude+import qualified PostgresqlConnectionString.Types.Gens as Gens+import qualified Test.QuickCheck as QuickCheck++-- | A PostgreSQL connection string.+--+-- This type represents all the components of a PostgreSQL connection string as defined in:+-- <https://www.postgresql.org/docs/current/libpq-connect.html#LIBPQ-CONNSTRING-URIS>+--+-- 'ConnectionString' has 'Semigroup' and 'Monoid' instances that allow combining+-- connection strings. When combining, the right-hand side takes precedence for+-- scalar values, while the list of hosts gets concatenated.+data ConnectionString+  = ConnectionString+      -- | Username for authentication.+      (Maybe Text)+      -- | Password for authentication.+      (Maybe Text)+      -- | List of host specifications (for failover/load balancing).+      [Host]+      -- | Database name to connect to.+      (Maybe Text)+      -- | Additional connection parameters.+      (Map.Map Text Text)+  deriving stock (Eq, Ord, Generic)+  deriving anyclass (Hashable)++-- | A host specification consisting of a hostname\/IP and optional port.+data Host+  = Host+      -- | Host domain name or IP address.+      Text+      -- | Port number. If 'Nothing', PostgreSQL's default port (5432) is used.+      (Maybe Word16)+  deriving stock (Show, Eq, Ord, Generic)+  deriving anyclass (Hashable)++-- | Combine two connection strings.+--+-- When combining, the following rules apply:+--+-- * For hosts: concatenated in order.+-- * For scalar values and params: right-hand side takes precedence for duplicate keys, which gives you override behaviour.+instance Semigroup ConnectionString where+  ConnectionString user1 password1 hosts1 dbname1 params1 <> ConnectionString user2 password2 hosts2 dbname2 params2 =+    ConnectionString+      (user2 <|> user1)+      (password2 <|> password1)+      (hosts1 <> hosts2)+      (dbname2 <|> dbname1)+      (Map.union params2 params1)++instance Monoid ConnectionString where+  mempty = ConnectionString Nothing Nothing [] Nothing Map.empty++instance QuickCheck.Arbitrary ConnectionString where+  arbitrary = QuickCheck.sized \size -> do+    user <- Gens.genMaybeText size+    -- Password only makes sense if there's a user+    password <- case user of+      Nothing -> pure Nothing+      Just _ -> Gens.genMaybeText size+    hosts <- QuickCheck.scale (`div` 2) (QuickCheck.listOf QuickCheck.arbitrary)+    dbname <- Gens.genMaybeText size+    params <- Gens.genParams size+    pure (ConnectionString user password hosts dbname params)++instance QuickCheck.Arbitrary Host where+  arbitrary = do+    hostname <- Gens.genHostname+    port <- QuickCheck.oneof [pure Nothing, Just <$> QuickCheck.arbitrary]+    pure (Host hostname port)
+ src/library/PostgresqlConnectionString/Types/Gens.hs view
@@ -0,0 +1,59 @@+module PostgresqlConnectionString.Types.Gens where++import qualified Data.Map.Strict as Map+import Platform.Prelude+import Test.QuickCheck++-- | Generate valid hostname (domain or IP)+genHostname :: Gen Text+genHostname =+  oneof+    [ genDomain,+      genIpAddress+    ]++-- | Generate a simple domain name+genDomain :: Gen Text+genDomain = do+  parts <- listOf1 genDomainPart+  pure (fromString (intercalate "." parts))+  where+    genDomainPart = listOf1 (elements (['a' .. 'z'] <> ['0' .. '9'] <> ['-']))++-- | Generate a simple IPv4 address+genIpAddress :: Gen Text+genIpAddress = do+  a <- elements [0 .. 255 :: Int]+  b <- elements [0 .. 255 :: Int]+  c <- elements [0 .. 255 :: Int]+  d <- elements [0 .. 255 :: Int]+  pure (fromString (show a <> "." <> show b <> "." <> show c <> "." <> show d))++-- | Generate Maybe Text with safe characters (excluding special URI chars)+genMaybeText :: Int -> Gen (Maybe Text)+genMaybeText size =+  oneof+    [ pure Nothing,+      Just <$> genSafeText size+    ]++-- | Generate text with safe characters (letters, numbers, basic punctuation)+genSafeText :: Int -> Gen Text+genSafeText size = do+  len <- elements [1 .. max 1 (size `div` 2)]+  chars <- vectorOf len genSafeChar+  pure (fromString chars)+  where+    genSafeChar = elements (['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] <> ['_', '-', '.'])++-- | Generate parameter map+genParams :: Int -> Gen (Map.Map Text Text)+genParams size = do+  len <- elements [0 .. max 0 (size `div` 4)]+  pairs <- vectorOf len genParamPair+  pure (Map.fromList pairs)+  where+    genParamPair = do+      key <- genSafeText (size `div` 2)+      value <- genSafeText (size `div` 2)+      pure (key, value)
+ src/percent-encoding/PercentEncoding.hs view
@@ -0,0 +1,17 @@+module PercentEncoding where++import qualified PercentEncoding.Parsers as Parsers+import qualified PercentEncoding.TextBuilders as TextBuilders+import Platform.Prelude+import qualified Text.Megaparsec as Megaparsec++encodeText :: Text -> TextBuilder+encodeText = TextBuilders.urlEncodedText++parser ::+  -- | Test on stop-char. @%@ is already accounted for.+  (Char -> Bool) ->+  -- | Megaparsec parser for a percent-encoded text component.+  Megaparsec.Parsec Void Text Text+parser isStopChar =+  Parsers.urlEncodedComponentText isStopChar
+ src/percent-encoding/PercentEncoding/Charsets.hs view
@@ -0,0 +1,24 @@+module PercentEncoding.Charsets where++import Data.CharSet+import Platform.Prelude hiding (fromList)++-- | Characters which don't need to be percent-encoded in URLs.+{-# NOINLINE passthrough #-}+passthrough :: CharSet+passthrough =+  mconcat+    [ lowerAsciiAlpha,+      upperAsciiAlpha,+      digit,+      fromList ['-', '.', '_', '~']+    ]++lowerAsciiAlpha :: CharSet+lowerAsciiAlpha = fromDistinctAscList ['a' .. 'z']++upperAsciiAlpha :: CharSet+upperAsciiAlpha = fromDistinctAscList ['A' .. 'Z']++digit :: CharSet+digit = fromDistinctAscList ['0' .. '9']
+ src/percent-encoding/PercentEncoding/MonadPlus.hs view
@@ -0,0 +1,41 @@+module PercentEncoding.MonadPlus where++import Platform.Prelude hiding (scanl)++{-# INLINE scanl #-}+scanl :: (MonadPlus m) => (a -> b -> a) -> a -> m b -> m a+scanl step start subaction =+  loop start+  where+    loop state =+      mplus+        ( do+            element <- subaction+            loop $! step state element+        )+        (return state)++{-# INLINE scanl1 #-}+scanl1 :: (MonadPlus m) => (a -> a -> a) -> m a -> m a+scanl1 step subaction = do+  start <- subaction+  scanl step start subaction++{-# INLINE scanlM #-}+scanlM :: (MonadPlus m) => (a -> b -> m a) -> a -> m b -> m a+scanlM step start subaction =+  loop start+  where+    loop state =+      join+        ( mplus+            ( do+                element <- subaction+                return (step state element >>= loop)+            )+            (return (return state))+        )++{-# INLINE scan #-}+scan :: (MonadPlus m, Monoid a) => m a -> m a+scan = scanl mappend mempty
+ src/percent-encoding/PercentEncoding/Parsers.hs view
@@ -0,0 +1,78 @@+module PercentEncoding.Parsers where++import qualified Control.Exception as Exception+import qualified Data.ByteString as ByteString+import qualified Data.Text.Encoding as Text.Encoding+import qualified Data.Text.Encoding.Error as Text.Encoding+import qualified PercentEncoding.MonadPlus as MonadPlus+import Platform.Prelude hiding (try)+import Text.Megaparsec+import Text.Megaparsec.Char+import qualified TextBuilder as TextBuilder++type Parser = Parsec Void Text++{-# INLINEABLE urlEncodedComponentText #-}+urlEncodedComponentText :: (Char -> Bool) -> Parser Text+urlEncodedComponentText stopCharPredicate =+  labeled "URL-encoded component"+    $ fmap TextBuilder.toText+    $ MonadPlus.scanl1 mappend+    $ parser+  where+    parser =+      asum+        [ TextBuilder.text <$> try (takeWhile1P (Just "Unencoded char") unencodedCharPredicate),+          urlEncodedSequenceTextBuilder+        ]+      where+        unencodedCharPredicate c =+          not (c == '%' || stopCharPredicate c)++{-# INLINEABLE urlEncodedSequenceTextBuilder #-}+urlEncodedSequenceTextBuilder :: Parser TextBuilder.TextBuilder+urlEncodedSequenceTextBuilder =+  labeled "URL-encoded sequence" $ do+    start <- progress (mempty, mempty, Text.Encoding.streamDecodeUtf8) =<< urlEncodedByte+    MonadPlus.scanlM progress start urlEncodedByte >>= finish+  where+    progress (!builder, _ :: ByteString, decode) byte =+      case unsafeDupablePerformIO (Exception.try (evaluate (decode (ByteString.singleton byte)))) of+        Right (Text.Encoding.Some decodedChunk undecodedBytes newDecode) ->+          return (builder <> TextBuilder.text decodedChunk, undecodedBytes, newDecode)+        Left (Text.Encoding.DecodeError error _) ->+          fail (showString "UTF8 decoding: " error)+        Left _ ->+          fail "Unexpected decoding error"+    finish (builder, undecodedBytes, _) =+      if ByteString.null undecodedBytes+        then return builder+        else fail (showString "UTF8 decoding: Bytes remaining: " (show undecodedBytes))++{-# INLINE urlEncodedByte #-}+urlEncodedByte :: Parser Word8+urlEncodedByte = do+  _ <- try (char '%')+  digit1 <- fromIntegral <$> hexadecimalDigit+  digit2 <- fromIntegral <$> hexadecimalDigit+  return (shiftL digit1 4 .|. digit2)++{-# INLINE hexadecimalDigit #-}+hexadecimalDigit :: Parser Int+hexadecimalDigit = label "Hex digit" do+  c <- anySingle+  let x = ord c+  if x >= 48 && x < 58+    then return (x - 48)+    else+      if x >= 65 && x < 71+        then return (x - 55)+        else+          if x >= 97 && x < 103+            then return (x - 87)+            else fail ("Not a hexadecimal digit: " <> show c)++{-# INLINE labeled #-}+labeled :: String -> Parser a -> Parser a+labeled label parser =+  parser <?> label
+ src/percent-encoding/PercentEncoding/TextBuilders.hs view
@@ -0,0 +1,36 @@+module PercentEncoding.TextBuilders where++import qualified Data.CharSet as CharSet+import qualified Data.Text as Text+import qualified PercentEncoding.Charsets as Charsets+import qualified PercentEncoding.Utf8CharView as Utf8CharView+import Platform.Prelude+import TextBuilder++-- | Apply URL-encoding to text+urlEncodedText :: Text -> TextBuilder+urlEncodedText =+  foldMap urlEncodedChar . Text.unpack++urlEncodedChar :: Char -> TextBuilder+urlEncodedChar c =+  if CharSet.member c Charsets.passthrough+    then char c+    else+      Utf8CharView.char+        c+        ( \b1 ->+            urlEncodedByte b1+        )+        ( \b1 b2 ->+            urlEncodedByte b1 <> urlEncodedByte b2+        )+        ( \b1 b2 b3 ->+            mconcat [urlEncodedByte b1, urlEncodedByte b2, urlEncodedByte b3]+        )+        ( \b1 b2 b3 b4 ->+            mconcat [urlEncodedByte b1, urlEncodedByte b2, urlEncodedByte b3, urlEncodedByte b4]+        )++urlEncodedByte :: Word8 -> TextBuilder+urlEncodedByte x = char '%' <> hexadecimal x
+ src/percent-encoding/PercentEncoding/Utf8CharView.hs view
@@ -0,0 +1,45 @@+-- |+-- Utilities for the UTF-8 encoding.+module PercentEncoding.Utf8CharView where++import Platform.Prelude++-- |+-- Church encoding of a UTF8-encoded character.+type Utf8CharView =+  forall a.+  (Word8 -> a) ->+  (Word8 -> Word8 -> a) ->+  (Word8 -> Word8 -> Word8 -> a) ->+  (Word8 -> Word8 -> Word8 -> Word8 -> a) ->+  a++{-# INLINE char #-}+char :: Char -> Utf8CharView+char a =+  codepoint (ord a)++{-# INLINE codepoint #-}+codepoint :: Int -> Utf8CharView+codepoint x f1 f2 f3 f4 =+  if x <= 0x7F+    then f1 (fromIntegral x)+    else+      if x <= 0x07FF+        then+          f2+            (fromIntegral ((x `unsafeShiftR` 6) + 0xC0))+            (fromIntegral ((x .&. 0x3F) + 0x80))+        else+          if x <= 0xFFFF+            then+              f3+                (fromIntegral (x `unsafeShiftR` 12) + 0xE0)+                (fromIntegral ((x `unsafeShiftR` 6) .&. 0x3F) + 0x80)+                (fromIntegral (x .&. 0x3F) + 0x80)+            else+              f4+                (fromIntegral (x `unsafeShiftR` 18) + 0xF0)+                (fromIntegral ((x `unsafeShiftR` 12) .&. 0x3F) + 0x80)+                (fromIntegral ((x `unsafeShiftR` 6) .&. 0x3F) + 0x80)+                (fromIntegral (x .&. 0x3F) + 0x80)
+ src/platform/Platform/Prelude.hs view
@@ -0,0 +1,48 @@+module Platform.Prelude+  ( module Exports,+  )+where++import Control.Applicative as Exports hiding (WrappedArrow (..))+import Control.Arrow as Exports hiding (first, second)+import Control.Category as Exports+import Control.Exception as Exports hiding (Handler)+import Control.Monad as Exports hiding (fail, forM, forM_, mapM, mapM_, msum, sequence, sequence_)+import Control.Monad.Fail as Exports+import Control.Monad.Fix as Exports hiding (fix)+import Control.Monad.IO.Class as Exports+import Data.Bifunctor as Exports+import Data.Bits as Exports+import Data.Bool as Exports+import Data.ByteString as Exports (ByteString)+import Data.Char as Exports+import Data.Coerce as Exports+import Data.Data as Exports+import Data.Either as Exports+import Data.Foldable as Exports hiding (toList)+import Data.Function as Exports hiding (id, (.))+import Data.Functor as Exports hiding (unzip)+import Data.Functor.Compose as Exports+import Data.Functor.Identity as Exports+import Data.Hashable as Exports (Hashable (..))+import Data.Int as Exports+import Data.List as Exports hiding (all, and, any, concat, concatMap, elem, filter, find, foldl, foldl', foldl1, foldr, foldr1, isSubsequenceOf, mapAccumL, mapAccumR, maximum, maximumBy, minimum, minimumBy, notElem, or, product, sortOn, sum, uncons)+import Data.List.NonEmpty as Exports (NonEmpty (..))+import Data.Maybe as Exports hiding (mapMaybe)+import Data.Monoid as Exports hiding (Alt, (<>))+import Data.Ord as Exports+import Data.Semigroup as Exports hiding (First (..), Last (..))+import Data.String as Exports+import Data.Text as Exports (Text)+import Data.Traversable as Exports+import Data.Tuple as Exports+import Data.Void as Exports+import Data.Word as Exports+import GHC.Exts as Exports (IsList (..), groupWith, inline, lazy, sortWith)+import GHC.Generics as Exports (Generic)+import GHC.OverloadedLabels as Exports+import Numeric as Exports+import System.IO as Exports (Handle, hClose)+import System.IO.Unsafe as Exports (unsafeDupablePerformIO)+import TextBuilder as Exports (TextBuilder)+import Prelude as Exports hiding (Read, all, and, any, concat, concatMap, elem, fail, filter, foldl, foldl1, foldr, foldr1, id, mapM, mapM_, maximum, minimum, notElem, or, product, sequence, sequence_, sum, (.))