hasql/library/Hasql.hs

-- |
-- This module provides a low-level effectful API dealing with connections to the database.
-- 
-- The API is completely disinfected from exceptions. All error-reporting is explicit and is presented using the 'Either' type.
module Hasql
(
  -- * Connection settings
  Settings.Settings(..),
  Settings.settings,
  -- * Connection
  Connection,
  ConnectionError(..),
  connect,
  disconnect,
  -- * Query
  Query(..),
  ResultsError(..),
  ResultError(..),
  RowError(..),
  query,
)
where

import Hasql.Prelude
import qualified Database.PostgreSQL.LibPQ as LibPQ
import qualified Hasql.PreparedStatementRegistry as PreparedStatementRegistry
import qualified Hasql.Decoding.Results as ResultsDecoding
import qualified Hasql.Decoding as Decoding
import qualified Hasql.Encoding.Params as ParamsEncoding
import qualified Hasql.Encoding as Encoding
import qualified Hasql.Settings as Settings
import qualified Hasql.IO as IO


-- |
-- A single connection to the database.
data Connection =
  Connection !LibPQ.Connection !Bool !PreparedStatementRegistry.PreparedStatementRegistry

-- |
-- An error of the result-decoder.
data ResultsError =
  -- |
  -- An error on the client-side,
  -- with a message generated by the \"libpq\" library.
  -- Usually indicates problems with connection.
  ClientError !(Maybe ByteString) |
  -- |
  -- Decoder error details.
  ResultError !ResultError
  deriving (Show, Eq)

-- |
-- Decoder error details.
data ResultError =
  -- | 
  -- An error reported by the DB.
  -- Consists of the following: Code, message, details, hint.
  -- 
  -- * __Code__.
  -- The SQLSTATE code for the error.
  -- It's recommended to use
  -- <http://hackage.haskell.org/package/postgresql-error-codes the "postgresql-error-codes" package>
  -- to work with those.
  -- 
  -- * __Message__.
  -- The primary human-readable error message (typically one line). Always present.
  -- 
  -- * __Details__.
  -- An optional secondary error message carrying more detail about the problem. 
  -- Might run to multiple lines.
  -- 
  -- * __Hint__.
  -- An optional suggestion on what to do about the problem. 
  -- This is intended to differ from detail in that it offers advice (potentially inappropriate) 
  -- rather than hard facts.
  -- Might run to multiple lines.
  ServerError !ByteString !ByteString !(Maybe ByteString) !(Maybe ByteString) |
  -- |
  -- The database returned an unexpected result.
  -- Indicates an improper statement or a schema mismatch.
  UnexpectedResult !Text |
  -- |
  -- An error of the row reader, preceded by the index of the row.
  RowError !Int !RowError |
  -- |
  -- An unexpected amount of rows.
  UnexpectedAmountOfRows !Int
  deriving (Show, Eq)

-- |
-- An error during the decoding of a specific row.
data RowError =
  -- |
  -- Appears on the attempt to parse more columns than there are in the result.
  EndOfInput |
  -- |
  -- Appears on the attempt to parse a @NULL@ as some value.
  UnexpectedNull |
  -- |
  -- Appears when a wrong value parser is used.
  -- Comes with the error details.
  ValueError !Text
  deriving (Show, Eq)

-- |
-- Possible details of the connection acquistion error.
type ConnectionError =
  Maybe ByteString

-- |
-- Acquire a connection using the provided settings.
connect :: Settings.Settings -> IO (Either ConnectionError Connection)
connect settings =
  {-# SCC "connect" #-} 
  runEitherT $ do
    pqConnection <- lift (IO.acquireConnection settings)
    lift (IO.checkConnectionStatus pqConnection) >>= traverse left
    lift (IO.initConnection pqConnection)
    integerDatetimes <- lift (IO.getIntegerDatetimes pqConnection)
    registry <- lift (IO.acquirePreparedStatementRegistry)
    pure (Connection pqConnection integerDatetimes registry)

-- |
-- Release the connection.
disconnect :: Connection -> IO ()
disconnect (Connection pqConnection _ _) =
  LibPQ.finish pqConnection


-- |
-- A specification of a strictly single-statement query, which can be parameterized and prepared.
-- 
-- Consists of the following:
-- 
-- * SQL template,
-- * params encoder,
-- * result decoder,
-- * a flag, determining whether it should be prepared.
-- 
-- The SQL template must be formatted according to Postgres' standard,
-- with any non-ASCII characters of the template must be encoded using UTF-8.
-- According to the format,
-- parameters must be referred to using the positional notation, as in the following:
-- @$1@, @$2@, @$3@ and etc.
-- Those references must be used to refer to the values of the 'Encoding.Params' encoder.
-- 
-- Following is an example of the declaration of a prepared statement with its associated codecs.
-- 
-- @
-- selectSum :: Hasql.'Hasql.Query' (Int64, Int64) Int64
-- selectSum =
--   Hasql.'Hasql.Query' sql encoder decoder True
--   where
--     sql =
--       "select ($1 + $2)"
--     encoder =
--       'contramap' 'fst' (Hasql.Encoding.'Hasql.Encoding.value' Hasql.Encoding.'Hasql.Encoding.int8') '<>'
--       'contramap' 'snd' (Hasql.Encoding.'Hasql.Encoding.value' Hasql.Encoding.'Hasql.Encoding.int8')
--     decoder =
--       Hasql.Decoding.'Hasql.Decoding.singleRow' (Hasql.Decoding.'Hasql.Decoding.value' Hasql.Decoding.'Hasql.Decoding.int8')
-- @
-- 
-- The statement above accepts a product of two parameters of type 'Int64'
-- and results in a single result of type 'Int64'.
-- 
data Query a b =
  Query !ByteString !(Encoding.Params a) !(Decoding.Result b) !Bool
  deriving (Functor)

instance Profunctor Query where
  {-# INLINE lmap #-}
  lmap f (Query p1 p2 p3 p4) =
    Query p1 (contramap f p2) p3 p4
  {-# INLINE rmap #-}
  rmap f (Query p1 p2 p3 p4) =
    Query p1 p2 (fmap f p3) p4
  {-# INLINE dimap #-}
  dimap f1 f2 (Query p1 p2 p3 p4) =
    Query p1 (contramap f1 p2) (fmap f2 p3) p4

-- |
-- Execute a parametric query, producing either a deserialization failure or a successful result.
query :: Connection -> Query a b -> a -> IO (Either ResultsError b)
query (Connection pqConnection integerDatetimes registry) (Query template encoder decoder preparable) params =
  {-# SCC "query" #-} 
  fmap (mapLeft coerceResultsError) $ runEitherT $ do
    EitherT $ IO.sendParametricQuery pqConnection integerDatetimes registry template (coerceEncoder encoder) preparable params
    EitherT $ IO.getResults pqConnection integerDatetimes (coerceDecoder decoder)

-- |
-- WARNING: We need to take special care that the structure of
-- the "ResultsDecoding.Error" type in the public API is an exact copy of
-- "Error", since we're using coercion.
coerceResultsError :: ResultsDecoding.Error -> ResultsError
coerceResultsError =
  unsafeCoerce

coerceDecoder :: Decoding.Result a -> ResultsDecoding.Results a
coerceDecoder =
  unsafeCoerce

coerceEncoder :: Encoding.Params a -> ParamsEncoding.Params a
coerceEncoder =
  unsafeCoerce