{-# LANGUAGE OverloadedStrings, CPP #-} import Test.Hspec import Database.PostgreSQL.Simple.PartialOptions import qualified Database.PostgreSQL.Simple.Options as O import System.Environment import Options.Applicative import System.Exit import Data.Default import qualified System.Envy as E import qualified Data.Map as Map testParser :: IO O.Options testParser = execParser $ info completeParser mempty main :: IO () main = hspec $ do describe "Env Parser" $ do it "parses all options" $ do mapM_ (uncurry setEnv) [ ("PGHOST" , "localhost") , ("PGHOSTADDR" , "127.0.0.1") , ("PGPORT" , "1234") , ("PGUSER" , "postgres") , ("PGPASSWORD" , "postgres") , ("PGDATABASE" , "temp1") , ("PGCONNECT_TIMEOUT", "100") , ("PGCLIENTENCODING" , "something") , ("PGOPTIONS" , "options") , ("PGAPPNAME" , "da app") , ("PGKEEPALIVES" , "1") , ("PGKEEPALIVESIDLE" , "2") , ("PGKEEPALIVESCOUNT", "3") , ("PGSSLMODE" , "on") , ("PGREQUIRESSL" , "1") , ("PGSSLCOMPRESSION" , "0") , ("PGSSLCERT" , "ca.cert") , ("PGSSLKEY" , "fda.key") , ("PGSSLROOTCERT" , "root.cert") , ("PGREQUIREPEER" , "yes") , ("PGKRBSRVNAME" , "blah") , ("PGGSSLIB" , "foo") , ("PGSERVICE" , "bar") ] let expected = PartialOptions { host = pure "localhost" , hostaddr = pure "127.0.0.1" , port = pure 1234 , user = pure "postgres" , password = pure "postgres" , dbname = pure "temp1" , connectTimeout = pure 100 , clientEncoding = pure "something" , options = pure "options" , fallbackApplicationName = pure "da app" , keepalives = pure 1 , keepalivesIdle = pure 2 , keepalivesCount = pure 3 , sslmode = pure "on" , requiressl = pure 1 , sslcompression = pure 0 , sslcert = pure "ca.cert" , sslkey = pure "fda.key" , sslrootcert = pure "root.cert" , requirepeer = pure "yes" , krbsrvname = pure "blah" , gsslib = pure "foo" , service = pure "bar" } E.decode `shouldReturn` Just expected it "adds to the environment all options" $ do let intial = PartialOptions { host = pure "localhost" , hostaddr = pure "127.0.0.1" , port = pure 1234 , user = pure "postgres" , password = pure "postgres" , dbname = pure "temp1" , connectTimeout = pure 100 , clientEncoding = pure "something" , options = pure "options" , fallbackApplicationName = pure "da app" , keepalives = pure 1 , keepalivesIdle = pure 2 , keepalivesCount = pure 3 , sslmode = pure "on" , requiressl = pure 1 , sslcompression = pure 0 , sslcert = pure "ca.cert" , sslkey = pure "fda.key" , sslrootcert = pure "root.cert" , requirepeer = pure "yes" , krbsrvname = pure "blah" , gsslib = pure "foo" , service = pure "bar" } mapM_ (unsetEnv . fst) =<< getEnvironment E.setEnvironment' intial `shouldReturn` Right () let expected = Map.fromList [ ("PGHOST" , "localhost") , ("PGHOSTADDR" , "127.0.0.1") , ("PGPORT" , "1234") , ("PGUSER" , "postgres") , ("PGPASSWORD" , "postgres") , ("PGDATABASE" , "temp1") , ("PGCONNECT_TIMEOUT", "100") , ("PGCLIENTENCODING" , "something") , ("PGOPTIONS" , "options") , ("PGAPPNAME" , "da app") , ("PGKEEPALIVES" , "1") , ("PGKEEPALIVESIDLE" , "2") , ("PGKEEPALIVESCOUNT", "3") , ("PGSSLMODE" , "on") , ("PGREQUIRESSL" , "1") , ("PGSSLCOMPRESSION" , "0") , ("PGSSLCERT" , "ca.cert") , ("PGSSLKEY" , "fda.key") , ("PGSSLROOTCERT" , "root.cert") , ("PGREQUIREPEER" , "yes") , ("PGKRBSRVNAME" , "blah") , ("PGGSSLIB" , "foo") , ("PGSERVICE" , "bar") ] fmap Map.fromList getEnvironment `shouldReturn` expected describe "Options Parser" $ do it "parses all options" $ do let testArgs = [ "--host=example.com" , "--port=1234" , "--user=nobody" , "--password=everytimeiclosemyeyes" , "--dbname=future" ] expected = completeOptions $ mempty { host = return "example.com" , port = return 1234 , user = return "nobody" , password = return "everytimeiclosemyeyes" , dbname = return "future" } actual <- withArgs testArgs testParser Right actual `shouldBe` expected it "parses some and uses defaults for others" $ do let testArgs = [ "--user=nobody" , "--password=everytimeiclosemyeyes" , "--dbname=future" ] expected = completeOptions $ mempty { host = return "127.0.0.1" , port = return 5432 , user = return "nobody" , password = return "everytimeiclosemyeyes" , dbname = return "future" } actual <- withArgs testArgs testParser Right actual `shouldBe` expected it "parses no options and gives defaults" $ do let expected = completeOptions $ mempty { host = return "127.0.0.1" , port = return 5432 , user = return "postgres" , password = return "" , dbname = return "" } actual <- withArgs [] testParser Right actual `shouldBe` expected it "parses the connection string double quoted" $ do let testArgs = ["--connectString=\"host=yahoo\""] expected = completeOptions $ def { host = return "yahoo" } actual <- withArgs testArgs testParser Right actual `shouldBe` expected it "parses the connection string single quoted" $ do let testArgs = ["--connectString='host=yahoo'"] expected = completeOptions $ def { host = return "yahoo" } actual <- withArgs testArgs testParser Right actual `shouldBe` expected it "parses the connection string no quotes" $ do let testArgs = ["--connectString=host=yahoo"] expected = completeOptions $ def { host = return "yahoo" } actual <- withArgs testArgs testParser Right actual `shouldBe` expected it "fails if connectString and other args are passed" $ do let testArgs = ["--connectString=host=yahoo", "--port=1234"] handler :: ExitCode -> Bool handler (ExitFailure 1) = True handler _ = False shouldThrow (withArgs testArgs testParser) handler describe "connection string parser" $ do it "fails on empty" $ parseConnectionString "" `shouldBe` Left "MalformedScheme NonAlphaLeading" it "parses a single keyword" $ parseConnectionString "host=localhost" `shouldBe` Right (mempty { host = return "localhost" }) it "parses all keywords" $ parseConnectionString "host=localhost port=1234 user=jonathan password=open dbname=dev" `shouldBe` Right (mempty { host = return "localhost" , port = return 1234 , user = return "jonathan" , password = return "open" , dbname = return "dev" }) it "parses host only connection string" $ parseConnectionString "postgresql://localhost" `shouldBe` Right (mempty { host = return "localhost" }) it "parses all params" $ parseConnectionString "postgresql://jonathan:open@localhost:1234/dev" `shouldBe` Right (mempty { host = return "localhost" , port = return 1234 , user = return "jonathan" , password = return "open" , dbname = return "dev" }) it "parses all params using query params" $ parseConnectionString "postgresql:///dev?host=localhost&port=1234" `shouldBe` Right (mempty { host = return "localhost" , port = return 1234 , dbname = return "dev" }) it "decodes a unix port" $ parseConnectionString "postgresql://%2Fvar%2Flib%2Fpostgresql/dbname" `shouldBe` Right (mempty { host = return "/var/lib/postgresql" , dbname = return "dbname" })