module Main where
import Control.Monad
import Data.Either
import Data.Function
import qualified Data.Map.Strict as Map
import Data.Proxy
import qualified Data.Text as Text
import qualified PostgresqlConnectionString as ConnectionString
import Test.Hspec
import Test.QuickCheck
import qualified Test.QuickCheck.Classes as Laws
import Prelude
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
in (url `elem` ["postgresql://", "postgres://"] || "postgresql://" `Text.isPrefixOf` url)
& 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