diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -83,48 +83,6 @@ 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. diff --git a/postgresql-connection-string.cabal b/postgresql-connection-string.cabal --- a/postgresql-connection-string.cabal +++ b/postgresql-connection-string.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: postgresql-connection-string -version: 0.1.0.1 +version: 0.1.0.2 category: Database, PostgreSQL synopsis: PostgreSQL connection string type, parser and builder description: @@ -99,6 +99,7 @@ PostgresqlConnectionString other-modules: + PostgresqlConnectionString.Charsets PostgresqlConnectionString.Parsers PostgresqlConnectionString.Types PostgresqlConnectionString.Types.Gens diff --git a/src/library/PostgresqlConnectionString.hs b/src/library/PostgresqlConnectionString.hs --- a/src/library/PostgresqlConnectionString.hs +++ b/src/library/PostgresqlConnectionString.hs @@ -368,7 +368,17 @@ -- Returns 'Left' with an error message if parsing fails: -- -- >>> parse "invalid://connection" --- Left "parse error message" +-- Left ... +-- +-- The error message is quite detailed (it is produced by Megaparsec): +-- +-- >>> parse "invalid://connection=" & either id (const "") & Data.Text.IO.putStrLn +-- 1:8: +-- | +-- 1 | invalid://connection= +-- | ^ +-- unexpected ':' +-- expecting '=' or Key parse :: Text -> Either Text ConnectionString parse input = Megaparsec.parse megaparsecOf "" input @@ -392,6 +402,11 @@ -- using the 'Semigroup' instance. -- -- When you need to specify a port, use 'hostAndPort' instead. +-- +-- Examples: +-- +-- >>> host "localhost" +-- "postgresql://localhost" host :: Text -> ConnectionString host hostname = ConnectionString @@ -408,13 +423,10 @@ -- -- Examples: -- --- >>> toUrl (host "localhost") --- "postgresql://localhost" --- --- >>> toUrl (hostAndPort "localhost" 5432) +-- >>> hostAndPort "localhost" 5432 -- "postgresql://localhost:5432" -- --- >>> toUrl (mconcat [hostAndPort "host1" 5432, hostAndPort "host2" 5433]) +-- >>> mconcat [hostAndPort "host1" 5432, hostAndPort "host2" 5433] -- "postgresql://host1:5432,host2:5433" hostAndPort :: Text -> Word16 -> ConnectionString hostAndPort host port = @@ -429,10 +441,10 @@ -- -- Examples: -- --- >>> toUrl (user "myuser") +-- >>> user "myuser" -- "postgresql://myuser@" -- --- >>> toUrl (mconcat [user "myuser", host "localhost"]) +-- >>> mconcat [user "myuser", host "localhost"] -- "postgresql://myuser@localhost" user :: Text -> ConnectionString user username = @@ -449,10 +461,10 @@ -- -- Examples: -- --- >>> toUrl (mconcat [user "myuser", password "secret"]) +-- >>> mconcat [user "myuser", password "secret"] -- "postgresql://myuser:secret@" -- --- >>> toUrl (mconcat [user "myuser", password "secret", host "localhost"]) +-- >>> mconcat [user "myuser", password "secret", host "localhost"] -- "postgresql://myuser:secret@localhost" password :: Text -> ConnectionString password pwd = @@ -467,10 +479,10 @@ -- -- Examples: -- --- >>> toUrl (dbname "mydb") +-- >>> dbname "mydb" -- "postgresql:///mydb" -- --- >>> toUrl (mconcat [host "localhost", dbname "mydb"]) +-- >>> mconcat [host "localhost", dbname "mydb"] -- "postgresql://localhost/mydb" dbname :: Text -> ConnectionString dbname db = @@ -496,13 +508,13 @@ -- -- Examples: -- --- >>> toUrl (param "application_name" "myapp") +-- >>> param "application_name" "myapp" -- "postgresql://?application_name=myapp" -- --- >>> toUrl (mconcat [host "localhost", param "connect_timeout" "10"]) +-- >>> mconcat [host "localhost", param "connect_timeout" "10"] -- "postgresql://localhost?connect_timeout=10" -- --- >>> toUrl (mconcat [param "application_name" "myapp", param "connect_timeout" "10"]) +-- >>> mconcat [param "application_name" "myapp", param "connect_timeout" "10"] -- "postgresql://?application_name=myapp&connect_timeout=10" param :: Text -> Text -> ConnectionString param key value = diff --git a/src/library/PostgresqlConnectionString/Charsets.hs b/src/library/PostgresqlConnectionString/Charsets.hs new file mode 100644 --- /dev/null +++ b/src/library/PostgresqlConnectionString/Charsets.hs @@ -0,0 +1,21 @@ +module PostgresqlConnectionString.Charsets where + +import Data.CharSet +import Platform.Prelude hiding (fromList) + +control :: CharSet +control = fromList ":@?/=&," + +paramControl :: CharSet +paramControl = fromList "&" + +keyName :: CharSet +keyName = + fromList + ( mconcat + [ ['a' .. 'z'], + ['A' .. 'Z'], + ['0' .. '9'], + "_" + ] + ) diff --git a/src/library/PostgresqlConnectionString/Parsers.hs b/src/library/PostgresqlConnectionString/Parsers.hs --- a/src/library/PostgresqlConnectionString/Parsers.hs +++ b/src/library/PostgresqlConnectionString/Parsers.hs @@ -7,6 +7,7 @@ import qualified Data.Text as Text import qualified PercentEncoding import Platform.Prelude hiding (many, some, try) +import qualified PostgresqlConnectionString.Charsets as Charsets import PostgresqlConnectionString.Types import Text.Megaparsec import Text.Megaparsec.Char @@ -115,17 +116,23 @@ getKeyValueParam :: P (Text, Text) getKeyValueParam = do - key <- some (satisfy (\c -> c /= '=' && c /= ' ')) + key <- try do + getKeyValueKey char '=' value <- getKeyValueParamValue - pure (fromString key, fromString value) + pure (key, value) -getKeyValueParamValue :: P String +getKeyValueKey :: P Text +getKeyValueKey = + takeWhile1P (Just "Key") \c -> CharSet.member c Charsets.keyName + +getKeyValueParamValue :: P Text getKeyValueParamValue = + -- TODO: Optimize to avoid intermediate String allocation asum [ do -- Quoted value - char '\'' + try (char '\'') chars <- many do asum [ do @@ -139,20 +146,16 @@ satisfy (/= '\'') ] char '\'' - pure chars, + pure (fromString chars), -- Unquoted value - some (satisfy (\c -> c /= ' ' && c /= '\n')) + fromString <$> some (satisfy (\c -> c /= ' ' && c /= '\n')) ] getWord :: P Text -getWord = PercentEncoding.parser (flip CharSet.member controlCharset) - where - controlCharset = CharSet.fromList ":@?/=&," +getWord = PercentEncoding.parser (flip CharSet.member Charsets.control) getParamValue :: P Text -getParamValue = PercentEncoding.parser (flip CharSet.member paramControlCharset) - where - paramControlCharset = CharSet.fromList "&" +getParamValue = PercentEncoding.parser (flip CharSet.member Charsets.paramControl) continueAfterHostspec :: Maybe Text -> Maybe Text -> [Host] -> P ConnectionString continueAfterHostspec user password hosts = do diff --git a/src/library/PostgresqlConnectionString/Types/Gens.hs b/src/library/PostgresqlConnectionString/Types/Gens.hs --- a/src/library/PostgresqlConnectionString/Types/Gens.hs +++ b/src/library/PostgresqlConnectionString/Types/Gens.hs @@ -54,6 +54,23 @@ pure (Map.fromList pairs) where genParamPair = do - key <- genSafeText (size `div` 2) + key <- genKey (size `div` 2) value <- genSafeText (size `div` 2) pure (key, value) + +genKey :: Int -> Gen Text +genKey size = do + len <- chooseInt (0, max 1 (size `div` 2)) + head <- elements (['a' .. 'z'] <> ['A' .. 'Z'] <> ['_']) + tail <- vectorOf len do + elements (['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] <> ['_']) + pure (fromString (head : tail)) + +-- | Generate text with safe characters (letters, numbers, basic punctuation) +genValue :: Int -> Gen Text +genValue size = do + len <- chooseInt (0, max 1 (size `div` 2)) + chars <- vectorOf len genSafeChar + pure (fromString chars) + where + genSafeChar = elements (['a' .. 'z'] <> ['A' .. 'Z'] <> ['0' .. '9'] <> ['_', '-', '.', ' '])