purescript-postgresql-client/test/Main.purs

module Test.Main
  ( main
  ) where

import Prelude

import Control.Monad.Error.Class (throwError, try)
import Control.Monad.Except.Trans (runExceptT)
import Control.Monad.Trans.Class (lift)
import Data.Argonaut (Json)
import Data.Argonaut (fromArray, fromObject, fromString) as Argonaut
import Data.Array (zip)
import Data.Date (Date, canonicalDate)
import Data.DateTime.Instant (Instant, unInstant)
import Data.Decimal as D
import Data.Either (Either(..))
import Data.Enum (toEnum)
import Data.Foldable (all, length)
import Data.JSDate (JSDate, jsdate, toInstant)
import Data.JSDate as JSDate
import Data.Maybe (Maybe(..), fromJust)
import Data.Newtype (unwrap)
import Data.Tuple (Tuple(..))
import Data.Tuple.Nested ((/\))
import Database.PostgreSQL (Configuration, Connection, DBHandle, PGError(..), Pool, Query(Query), Row0(Row0), Row1(Row1), Row2(Row2), Row3(Row3), Row9(Row9), PGConnectionURI, parseURI)
import Database.PostgreSQL.PG (command, execute, onIntegrityError, query, scalar)
import Database.PostgreSQL.PG (withConnection, withConnectionTransaction) as PG
import Database.PostgreSQL.Pool (new) as Pool
import Effect (Effect)
import Effect.Aff (Aff, error, launchAff)
import Effect.Class (liftEffect)
import Effect.Exception (message)
import Foreign.Object (Object)
import Foreign.Object (fromFoldable) as Object
import Math ((%))
import Partial.Unsafe (unsafePartial)
import Test.Assert (assert)
import Test.Config (load) as Config
import Test.README (AppM)
import Test.README (run) as README
import Test.Unit (TestSuite, suite)
import Test.Unit as Test.Unit
import Test.Unit.Assert (equal)
import Test.Unit.Main (runTest)

withConnection :: forall a. Pool -> (Connection -> AppM a) -> AppM a
withConnection = PG.withConnection runExceptT

withConnectionTransaction :: forall a. Connection -> AppM a -> AppM a
withConnectionTransaction = PG.withConnectionTransaction runExceptT


pgEqual :: forall a. Eq a => Show a => a -> a -> AppM Unit
pgEqual a b = lift $ equal a b

withRollback
  ∷ Connection
  → AppM Unit
  → AppM Unit
withRollback conn action =
    begin *> action *> rollback
    where
        begin = execute (Right conn) (Query "BEGIN TRANSACTION") Row0
        rollback = execute (Right conn) (Query "ROLLBACK TRANSACTION") Row0

test
  ∷ DBHandle
  → String
  → AppM Unit
  → TestSuite
test (Left pool) name action =
    Test.Unit.test name $ checkPGErrors $ action
test (Right conn) name action =
    Test.Unit.test name $ checkPGErrors $ withRollback conn action

transactionTest
  ∷ String
  → AppM Unit
  → TestSuite
transactionTest name action =
    Test.Unit.test name $ checkPGErrors $ action

checkPGErrors :: AppM Unit -> Aff Unit
checkPGErrors action = do
    runExceptT action >>= case _ of
        Left pgError -> Test.Unit.failure ("Unexpected PostgreSQL error occured:" <> unsafeStringify pgError)
        Right _ -> pure unit

now ∷ Effect Instant
now = unsafePartial $ (fromJust <<< toInstant) <$> JSDate.now

date ∷ Int → Int → Int → Date
date y m d = unsafePartial $ fromJust $ canonicalDate <$> toEnum y <*> toEnum m <*> toEnum d

jsdate_ ∷ Number → Number → Number → Number → Number → Number → Number → JSDate
jsdate_ year month day hour minute second millisecond =
  jsdate { year, month, day, hour, minute, second, millisecond }

noSuchDatabaseConfig :: Configuration → Configuration
noSuchDatabaseConfig config =
  config { database = "non-existing" <> config.database }

cannotConnectConfig :: Configuration → Configuration
cannotConnectConfig config =
  config { host = Just "127.0.0.1"
         , port = Just 45287
         }

main ∷ Effect Unit
main = do
  void $ launchAff do
    -- Running guide from README
    void $ runExceptT $ README.run

    config ← Config.load
    pool ← liftEffect $ Pool.new config

    checkPGErrors $ execute (Left pool) (Query """
      CREATE TEMPORARY TABLE foods (
        name text NOT NULL,
        delicious boolean NOT NULL,
        price NUMERIC(4,2) NOT NULL,
        added TIMESTAMP WITH TIME ZONE NOT NULL DEFAULT CURRENT_TIMESTAMP,
        PRIMARY KEY (name)
      );
      CREATE TEMPORARY TABLE dates (
        date date NOT NULL
      );
      CREATE TEMPORARY TABLE timestamps (
        timestamp timestamptz NOT NULL
      );
      CREATE TEMPORARY TABLE jsons (
        json json NOT NULL,
        jsonb jsonb NOT NULL
      );
    """) Row0

    checkPGErrors $ withConnection pool \conn -> do

      liftEffect $ runTest $ do
        suite "PostgreSQL client" $ do
          let
            testCount n = do
              count <- scalar (Left pool) (Query """
                SELECT count(*) = $1
                FROM foods
              """) (Row1 n)
              liftEffect <<< assert $ count == Just true

          transactionTest "transaction commit" do
            withConnectionTransaction conn do
              execute (Right conn) (Query """
                INSERT INTO foods (name, delicious, price)
                VALUES ($1, $2, $3)
              """) (Row3 "pork" true (D.fromString "8.30"))
              testCount 1
            testCount 1
            execute (Right conn) (Query """
              DELETE FROM foods
            """) Row0

          transactionTest "transaction rollback on PostgreSQL error" $ do
            _ <- try $ withConnectionTransaction conn do
              execute (Right conn) (Query """
                INSERT INTO foods (name, delicious, price)
                VALUES ($1, $2, $3)
              """) (Row3 "pork" true (D.fromString "8.30"))
              testCount 1

              -- invalid SQL query --> PGError is thrown
              execute (Right conn) (Query "foo bar") Row0

            -- transaction should've been rolled back
            testCount 0

          transactionTest "transaction rollback on JavaScript exception" $ do
            result <- lift $ try $ runExceptT $ withConnectionTransaction conn do
              execute (Right conn) (Query """
                INSERT INTO foods (name, delicious, price)
                VALUES ($1, $2, $3)
              """) (Row3 "pork" true (D.fromString "8.30"))
              testCount 1

              -- throw a JavaScript error
              lift $ throwError $ error "fail"

            -- make sure the JavaScript error was thrown
            liftEffect $ case result of
                Left jsErr -> assert (message jsErr == "fail")
                Right _ -> assert false

            -- transaction should've been rolled back
            testCount 0

          let
            handle = Right conn

          test handle "usage of rows represented by nested tuples" $ do
            execute handle (Query """
              INSERT INTO foods (name, delicious, price)
              VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
            """)
              ( ("pork" /\ true /\ (D.fromString "8.30"))
              /\ ("sauerkraut" /\ false /\ (D.fromString "3.30"))
              /\ ("rookworst" /\ true /\ (D.fromString "5.60")))
            names <- query handle (Query """
              SELECT name, delicious
              FROM foods
              WHERE delicious
              ORDER BY name ASC
            """) Row0
            liftEffect <<< assert $ names == ["pork" /\ true, "rookworst" /\ true]

          test handle "nested tuples as rows - just one element" $ do
            let row = date 2010 2 31 /\ unit
            execute handle (Query """
              INSERT INTO dates (date)
              VALUES ($1)
            """) row
            rows <- query handle (Query "SELECT date FROM dates") Row0
            liftEffect <<< assert $ rows == [row]

          let
            insertFood =
              execute handle (Query """
                INSERT INTO foods (name, delicious, price)
                VALUES ($1, $2, $3), ($4, $5, $6), ($7, $8, $9)
              """) (Row9
                  "pork" true (D.fromString "8.30")
                  "sauerkraut" false (D.fromString "3.30")
                  "rookworst" true (D.fromString "5.60"))

          test handle "select column subset" $ do
            insertFood
            names <- query handle (Query """
              SELECT name, delicious
              FROM foods
              WHERE delicious
              ORDER BY name ASC
            """) Row0
            liftEffect <<< assert $ names == [Row2 "pork" true, Row2 "rookworst" true]

          test handle "delete returning columns subset" $ do
            insertFood
            deleted <- query handle (Query """
              DELETE FROM foods
              WHERE delicious
              RETURNING name, delicious
            """) Row0
            liftEffect <<< assert $ deleted == [Row2 "pork" true, Row2 "rookworst" true]

          test handle "delete returning command tag value" $ do
            insertFood
            deleted <- command handle (Query """
              DELETE FROM foods
              WHERE delicious
            """) Row0
            liftEffect <<< assert $ deleted == 2

          test handle "handling instant value" $ do
            before <- liftEffect $ (unwrap <<< unInstant) <$> now
            insertFood
            added <- query handle (Query """
              SELECT added
              FROM foods
            """) Row0
            after <- liftEffect $ (unwrap <<< unInstant) <$> now
            -- | timestamps are fetched without milliseconds so we have to
            -- | round before value down
            liftEffect <<< assert $ all
              (\(Row1 t) ->
                ( unwrap $ unInstant t) >= (before - before % 1000.0)
                  && after >= (unwrap $ unInstant t))
              added

          test handle "handling decimal value" $ do
            insertFood
            sauerkrautPrice <- query handle (Query """
              SELECT price
              FROM foods
              WHERE NOT delicious
            """) Row0
            liftEffect <<< assert $ sauerkrautPrice == [Row1 (D.fromString "3.30")]

          transactionTest "integrity error handling" $ do
            withRollback conn do
              result <- onIntegrityError (pure "integrity error was handled") do
                insertFood
                insertFood
                pure "integrity error was not handled"
              liftEffect $ assert $ result == "integrity error was handled"

          test handle "handling date value" $ do
            let
              d1 = date 2010 2 31
              d2 = date 2017 2 1
              d3 = date 2020 6 31

            execute handle (Query """
              INSERT INTO dates (date)
              VALUES ($1), ($2), ($3)
            """) (Row3 d1 d2 d3)

            (dates :: Array (Row1 Date)) <- query handle (Query """
              SELECT *
              FROM dates
              ORDER BY date ASC
            """) Row0
            pgEqual  3 (length dates)
            liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip dates [d1, d2, d3])

          test handle "handling Foreign.Object as json and jsonb" $ do
            let jsonIn = Object.fromFoldable [Tuple "a" 1, Tuple "a" 2, Tuple "2" 3]
            let expected = Object.fromFoldable [Tuple "a" 2, Tuple "2" 3]

            execute handle (Query """
              INSERT INTO jsons (json, jsonb)
              VALUES ($1, $2)
            """) (Row2 jsonIn jsonIn)

            (js ∷ Array (Row2 (Object Int) (Object Int))) <- query handle (Query """SELECT * FROM JSONS""") Row0
            liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == expected && expected == j2) js

          test handle "handling Argonaut.Json as json and jsonb for an object" $ do
            let input = Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])

            execute handle (Query """
              INSERT INTO jsons (json, jsonb)
              VALUES ($1, $2)
            """) (Row2 input input)

            (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
            liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js

          test handle "handling Argonaut.Json as json and jsonb for an array" $ do
            let input = Argonaut.fromArray [ Argonaut.fromObject (Object.fromFoldable [ Tuple "a" (Argonaut.fromString "value") ])]

            execute handle (Query """
              INSERT INTO jsons (json, jsonb)
              VALUES ($1, $2)
            """) (Row2 input input)

            (js ∷ Array (Row2 (Json) (Json))) <- query handle (Query """SELECT * FROM JSONS""") Row0
            liftEffect $ assert $ all (\(Row2 j1 j2) → j1 == input && j2 == input) js

          test handle "handling jsdate value" $ do
            let
              jsd1 = jsdate_ 2010.0 2.0 31.0 6.0 23.0 1.0 123.0
              jsd2 = jsdate_ 2017.0 2.0 1.0 12.0 59.0 42.0 999.0
              jsd3 = jsdate_ 2020.0 6.0 31.0 23.0 3.0 59.0 333.0

            execute handle (Query """
              INSERT INTO timestamps (timestamp)
              VALUES ($1), ($2), ($3)
            """) (Row3 jsd1 jsd2 jsd3)

            (timestamps :: Array (Row1 JSDate)) <- query handle (Query """
              SELECT *
              FROM timestamps
              ORDER BY timestamp ASC
            """) Row0
            pgEqual 3 (length timestamps)
            liftEffect <<< assert $ all (\(Tuple (Row1 r) e) -> e == r) $ (zip timestamps [jsd1, jsd2, jsd3])

        suite "PostgreSQL connection errors" $ do
          let doNothing _ = pure unit

          Test.Unit.test "connection refused" do
            testPool <- liftEffect $ Pool.new (cannotConnectConfig config)
            runExceptT (withConnection testPool doNothing) >>= case _ of
              Left (ConnectionError cause) -> equal cause "ECONNREFUSED"
              _ -> Test.Unit.failure "foo"

          Test.Unit.test "no such database" do
            testPool <- liftEffect $ Pool.new (noSuchDatabaseConfig config)
            runExceptT (withConnection testPool doNothing) >>= case _ of
              Left (ProgrammingError { code, message }) -> equal code "3D000"
              _ -> Test.Unit.failure "PostgreSQL error was expected"

          Test.Unit.test "get pool configuration from postgres uri" do
            equal (parseURI validUriToPoolConfigs.uri) (Just validUriToPoolConfigs.poolConfig)
            equal (parseURI notValidConnUri) Nothing

validUriToPoolConfigs :: { uri :: PGConnectionURI
                         , poolConfig :: Configuration }
validUriToPoolConfigs = { uri: "postgres://urllgqrivcyako:c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"
                        , poolConfig: { database: "e7cecg4nirunpo"
                                      , host: Just "ec2-79-124-25-231.eu-west-1.compute.amazonaws.com"
                                      , idleTimeoutMillis: Nothing
                                      , max: Nothing
                                      , password: Just "c52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969"
                                      , port: Just 5432
                                      , user: Just "urllgqrivcyako"
                                      }
                        }

notValidConnUri :: PGConnectionURI
notValidConnUri = "postgres://urllgqrivcyakoc52275a95b7f177e2850c49de9bfa8bedc457ce860ccca664cb15db973554969@ec2-79-124-25-231.eu-west-1.compute.amazonaws.com:5432/e7cecg4nirunpo"

foreign import unsafeStringify :: forall a. a -> String