{-# LANGUAGE  CPP, BangPatterns, DoAndIfThenElse, RecordWildCards  #-}
{-# LANGUAGE  DeriveDataTypeable, DeriveGeneric                    #-}
{-# LANGUAGE  GeneralizedNewtypeDeriving                           #-}

------------------------------------------------------------------------------
-- |
-- Module:      Database.PostgreSQL.Simple.Internal
-- Copyright:   (c) 2011-2015 Leon P Smith
-- License:     BSD3
-- Maintainer:  Leon P Smith <leon@melding-monads.com>
-- Stability:   experimental
--
-- Internal bits.  This interface is less stable and can change at any time.
-- In particular this means that while the rest of the postgresql-simple
-- package endeavors to follow the package versioning policy,  this module
-- does not.  Also, at the moment there are things in here that aren't
-- particularly internal and are exported elsewhere;  these will eventually
-- disappear from this module.
--
------------------------------------------------------------------------------

module Database.PostgreSQL.Simple.Internal where

import           Control.Applicative
import           Control.Exception
import           Control.Concurrent.MVar
import           Control.Monad(MonadPlus(..))
import           Data.ByteString(ByteString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import           Data.ByteString.Builder ( Builder, byteString )
import           Data.Char (ord)
import           Data.Int (Int64)
import qualified Data.IntMap as IntMap
import           Data.IORef
import           Data.Maybe(fromMaybe)
import           Data.Monoid
import           Data.String
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import           Data.Typeable
import           Data.Word
import           Database.PostgreSQL.LibPQ(Oid(..))
import qualified Database.PostgreSQL.LibPQ as PQ
import           Database.PostgreSQL.LibPQ(ExecStatus(..))
import           Database.PostgreSQL.Simple.Compat ( toByteString )
import           Database.PostgreSQL.Simple.Ok
import           Database.PostgreSQL.Simple.ToField (Action(..), inQuotes)
import           Database.PostgreSQL.Simple.Types (Query(..))
import           Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)
import           Control.Monad.Trans.State.Strict
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.Class
import           GHC.Generics
import           GHC.IO.Exception
#if !defined(mingw32_HOST_OS)
import           Control.Concurrent(threadWaitRead, threadWaitWrite)
#endif

-- | A Field represents metadata about a particular field
--
-- You don't particularly want to retain these structures for a long
-- period of time,  as they will retain the entire query result,  not
-- just the field metadata

data Field = Field {
     Field -> Result
result   :: !PQ.Result
   , Field -> Column
column   :: {-# UNPACK #-} !PQ.Column
   , Field -> Oid
typeOid  :: {-# UNPACK #-} !PQ.Oid
     -- ^ This returns the type oid associated with the column.  Analogous
     --   to libpq's @PQftype@.
   }

type TypeInfoCache = IntMap.IntMap TypeInfo

data Connection = Connection {
     Connection -> MVar Connection
connectionHandle  :: {-# UNPACK #-} !(MVar PQ.Connection)
   , Connection -> MVar TypeInfoCache
connectionObjects :: {-# UNPACK #-} !(MVar TypeInfoCache)
   , Connection -> IORef Int64
connectionTempNameCounter :: {-# UNPACK #-} !(IORef Int64)
   } deriving (Typeable)

instance Eq Connection where
   Connection
x == :: Connection -> Connection -> Bool
== Connection
y = Connection -> MVar Connection
connectionHandle Connection
x forall a. Eq a => a -> a -> Bool
== Connection -> MVar Connection
connectionHandle Connection
y

data SqlError = SqlError {
     SqlError -> ByteString
sqlState       :: ByteString
   , SqlError -> ExecStatus
sqlExecStatus  :: ExecStatus
   , SqlError -> ByteString
sqlErrorMsg    :: ByteString
   , SqlError -> ByteString
sqlErrorDetail :: ByteString
   , SqlError -> ByteString
sqlErrorHint   :: ByteString
   } deriving (SqlError -> SqlError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SqlError -> SqlError -> Bool
$c/= :: SqlError -> SqlError -> Bool
== :: SqlError -> SqlError -> Bool
$c== :: SqlError -> SqlError -> Bool
Eq, Int -> SqlError -> ShowS
[SqlError] -> ShowS
SqlError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SqlError] -> ShowS
$cshowList :: [SqlError] -> ShowS
show :: SqlError -> [Char]
$cshow :: SqlError -> [Char]
showsPrec :: Int -> SqlError -> ShowS
$cshowsPrec :: Int -> SqlError -> ShowS
Show, Typeable)

fatalError :: ByteString -> SqlError
fatalError :: ByteString -> SqlError
fatalError ByteString
msg = ByteString
-> ExecStatus -> ByteString -> ByteString -> ByteString -> SqlError
SqlError ByteString
"" ExecStatus
FatalError ByteString
msg ByteString
"" ByteString
""

instance Exception SqlError

-- | Exception thrown if 'query' is used to perform an @INSERT@-like
-- operation, or 'execute' is used to perform a @SELECT@-like operation.
data QueryError = QueryError {
      QueryError -> [Char]
qeMessage :: String
    , QueryError -> Query
qeQuery :: Query
    } deriving (QueryError -> QueryError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryError -> QueryError -> Bool
$c/= :: QueryError -> QueryError -> Bool
== :: QueryError -> QueryError -> Bool
$c== :: QueryError -> QueryError -> Bool
Eq, Int -> QueryError -> ShowS
[QueryError] -> ShowS
QueryError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [QueryError] -> ShowS
$cshowList :: [QueryError] -> ShowS
show :: QueryError -> [Char]
$cshow :: QueryError -> [Char]
showsPrec :: Int -> QueryError -> ShowS
$cshowsPrec :: Int -> QueryError -> ShowS
Show, Typeable)

instance Exception QueryError

-- | Exception thrown if a 'Query' could not be formatted correctly.
-- This may occur if the number of \'@?@\' characters in the query
-- string does not match the number of parameters provided.
data FormatError = FormatError {
      FormatError -> [Char]
fmtMessage :: String
    , FormatError -> Query
fmtQuery :: Query
    , FormatError -> [ByteString]
fmtParams :: [ByteString]
    } deriving (FormatError -> FormatError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormatError -> FormatError -> Bool
$c/= :: FormatError -> FormatError -> Bool
== :: FormatError -> FormatError -> Bool
$c== :: FormatError -> FormatError -> Bool
Eq, Int -> FormatError -> ShowS
[FormatError] -> ShowS
FormatError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [FormatError] -> ShowS
$cshowList :: [FormatError] -> ShowS
show :: FormatError -> [Char]
$cshow :: FormatError -> [Char]
showsPrec :: Int -> FormatError -> ShowS
$cshowsPrec :: Int -> FormatError -> ShowS
Show, Typeable)

instance Exception FormatError

data ConnectInfo = ConnectInfo {
      ConnectInfo -> [Char]
connectHost :: String
    , ConnectInfo -> Word16
connectPort :: Word16
    , ConnectInfo -> [Char]
connectUser :: String
    , ConnectInfo -> [Char]
connectPassword :: String
    , ConnectInfo -> [Char]
connectDatabase :: String
    } deriving (forall x. Rep ConnectInfo x -> ConnectInfo
forall x. ConnectInfo -> Rep ConnectInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConnectInfo x -> ConnectInfo
$cfrom :: forall x. ConnectInfo -> Rep ConnectInfo x
Generic,ConnectInfo -> ConnectInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectInfo -> ConnectInfo -> Bool
$c/= :: ConnectInfo -> ConnectInfo -> Bool
== :: ConnectInfo -> ConnectInfo -> Bool
$c== :: ConnectInfo -> ConnectInfo -> Bool
Eq,ReadPrec [ConnectInfo]
ReadPrec ConnectInfo
Int -> ReadS ConnectInfo
ReadS [ConnectInfo]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConnectInfo]
$creadListPrec :: ReadPrec [ConnectInfo]
readPrec :: ReadPrec ConnectInfo
$creadPrec :: ReadPrec ConnectInfo
readList :: ReadS [ConnectInfo]
$creadList :: ReadS [ConnectInfo]
readsPrec :: Int -> ReadS ConnectInfo
$creadsPrec :: Int -> ReadS ConnectInfo
Read,Int -> ConnectInfo -> ShowS
[ConnectInfo] -> ShowS
ConnectInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ConnectInfo] -> ShowS
$cshowList :: [ConnectInfo] -> ShowS
show :: ConnectInfo -> [Char]
$cshow :: ConnectInfo -> [Char]
showsPrec :: Int -> ConnectInfo -> ShowS
$cshowsPrec :: Int -> ConnectInfo -> ShowS
Show,Typeable)

-- | Default information for setting up a connection.
--
-- Defaults are as follows:
--
-- * Server on @localhost@
--
-- * Port on @5432@
--
-- * User @postgres@
--
-- * No password
--
-- * Database @postgres@
--
-- Use as in the following example:
--
-- > connect defaultConnectInfo { connectHost = "db.example.com" }

defaultConnectInfo :: ConnectInfo
defaultConnectInfo :: ConnectInfo
defaultConnectInfo = ConnectInfo {
                       connectHost :: [Char]
connectHost = [Char]
"127.0.0.1"
                     , connectPort :: Word16
connectPort = Word16
5432
                     , connectUser :: [Char]
connectUser = [Char]
"postgres"
                     , connectPassword :: [Char]
connectPassword = [Char]
""
                     , connectDatabase :: [Char]
connectDatabase = [Char]
""
                     }

-- | Connect with the given username to the given database. Will throw
--   an exception if it cannot connect.
connect :: ConnectInfo -> IO Connection
connect :: ConnectInfo -> IO Connection
connect = ByteString -> IO Connection
connectPostgreSQL forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectInfo -> ByteString
postgreSQLConnectionString

-- | Memory bracket around 'connect' and 'close'.
--
-- @since 0.6.5
withConnect :: ConnectInfo -> (Connection -> IO c) -> IO c
withConnect :: forall c. ConnectInfo -> (Connection -> IO c) -> IO c
withConnect ConnectInfo
connInfo = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (ConnectInfo -> IO Connection
connect ConnectInfo
connInfo) Connection -> IO ()
close

-- | Attempt to make a connection based on a libpq connection string.
--   See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
--   for more information.  Also note that environment variables also affect
--   parameters not provided, parameters provided as the empty string, and a
--   few other things; see
--   <https://www.postgresql.org/docs/9.5/static/libpq-envars.html>
--   for details.  Here is an example with some of the most commonly used
--   parameters:
--
-- > host='db.somedomain.com' port=5432 ...
--
--   This attempts to connect to @db.somedomain.com:5432@.  Omitting the port
--   will normally default to 5432.
--
--   On systems that provide unix domain sockets,  omitting the host parameter
--   will cause libpq to attempt to connect via unix domain sockets.
--   The default filesystem path to the socket is constructed from the
--   port number and the @DEFAULT_PGSOCKET_DIR@ constant defined in the
--   @pg_config_manual.h@ header file.  Connecting via unix sockets tends
--   to use the @peer@ authentication method, which is very secure and
--   does not require a password.
--
--   On Windows and other systems without unix domain sockets, omitting
--   the host will default to @localhost@.
--
-- > ... dbname='postgres' user='postgres' password='secret \' \\ pw'
--
--   This attempts to connect to a database named @postgres@ with
--   user @postgres@ and password @secret \' \\ pw@.  Backslash
--   characters will have to be double-quoted in literal Haskell strings,
--   of course.  Omitting @dbname@ and @user@ will both default to the
--   system username that the client process is running as.
--
--   Omitting @password@ will default to an appropriate password found
--   in the @pgpass@ file,  or no password at all if a matching line is
--   not found.  The path of the @pgpass@ file may be specified by setting
--   the @PGPASSFILE@ environment variable. See
--   <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for
--   more information regarding this file.
--
--   As all parameters are optional and the defaults are sensible,  the
--   empty connection string can be useful for development and
--   exploratory use,  assuming your system is set up appropriately.
--
--   On Unix,  such a setup would typically consist of a local
--   postgresql server listening on port 5432,  as well as a system user,
--   database user, and database sharing a common name,  with permissions
--   granted to the user on the database.
--
--   On Windows,  in addition you will either need @pg_hba.conf@
--   to specify the use of the @trust@ authentication method for
--   the connection,  which may not be appropriate for multiuser
--   or production machines, or you will need to use a @pgpass@ file
--   with the @password@ or @md5@ authentication methods.
--
--   See <https://www.postgresql.org/docs/9.5/static/client-authentication.html>
--   for more information regarding the authentication process.
--
--   SSL/TLS will typically "just work" if your postgresql server supports or
--   requires it.  However,  note that libpq is trivially vulnerable to a MITM
--   attack without setting additional SSL connection parameters.  In
--   particular,  @sslmode@ needs to be set to @require@, @verify-ca@, or
--   @verify-full@ in order to perform certificate validation.  When @sslmode@
--   is @require@,  then you will also need to specify a @sslrootcert@ file,
--   otherwise no validation of the server's identity will be performed.
--   Client authentication via certificates is also possible via the
--   @sslcert@ and @sslkey@ parameters.   See
--   <https://www.postgresql.org/docs/9.5/static/libpq-ssl.html>
--   for detailed information regarding libpq and SSL.

connectPostgreSQL :: ByteString -> IO Connection
connectPostgreSQL :: ByteString -> IO Connection
connectPostgreSQL ByteString
connstr = do
    Connection
conn <- ByteString -> IO Connection
connectdb ByteString
connstr
    ConnStatus
stat <- Connection -> IO ConnStatus
PQ.status Connection
conn
    case ConnStatus
stat of
      ConnStatus
PQ.ConnectionOk -> do
          MVar Connection
connectionHandle  <- forall a. a -> IO (MVar a)
newMVar Connection
conn
          MVar TypeInfoCache
connectionObjects <- forall a. a -> IO (MVar a)
newMVar (forall a. IntMap a
IntMap.empty)
          IORef Int64
connectionTempNameCounter <- forall a. a -> IO (IORef a)
newIORef Int64
0
          let wconn :: Connection
wconn = Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
..}
          Int
version <- Connection -> IO Int
PQ.serverVersion Connection
conn
          let settings :: Query
settings
                | Int
version forall a. Ord a => a -> a -> Bool
< Int
80200 = Query
"SET datestyle TO ISO;SET client_encoding TO UTF8"
                | Bool
otherwise       = Query
"SET datestyle TO ISO;SET client_encoding TO UTF8;SET standard_conforming_strings TO on"
          Int64
_ <- Connection -> Query -> IO Int64
execute_ Connection
wconn Query
settings
          forall (m :: * -> *) a. Monad m => a -> m a
return Connection
wconn
      ConnStatus
_ -> do
          ByteString
msg <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"connectPostgreSQL error" forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
PQ.errorMessage Connection
conn
          forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ ByteString -> SqlError
fatalError ByteString
msg

connectdb :: ByteString -> IO PQ.Connection
#if defined(mingw32_HOST_OS)
connectdb = PQ.connectdb
#else
connectdb :: ByteString -> IO Connection
connectdb ByteString
conninfo = do
    Connection
conn <- ByteString -> IO Connection
PQ.connectStart ByteString
conninfo
    Connection -> IO Connection
loop Connection
conn
  where
    funcName :: ByteString
funcName = ByteString
"Database.PostgreSQL.Simple.connectPostgreSQL"
    loop :: Connection -> IO Connection
loop Connection
conn = do
      PollingStatus
status <- Connection -> IO PollingStatus
PQ.connectPoll Connection
conn
      case PollingStatus
status of
        PollingStatus
PQ.PollingFailed  -> forall a. Connection -> ByteString -> IO a
throwLibPQError Connection
conn ByteString
"connection failed"
        PollingStatus
PQ.PollingReading -> do
                                Maybe Fd
mfd <- Connection -> IO (Maybe Fd)
PQ.socket Connection
conn
                                case Maybe Fd
mfd of
                                  Maybe Fd
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
fdError ByteString
funcName
                                  Just Fd
fd -> do
                                      Fd -> IO ()
threadWaitRead Fd
fd
                                      Connection -> IO Connection
loop Connection
conn
        PollingStatus
PQ.PollingWriting -> do
                                Maybe Fd
mfd <- Connection -> IO (Maybe Fd)
PQ.socket Connection
conn
                                case Maybe Fd
mfd of
                                  Maybe Fd
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
fdError ByteString
funcName
                                  Just Fd
fd -> do
                                      Fd -> IO ()
threadWaitWrite Fd
fd
                                      Connection -> IO Connection
loop Connection
conn
        PollingStatus
PQ.PollingOk      -> forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn

#endif

-- | Turns a 'ConnectInfo' data structure into a libpq connection string.

postgreSQLConnectionString :: ConnectInfo -> ByteString
postgreSQLConnectionString :: ConnectInfo -> ByteString
postgreSQLConnectionString ConnectInfo
connectInfo = forall a. IsString a => [Char] -> a
fromString [Char]
connstr
  where
    connstr :: [Char]
connstr = forall {t :: * -> *}.
Foldable t =>
[Char] -> (ConnectInfo -> t Char) -> ShowS
str [Char]
"host="     ConnectInfo -> [Char]
connectHost
            forall a b. (a -> b) -> a -> b
$ forall {a}.
(Ord a, Num a, Show a) =>
[Char] -> (ConnectInfo -> a) -> ShowS
num [Char]
"port="     ConnectInfo -> Word16
connectPort
            forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
Foldable t =>
[Char] -> (ConnectInfo -> t Char) -> ShowS
str [Char]
"user="     ConnectInfo -> [Char]
connectUser
            forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
Foldable t =>
[Char] -> (ConnectInfo -> t Char) -> ShowS
str [Char]
"password=" ConnectInfo -> [Char]
connectPassword
            forall a b. (a -> b) -> a -> b
$ forall {t :: * -> *}.
Foldable t =>
[Char] -> (ConnectInfo -> t Char) -> ShowS
str [Char]
"dbname="   ConnectInfo -> [Char]
connectDatabase
            forall a b. (a -> b) -> a -> b
$ []

    str :: [Char] -> (ConnectInfo -> t Char) -> ShowS
str [Char]
name ConnectInfo -> t Char
field
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null t Char
value = forall a. a -> a
id
      | Bool
otherwise  = [Char] -> ShowS
showString [Char]
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t :: * -> *}. Foldable t => t Char -> ShowS
addQuotes t Char
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
        where value :: t Char
value = ConnectInfo -> t Char
field ConnectInfo
connectInfo

    num :: [Char] -> (ConnectInfo -> a) -> ShowS
num [Char]
name ConnectInfo -> a
field
      | a
value forall a. Ord a => a -> a -> Bool
<= a
0 = forall a. a -> a
id
      | Bool
otherwise  = [Char] -> ShowS
showString [Char]
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows a
value forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
space
        where value :: a
value = ConnectInfo -> a
field ConnectInfo
connectInfo

    addQuotes :: t Char -> ShowS
addQuotes t Char
s [Char]
rest = Char
'\'' forall a. a -> [a] -> [a]
: forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Char -> ShowS
delta (Char
'\'' forall a. a -> [a] -> [a]
: [Char]
rest) t Char
s
       where
         delta :: Char -> ShowS
delta Char
c [Char]
cs = case Char
c of
                        Char
'\\' -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'\\' forall a. a -> [a] -> [a]
: [Char]
cs
                        Char
'\'' -> Char
'\\' forall a. a -> [a] -> [a]
: Char
'\'' forall a. a -> [a] -> [a]
: [Char]
cs
                        Char
_    -> Char
c forall a. a -> [a] -> [a]
: [Char]
cs

    space :: ShowS
space [] = []
    space [Char]
xs = Char
' 'forall a. a -> [a] -> [a]
:[Char]
xs



oid2int :: Oid -> Int
oid2int :: Oid -> Int
oid2int (Oid CUInt
x) = forall a b. (Integral a, Num b) => a -> b
fromIntegral CUInt
x
{-# INLINE oid2int #-}

exec :: Connection
     -> ByteString
     -> IO PQ.Result
#if defined(mingw32_HOST_OS)
exec conn sql =
    withConnection conn $ \h -> do
        mres <- PQ.exec h sql
        case mres of
          Nothing  -> throwLibPQError h "PQexec returned no results"
          Just res -> return res
#else
exec :: Connection -> ByteString -> IO Result
exec Connection
conn ByteString
sql =
    forall a. Connection -> (Connection -> IO a) -> IO a
withConnection Connection
conn forall a b. (a -> b) -> a -> b
$ \Connection
h -> do
        Bool
success <- Connection -> ByteString -> IO Bool
PQ.sendQuery Connection
h ByteString
sql
        if Bool
success
        then Connection -> Maybe Result -> IO Result
awaitResult Connection
h forall a. Maybe a
Nothing
        else forall a. Connection -> ByteString -> IO a
throwLibPQError Connection
h ByteString
"PQsendQuery failed"
  where
    awaitResult :: Connection -> Maybe Result -> IO Result
awaitResult Connection
h Maybe Result
mres = do
        Maybe Fd
mfd <- Connection -> IO (Maybe Fd)
PQ.socket Connection
h
        case Maybe Fd
mfd of
          Maybe Fd
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
fdError ByteString
"Database.PostgreSQL.Simple.Internal.exec"
          Just Fd
fd -> do
             Fd -> IO ()
threadWaitRead Fd
fd
             Bool
_ <- Connection -> IO Bool
PQ.consumeInput Connection
h  -- FIXME?
             Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres

    getResult :: Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres = do
        Bool
isBusy <- Connection -> IO Bool
PQ.isBusy Connection
h
        if Bool
isBusy
        then Connection -> Maybe Result -> IO Result
awaitResult Connection
h Maybe Result
mres
        else do
          Maybe Result
mres' <- Connection -> IO (Maybe Result)
PQ.getResult Connection
h
          case Maybe Result
mres' of
            Maybe Result
Nothing -> case Maybe Result
mres of
                         Maybe Result
Nothing  -> forall a. Connection -> ByteString -> IO a
throwLibPQError Connection
h ByteString
"PQgetResult returned no results"
                         Just Result
res -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
res
            Just Result
res -> do
                ExecStatus
status <- Result -> IO ExecStatus
PQ.resultStatus Result
res
                case ExecStatus
status of
                   -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple
                   ExecStatus
PQ.EmptyQuery    -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.CommandOk     -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.TuplesOk      -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.CopyOut       -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
res
                   ExecStatus
PQ.CopyIn        -> forall (m :: * -> *) a. Monad m => a -> m a
return Result
res
                   ExecStatus
PQ.BadResponse   -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.NonfatalError -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
                   ExecStatus
PQ.FatalError    -> Connection -> Maybe Result -> IO Result
getResult Connection
h Maybe Result
mres'
#endif

-- | A version of 'execute' that does not perform query substitution.
execute_ :: Connection -> Query -> IO Int64
execute_ :: Connection -> Query -> IO Int64
execute_ Connection
conn q :: Query
q@(Query ByteString
stmt) = do
  Result
result <- Connection -> ByteString -> IO Result
exec Connection
conn ByteString
stmt
  Connection -> Query -> Result -> IO Int64
finishExecute Connection
conn Query
q Result
result

finishExecute :: Connection -> Query -> PQ.Result -> IO Int64
finishExecute :: Connection -> Query -> Result -> IO Int64
finishExecute Connection
_conn Query
q Result
result = do
    ExecStatus
status <- Result -> IO ExecStatus
PQ.resultStatus Result
result
    case ExecStatus
status of
      -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple
      ExecStatus
PQ.EmptyQuery -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> QueryError
QueryError [Char]
"execute: Empty query" Query
q
      ExecStatus
PQ.CommandOk -> do
          Column
ncols <- Result -> IO Column
PQ.nfields Result
result
          if Column
ncols forall a. Eq a => a -> a -> Bool
/= Column
0
          then forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> QueryError
QueryError ([Char]
"execute resulted in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Column
ncols forall a. [a] -> [a] -> [a]
++
                                     [Char]
"-column result") Query
q
          else do
            Maybe ByteString
nstr <- Result -> IO (Maybe ByteString)
PQ.cmdTuples Result
result
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case Maybe ByteString
nstr of
                       Maybe ByteString
Nothing  -> Int64
0   -- is this appropriate?
                       Just ByteString
str -> forall {a}. Num a => ByteString -> a
mkInteger ByteString
str
      ExecStatus
PQ.TuplesOk -> do
          Column
ncols <- Result -> IO Column
PQ.nfields Result
result
          forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> QueryError
QueryError ([Char]
"execute resulted in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Column
ncols forall a. [a] -> [a] -> [a]
++
                                 [Char]
"-column result") Query
q
      ExecStatus
PQ.CopyOut ->
          forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> QueryError
QueryError [Char]
"execute: COPY TO is not supported" Query
q
      ExecStatus
PQ.CopyIn ->
          forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> Query -> QueryError
QueryError [Char]
"execute: COPY FROM is not supported" Query
q
      ExecStatus
PQ.BadResponse   -> forall a. ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
"execute" Result
result ExecStatus
status
      ExecStatus
PQ.NonfatalError -> forall a. ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
"execute" Result
result ExecStatus
status
      ExecStatus
PQ.FatalError    -> forall a. ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
"execute" Result
result ExecStatus
status
    where
     mkInteger :: ByteString -> a
mkInteger ByteString
str = forall a. (a -> Char -> a) -> a -> ByteString -> a
B8.foldl' forall {a}. Num a => a -> Char -> a
delta a
0 ByteString
str
                where
                  delta :: a -> Char -> a
delta a
acc Char
c =
                    if Char
'0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9'
                    then a
10 forall a. Num a => a -> a -> a
* a
acc forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'0')
                    else forall a. HasCallStack => [Char] -> a
error ([Char]
"finishExecute:  not an int: " forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
B8.unpack ByteString
str)

throwResultError :: ByteString -> PQ.Result -> PQ.ExecStatus -> IO a
throwResultError :: forall a. ByteString -> Result -> ExecStatus -> IO a
throwResultError ByteString
_ Result
result ExecStatus
status = do
    ByteString
errormsg  <- forall a. a -> Maybe a -> a
fromMaybe ByteString
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagMessagePrimary
    ByteString
detail    <- forall a. a -> Maybe a -> a
fromMaybe ByteString
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagMessageDetail
    ByteString
hint      <- forall a. a -> Maybe a -> a
fromMaybe ByteString
"" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
                 Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagMessageHint
    ByteString
state'    <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> FieldCode -> IO (Maybe ByteString)
PQ.resultErrorField Result
result FieldCode
PQ.DiagSqlstate
    forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ SqlError { sqlState :: ByteString
sqlState = ByteString
state'
                       , sqlExecStatus :: ExecStatus
sqlExecStatus = ExecStatus
status
                       , sqlErrorMsg :: ByteString
sqlErrorMsg = ByteString
errormsg
                       , sqlErrorDetail :: ByteString
sqlErrorDetail = ByteString
detail
                       , sqlErrorHint :: ByteString
sqlErrorHint = ByteString
hint }

disconnectedError :: SqlError
disconnectedError :: SqlError
disconnectedError = ByteString -> SqlError
fatalError ByteString
"connection disconnected"

-- | Atomically perform an action with the database handle, if there is one.
withConnection :: Connection -> (PQ.Connection -> IO a) -> IO a
withConnection :: forall a. Connection -> (Connection -> IO a) -> IO a
withConnection Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: Connection -> IORef Int64
connectionObjects :: Connection -> MVar TypeInfoCache
connectionHandle :: Connection -> MVar Connection
..} Connection -> IO a
m = do
    forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar Connection
connectionHandle forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
        if Connection -> Bool
PQ.isNullConnection Connection
conn
          then forall e a. Exception e => e -> IO a
throwIO SqlError
disconnectedError
          else Connection -> IO a
m Connection
conn

close :: Connection -> IO ()
close :: Connection -> IO ()
close Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: Connection -> IORef Int64
connectionObjects :: Connection -> MVar TypeInfoCache
connectionHandle :: Connection -> MVar Connection
..} =
    forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> (do
            Connection
conn <- forall a. MVar a -> IO a
takeMVar MVar Connection
connectionHandle
            forall a. IO a -> IO a
restore (Connection -> IO ()
PQ.finish Connection
conn)
        forall a b. IO a -> IO b -> IO a
`finally` do
            forall a. MVar a -> a -> IO ()
putMVar MVar Connection
connectionHandle forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Connection
PQ.newNullConnection
        )

newNullConnection :: IO Connection
newNullConnection :: IO Connection
newNullConnection = do
    MVar Connection
connectionHandle  <- forall a. a -> IO (MVar a)
newMVar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Connection
PQ.newNullConnection
    MVar TypeInfoCache
connectionObjects <- forall a. a -> IO (MVar a)
newMVar forall a. IntMap a
IntMap.empty
    IORef Int64
connectionTempNameCounter <- forall a. a -> IO (IORef a)
newIORef Int64
0
    forall (m :: * -> *) a. Monad m => a -> m a
return Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
..}

data Row = Row {
     Row -> Row
row        :: {-# UNPACK #-} !PQ.Row
   , Row -> Result
rowresult  :: !PQ.Result
   }

newtype RowParser a = RP { forall a. RowParser a -> ReaderT Row (StateT Column Conversion) a
unRP :: ReaderT Row (StateT PQ.Column Conversion) a }
   deriving ( forall a b. a -> RowParser b -> RowParser a
forall a b. (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> RowParser b -> RowParser a
$c<$ :: forall a b. a -> RowParser b -> RowParser a
fmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
$cfmap :: forall a b. (a -> b) -> RowParser a -> RowParser b
Functor, Functor RowParser
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. RowParser a -> RowParser b -> RowParser a
$c<* :: forall a b. RowParser a -> RowParser b -> RowParser a
*> :: forall a b. RowParser a -> RowParser b -> RowParser b
$c*> :: forall a b. RowParser a -> RowParser b -> RowParser b
liftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
$cliftA2 :: forall a b c.
(a -> b -> c) -> RowParser a -> RowParser b -> RowParser c
<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
$c<*> :: forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
pure :: forall a. a -> RowParser a
$cpure :: forall a. a -> RowParser a
Applicative, Applicative RowParser
forall a. RowParser a
forall a. RowParser a -> RowParser [a]
forall a. RowParser a -> RowParser a -> RowParser a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
many :: forall a. RowParser a -> RowParser [a]
$cmany :: forall a. RowParser a -> RowParser [a]
some :: forall a. RowParser a -> RowParser [a]
$csome :: forall a. RowParser a -> RowParser [a]
<|> :: forall a. RowParser a -> RowParser a -> RowParser a
$c<|> :: forall a. RowParser a -> RowParser a -> RowParser a
empty :: forall a. RowParser a
$cempty :: forall a. RowParser a
Alternative, Applicative RowParser
forall a. a -> RowParser a
forall a b. RowParser a -> RowParser b -> RowParser b
forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> RowParser a
$creturn :: forall a. a -> RowParser a
>> :: forall a b. RowParser a -> RowParser b -> RowParser b
$c>> :: forall a b. RowParser a -> RowParser b -> RowParser b
>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
$c>>= :: forall a b. RowParser a -> (a -> RowParser b) -> RowParser b
Monad )

liftRowParser :: IO a -> RowParser a
liftRowParser :: forall a. IO a -> RowParser a
liftRowParser = forall a. ReaderT Row (StateT Column Conversion) a -> RowParser a
RP forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IO a -> Conversion a
liftConversion

newtype Conversion a = Conversion { forall a. Conversion a -> Connection -> IO (Ok a)
runConversion :: Connection -> IO (Ok a) }

liftConversion :: IO a -> Conversion a
liftConversion :: forall a. IO a -> Conversion a
liftConversion IO a
m = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion (\Connection
_ -> forall a. a -> Ok a
Ok forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
m)

instance Functor Conversion where
   fmap :: forall a b. (a -> b) -> Conversion a -> Conversion b
fmap a -> b
f Conversion a
m = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f (forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
m Connection
conn)

instance Applicative Conversion where
   pure :: forall a. a -> Conversion a
pure a
a    = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
_conn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
   Conversion (a -> b)
mf <*> :: forall a b. Conversion (a -> b) -> Conversion a -> Conversion b
<*> Conversion a
ma = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                   Ok (a -> b)
okf <- forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion (a -> b)
mf Connection
conn
                   case Ok (a -> b)
okf of
                     Ok a -> b
f -> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) a -> b
f (forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
ma Connection
conn)
                     Errors [SomeException]
errs -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [SomeException] -> Ok a
Errors [SomeException]
errs)

instance Alternative Conversion where
   empty :: forall a. Conversion a
empty     = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
_conn -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (f :: * -> *) a. Alternative f => f a
empty
   Conversion a
ma <|> :: forall a. Conversion a -> Conversion a -> Conversion a
<|> Conversion a
mb = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                   Ok a
oka <- forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
ma Connection
conn
                   case Ok a
oka of
                     Ok a
_     -> forall (m :: * -> *) a. Monad m => a -> m a
return Ok a
oka
                     Errors [SomeException]
_ -> (Ok a
oka forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
mb Connection
conn

instance Monad Conversion where
#if !(MIN_VERSION_base(4,8,0))
   return = pure
#endif
   Conversion a
m >>= :: forall a b. Conversion a -> (a -> Conversion b) -> Conversion b
>>= a -> Conversion b
f = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
                 Ok a
oka <- forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
m Connection
conn
                 case Ok a
oka of
                   Ok a
a -> forall a. Conversion a -> Connection -> IO (Ok a)
runConversion (a -> Conversion b
f a
a) Connection
conn
                   Errors [SomeException]
err -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [SomeException] -> Ok a
Errors [SomeException]
err)

instance MonadPlus Conversion where
   mzero :: forall a. Conversion a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
   mplus :: forall a. Conversion a -> Conversion a -> Conversion a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)

conversionMap :: (Ok a -> Ok b) -> Conversion a -> Conversion b
conversionMap :: forall a b. (Ok a -> Ok b) -> Conversion a -> Conversion b
conversionMap Ok a -> Ok b
f Conversion a
m = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
conn -> Ok a -> Ok b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Conversion a -> Connection -> IO (Ok a)
runConversion Conversion a
m Connection
conn

conversionError :: Exception err => err -> Conversion a
conversionError :: forall err a. Exception err => err -> Conversion a
conversionError err
err = forall a. (Connection -> IO (Ok a)) -> Conversion a
Conversion forall a b. (a -> b) -> a -> b
$ \Connection
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. [SomeException] -> Ok a
Errors [forall e. Exception e => e -> SomeException
toException err
err])

newTempName :: Connection -> IO Query
newTempName :: Connection -> IO Query
newTempName Connection{IORef Int64
MVar TypeInfoCache
MVar Connection
connectionTempNameCounter :: IORef Int64
connectionObjects :: MVar TypeInfoCache
connectionHandle :: MVar Connection
connectionTempNameCounter :: Connection -> IORef Int64
connectionObjects :: Connection -> MVar TypeInfoCache
connectionHandle :: Connection -> MVar Connection
..} = do
    !Int64
n <- forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef IORef Int64
connectionTempNameCounter
          (\Int64
n -> let !n' :: Int64
n' = Int64
nforall a. Num a => a -> a -> a
+Int64
1 in (Int64
n', Int64
n'))
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! ByteString -> Query
Query forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
B8.pack forall a b. (a -> b) -> a -> b
$ [Char]
"temp" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Int64
n

-- FIXME?  What error should getNotification and getCopyData throw?
fdError :: ByteString -> IOError
fdError :: ByteString -> IOError
fdError ByteString
funcName = IOError {
                     ioe_handle :: Maybe Handle
ioe_handle      = forall a. Maybe a
Nothing,
                     ioe_type :: IOErrorType
ioe_type        = IOErrorType
ResourceVanished,
                     ioe_location :: [Char]
ioe_location    = ByteString -> [Char]
B8.unpack ByteString
funcName,
                     ioe_description :: [Char]
ioe_description = [Char]
"failed to fetch file descriptor",
                     ioe_errno :: Maybe CInt
ioe_errno       = forall a. Maybe a
Nothing,
                     ioe_filename :: Maybe [Char]
ioe_filename    = forall a. Maybe a
Nothing
                   }


libPQError :: ByteString -> IOError
libPQError :: ByteString -> IOError
libPQError ByteString
desc = IOError {
                    ioe_handle :: Maybe Handle
ioe_handle      = forall a. Maybe a
Nothing,
                    ioe_type :: IOErrorType
ioe_type        = IOErrorType
OtherError,
                    ioe_location :: [Char]
ioe_location    = [Char]
"libpq",
                    ioe_description :: [Char]
ioe_description = ByteString -> [Char]
B8.unpack ByteString
desc,
                    ioe_errno :: Maybe CInt
ioe_errno       = forall a. Maybe a
Nothing,
                    ioe_filename :: Maybe [Char]
ioe_filename    = forall a. Maybe a
Nothing
                  }

throwLibPQError :: PQ.Connection -> ByteString -> IO a
throwLibPQError :: forall a. Connection -> ByteString -> IO a
throwLibPQError Connection
conn ByteString
default_desc = do
  ByteString
msg <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
default_desc forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
PQ.errorMessage Connection
conn
  forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$! ByteString -> IOError
libPQError ByteString
msg


fmtError :: String -> Query -> [Action] -> a
fmtError :: forall a. [Char] -> Query -> [Action] -> a
fmtError [Char]
msg Query
q [Action]
xs = forall a e. Exception e => e -> a
throw FormatError {
                      fmtMessage :: [Char]
fmtMessage = [Char]
msg
                    , fmtQuery :: Query
fmtQuery = Query
q
                    , fmtParams :: [ByteString]
fmtParams = forall a b. (a -> b) -> [a] -> [b]
map Action -> ByteString
twiddle [Action]
xs
                    }
  where twiddle :: Action -> ByteString
twiddle (Plain Builder
b)            = Builder -> ByteString
toByteString Builder
b
        twiddle (Escape ByteString
s)           = ByteString
s
        twiddle (EscapeByteA ByteString
s)      = ByteString
s
        twiddle (EscapeIdentifier ByteString
s) = ByteString
s
        twiddle (Many [Action]
ys)            = [ByteString] -> ByteString
B.concat (forall a b. (a -> b) -> [a] -> [b]
map Action -> ByteString
twiddle [Action]
ys)

fmtErrorBs :: Query -> [Action] -> ByteString -> a
fmtErrorBs :: forall a. Query -> [Action] -> ByteString -> a
fmtErrorBs Query
q [Action]
xs ByteString
msg = forall a. [Char] -> Query -> [Action] -> a
fmtError (Text -> [Char]
T.unpack forall a b. (a -> b) -> a -> b
$ ByteString -> Text
TE.decodeUtf8 ByteString
msg) Query
q [Action]
xs

-- | Quote bytestring or throw 'FormatError'
quote :: Query -> [Action] -> Either ByteString ByteString -> Builder
quote :: Query -> [Action] -> Either ByteString ByteString -> Builder
quote Query
q [Action]
xs = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Query -> [Action] -> ByteString -> a
fmtErrorBs Query
q [Action]
xs) (Builder -> Builder
inQuotes forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
byteString)

buildAction :: Connection        -- ^ Connection for string escaping
            -> Query             -- ^ Query for message error
            -> [Action]          -- ^ List of parameters for message error
            -> Action            -- ^ Action to build
            -> IO Builder
buildAction :: Connection -> Query -> [Action] -> Action -> IO Builder
buildAction Connection
_ Query
_ [Action]
_     (Plain  Builder
b)            = forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
b
buildAction Connection
conn Query
q [Action]
xs (Escape ByteString
s)            = Query -> [Action] -> Either ByteString ByteString -> Builder
quote Query
q [Action]
xs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeStringConn Connection
conn ByteString
s
buildAction Connection
conn Query
q [Action]
xs (EscapeByteA ByteString
s)       = Query -> [Action] -> Either ByteString ByteString -> Builder
quote Query
q [Action]
xs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeByteaConn Connection
conn ByteString
s
buildAction Connection
conn Query
q [Action]
xs (EscapeIdentifier ByteString
s) =
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Query -> [Action] -> ByteString -> a
fmtErrorBs Query
q [Action]
xs) ByteString -> Builder
byteString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeIdentifier Connection
conn ByteString
s
buildAction Connection
conn Query
q [Action]
xs (Many  [Action]
ys)           =
    forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Connection -> Query -> [Action] -> Action -> IO Builder
buildAction Connection
conn Query
q [Action]
xs) [Action]
ys

checkError :: PQ.Connection -> Maybe a -> IO (Either ByteString a)
checkError :: forall a. Connection -> Maybe a -> IO (Either ByteString a)
checkError Connection
_ (Just a
x) = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right a
x
checkError Connection
c Maybe a
Nothing  = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"" forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> IO (Maybe ByteString)
PQ.errorMessage Connection
c

escapeWrap       :: (PQ.Connection -> ByteString -> IO (Maybe ByteString))
                 -> Connection
                 -> ByteString
                 -> IO (Either ByteString ByteString)
escapeWrap :: (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
f Connection
conn ByteString
s =
    forall a. Connection -> (Connection -> IO a) -> IO a
withConnection Connection
conn forall a b. (a -> b) -> a -> b
$ \Connection
c ->
    Connection -> ByteString -> IO (Maybe ByteString)
f Connection
c ByteString
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Connection -> Maybe a -> IO (Either ByteString a)
checkError Connection
c

escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeStringConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeStringConn = (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
PQ.escapeStringConn

escapeIdentifier :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeIdentifier :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeIdentifier = (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
PQ.escapeIdentifier

escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
escapeByteaConn = (Connection -> ByteString -> IO (Maybe ByteString))
-> Connection -> ByteString -> IO (Either ByteString ByteString)
escapeWrap Connection -> ByteString -> IO (Maybe ByteString)
PQ.escapeByteaConn

breakOnSingleQuestionMark :: ByteString -> (ByteString, ByteString)
breakOnSingleQuestionMark :: ByteString -> (ByteString, ByteString)
breakOnSingleQuestionMark ByteString
b = (ByteString, ByteString) -> (ByteString, ByteString)
go (ByteString
B8.empty, ByteString
b)
  where go :: (ByteString, ByteString) -> (ByteString, ByteString)
go (ByteString
x,ByteString
bs) = (ByteString
x ByteString -> ByteString -> ByteString
`B8.append` ByteString
x',ByteString
bs')
                -- seperate from first QM
          where tup :: (ByteString, ByteString)
tup@(ByteString
noQ, ByteString
restWithQ) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
B8.break (forall a. Eq a => a -> a -> Bool
==Char
'?') ByteString
bs
                -- if end of query, just return
                -- else check for second QM in 'go2'
                (ByteString
x', ByteString
bs') = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString, ByteString)
tup (Char, ByteString) -> (ByteString, ByteString)
go2 forall a b. (a -> b) -> a -> b
$
                    -- drop found QM and peek at next char
                    ByteString -> Maybe (Char, ByteString)
B8.uncons ByteString
restWithQ forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe (Char, ByteString)
B8.uncons forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd
                -- another QM after the first means:
                -- take literal QM and keep going.
                go2 :: (Char, ByteString) -> (ByteString, ByteString)
go2 (Char
'?', ByteString
t2) = (ByteString, ByteString) -> (ByteString, ByteString)
go (ByteString
noQ ByteString -> Char -> ByteString
`B8.snoc` Char
'?',ByteString
t2)
                -- Anything else means
                go2 (Char, ByteString)
_ = (ByteString, ByteString)
tup