{-# LANGUAGE
    BangPatterns
  , ConstraintKinds
  , LambdaCase
  , NumericUnderscores
  , OverloadedStrings
  , RecordWildCards
#-}

module ClickHaskell
  (
  -- * Connection
    ChCredential(..), defaultCredentials
  , Connection(..), openNativeConnection

  -- * Reading and writing
  , Table
  , Columns, Column, KnownColumn(..), DeserializableColumn(..)

  -- ** Reading
  , ReadableFrom(..)
  -- *** Simple
  , select
  , selectFrom
  , selectFromView, View, parameter, Parameter
  -- *** Streaming
  , streamSelect
  , streamSelectFrom
  , streamSelectFromView
  -- *** Internal
  , handleSelect

  -- ** Writing
  , WritableInto(..)
  , insertInto

  -- * Ping database connection
  , ping

  -- * ClickHouse types
  , IsChType(ToChTypeName, chTypeName, defaultValueOfTypeName)
  , ToChType(toChType)
  , FromChType(fromChType)
  , ToQueryPart(toQueryPart)
  
  , ChDateTime(..)
  , ChDate(..)
  
  , ChInt8(..), ChInt16(..), ChInt32(..), ChInt64(..), ChInt128(..)
  , ChUInt8(..), ChUInt16(..), ChUInt32(..), ChUInt64(..), ChUInt128(..)
  
  , ChString(..)
  , ChUUID(..)
  
  , ChArray(..)
  , Nullable
  , LowCardinality, IsLowCardinalitySupported
  
  , UVarInt(..)
  , module Data.WideWord
  ) where

-- Internal dependencies
import ClickHaskell.NativeProtocol
  ( mkDataPacket, DataPacket(..)
  , mkHelloPacket, HelloParameters(..), mkAddendum
  , mkPingPacket
  , mkQueryPacket
  , ServerPacketType(..), HelloResponse(..), ExceptionPacket, latestSupportedRevision
  , HasColumns (..), WritableInto (..), ReadableFrom (..)
  , Columns, DeserializableColumns (..), Column, DeserializableColumn(..), KnownColumn(..)
  , Serializable(..), Deserializable(..), ProtocolRevision
  , Parameter, parameter, Parameters, CheckParameters, viewParameters

  , IsChType(ToChTypeName, chTypeName, defaultValueOfTypeName)
  , ToChType(toChType)
  , FromChType(fromChType)
  , ToQueryPart(toQueryPart)
  
  , ChDateTime(..)
  , ChDate(..)
  
  , ChInt8(..), ChInt16(..), ChInt32(..), ChInt64(..), ChInt128(..)
  , ChUInt8(..), ChUInt16(..), ChUInt32(..), ChUInt64(..), ChUInt128(..)
  
  , ChString(..)
  , ChUUID(..)
  
  , ChArray(..)
  , Nullable
  , LowCardinality, IsLowCardinalitySupported
  
  , UVarInt(..)
  )

-- GHC included
import Control.Exception (Exception, SomeException, bracketOnError, catch, finally, throwIO)
import Control.DeepSeq (NFData, (<$!!>))
import Data.Binary.Get (Decoder (..), Get, runGetIncremental)
import Data.ByteString.Builder (byteString, toLazyByteString)
import Data.ByteString.Char8 as BS8 (fromStrict, pack)
import Data.ByteString.Lazy.Internal as BL (ByteString (..), LazyByteString)
import Data.Int (Int64)
import Data.Kind (Type)
import Data.Maybe (listToMaybe)
import Data.Text (Text)
import Data.Typeable (Proxy (..))
import GHC.Stack (HasCallStack, callStack, prettyCallStack)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import System.Timeout (timeout)

-- External
import Data.WideWord (Int128 (..), Word128(..))
import Network.Socket as Sock
import Network.Socket.ByteString.Lazy (recv, sendAll)

-- * Connection

data ChCredential = MkChCredential
  { ChCredential -> Text
chLogin    :: Text
  , ChCredential -> Text
chPass     :: Text
  , ChCredential -> Text
chDatabase :: Text
  , ChCredential -> HostName
chHost     :: HostName
  , ChCredential -> HostName
chPort     :: ServiceName
  }

defaultCredentials :: ChCredential
defaultCredentials :: ChCredential
defaultCredentials = MkChCredential
  { chLogin :: Text
chLogin    = Text
"default"
  , chPass :: Text
chPass     = Text
""
  , chHost :: HostName
chHost     = HostName
"localhost"
  , chDatabase :: Text
chDatabase = Text
"default"
  , chPort :: HostName
chPort     = HostName
"9000"
  }

data Connection = MkConnection
  { Connection -> Socket
sock       :: Socket
  , Connection -> ChString
user       :: ChString
  , Connection -> Int64
bufferSize :: Int64
  , Connection -> ProtocolRevision
revision   :: ProtocolRevision
  }

openNativeConnection :: HasCallStack => ChCredential -> IO Connection
openNativeConnection :: HasCallStack => ChCredential -> IO Connection
openNativeConnection MkChCredential{HostName
chHost :: ChCredential -> HostName
chHost :: HostName
chHost, HostName
chPort :: ChCredential -> HostName
chPort :: HostName
chPort, Text
chLogin :: ChCredential -> Text
chLogin :: Text
chLogin, Text
chPass :: ChCredential -> Text
chPass :: Text
chPass, Text
chDatabase :: ChCredential -> Text
chDatabase :: Text
chDatabase} = do
  AddrInfo{Family
addrFamily :: Family
addrFamily :: AddrInfo -> Family
addrFamily, SocketType
addrSocketType :: SocketType
addrSocketType :: AddrInfo -> SocketType
addrSocketType, ProtocolNumber
addrProtocol :: ProtocolNumber
addrProtocol :: AddrInfo -> ProtocolNumber
addrProtocol, SockAddr
addrAddress :: SockAddr
addrAddress :: AddrInfo -> SockAddr
addrAddress}
    <- (IO AddrInfo
-> (AddrInfo -> IO AddrInfo) -> Maybe AddrInfo -> IO AddrInfo
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ClientError -> IO AddrInfo
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO AddrInfo) -> ClientError -> IO AddrInfo
forall a b. (a -> b) -> a -> b
$ HasCallStack => ConnectionError -> ClientError
ConnectionError -> ClientError
ConnectionError ConnectionError
NoAdressResolved) AddrInfo -> IO AddrInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe AddrInfo -> IO AddrInfo)
-> ([AddrInfo] -> Maybe AddrInfo) -> [AddrInfo] -> IO AddrInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AddrInfo] -> Maybe AddrInfo
forall a. [a] -> Maybe a
listToMaybe)
    ([AddrInfo] -> IO AddrInfo) -> IO [AddrInfo] -> IO AddrInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe AddrInfo -> Maybe HostName -> Maybe HostName -> IO [AddrInfo]
getAddrInfo
      (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
defaultHints{addrFlags = [AI_ADDRCONFIG], addrSocketType = Stream})
      (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
chHost)
      (HostName -> Maybe HostName
forall a. a -> Maybe a
Just HostName
chPort)
  Socket
sock <- IO Socket -> (Socket -> IO Socket) -> Maybe Socket -> IO Socket
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ClientError -> IO Socket
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO Socket) -> ClientError -> IO Socket
forall a b. (a -> b) -> a -> b
$ HasCallStack => ConnectionError -> ClientError
ConnectionError -> ClientError
ConnectionError ConnectionError
EstablishTimeout) Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe Socket -> IO Socket) -> IO (Maybe Socket) -> IO Socket
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Int -> IO Socket -> IO (Maybe Socket)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
3_000_000 (
      IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
        (Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
addrFamily SocketType
addrSocketType ProtocolNumber
addrProtocol)
        (\Socket
sock ->
          forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch @SomeException
            (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
finally
              (Socket -> ShutdownCmd -> IO ()
shutdown Socket
sock ShutdownCmd
ShutdownBoth)
              (Socket -> IO ()
close Socket
sock)
            )
            (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (IO () -> SomeException -> IO ())
-> IO () -> SomeException -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
        )
        (\Socket
sock -> do
           Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
NoDelay Int
1
           Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
Sock.KeepAlive Int
1
           Socket -> SockAddr -> IO ()
connect Socket
sock SockAddr
addrAddress
           Socket -> IO Socket
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Socket
sock
        )
      )

  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (HelloPacket -> ByteString) -> HelloPacket -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (HelloPacket -> Builder) -> HelloPacket -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtocolRevision -> HelloPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
latestSupportedRevision)
    (HelloParameters -> HelloPacket
mkHelloPacket MkHelloParameters{Text
chLogin :: Text
chPass :: Text
chDatabase :: Text
$sel:chDatabase:MkHelloParameters :: Text
$sel:chLogin:MkHelloParameters :: Text
$sel:chPass:MkHelloParameters :: Text
..})

  (ServerPacketType
serverPacketType, ByteString
_) <- ByteString
-> Get ServerPacketType
-> Socket
-> Int64
-> IO (ServerPacketType, ByteString)
forall packet.
ByteString
-> Get packet -> Socket -> Int64 -> IO (packet, ByteString)
rawBufferizedRead ByteString
emptyBuffer (ProtocolRevision -> Get ServerPacketType
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
latestSupportedRevision) Socket
sock Int64
4096
  case ServerPacketType
serverPacketType of
    HelloResponse MkHelloResponse{ProtocolRevision
server_revision :: ProtocolRevision
$sel:server_revision:MkHelloResponse :: HelloResponse -> ProtocolRevision
server_revision} -> do
      let revision :: ProtocolRevision
revision = ProtocolRevision -> ProtocolRevision -> ProtocolRevision
forall a. Ord a => a -> a -> a
min ProtocolRevision
server_revision ProtocolRevision
latestSupportedRevision
      (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString) (ProtocolRevision -> Addendum -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision Addendum
mkAddendum)
      Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkConnection
        { user :: ChString
user = Text -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Text
chLogin
        , ProtocolRevision
revision :: ProtocolRevision
revision :: ProtocolRevision
revision
        , Socket
sock :: Socket
sock :: Socket
sock
        , bufferSize :: Int64
bufferSize = Int64
4096
        }
    Exception ExceptionPacket
exception -> ClientError -> IO Connection
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
    ServerPacketType
otherPacket         -> ClientError -> IO Connection
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ProtocolImplementationError -> ClientError
ProtocolImplementationError -> ClientError
ProtocolImplementationError (ProtocolImplementationError -> ClientError)
-> ProtocolImplementationError -> ClientError
forall a b. (a -> b) -> a -> b
$ ServerPacketType -> ProtocolImplementationError
UnexpectedPacketType ServerPacketType
otherPacket)


-- * Ping

ping :: HasCallStack => Connection -> IO ()
ping :: HasCallStack => Connection -> IO ()
ping MkConnection{Socket
sock :: Connection -> Socket
sock :: Socket
sock, ProtocolRevision
revision :: Connection -> ProtocolRevision
revision :: ProtocolRevision
revision, Int64
bufferSize :: Connection -> Int64
bufferSize :: Int64
bufferSize} = do
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (ProtocolRevision -> PingPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision PingPacket
mkPingPacket)
  (ServerPacketType
responsePacket, ByteString
_) <- ByteString
-> Get ServerPacketType
-> Socket
-> Int64
-> IO (ServerPacketType, ByteString)
forall packet.
ByteString
-> Get packet -> Socket -> Int64 -> IO (packet, ByteString)
rawBufferizedRead ByteString
emptyBuffer (ProtocolRevision -> Get ServerPacketType
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision) Socket
sock Int64
bufferSize
  case ServerPacketType
responsePacket of
    ServerPacketType
Pong                -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Exception ExceptionPacket
exception -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
    ServerPacketType
otherPacket         -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ProtocolImplementationError -> ClientError
ProtocolImplementationError -> ClientError
ProtocolImplementationError (ProtocolImplementationError -> ClientError)
-> (ServerPacketType -> ProtocolImplementationError)
-> ServerPacketType
-> ClientError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerPacketType -> ProtocolImplementationError
UnexpectedPacketType (ServerPacketType -> ClientError)
-> ServerPacketType -> ClientError
forall a b. (a -> b) -> a -> b
$ ServerPacketType
otherPacket)




-- * Querying

data Table (name :: Symbol) (columns :: [Type])

instance HasColumns (Table name columns) where
  type GetColumns (Table _ columns) = columns

-- ** Selecting

-- *** Simple

selectFrom ::
  forall table record name columns
  .
  ( table ~ Table name columns
  , KnownSymbol name
  , ReadableFrom table record
  )
  =>
  Connection -> IO [record]
selectFrom :: forall table record (name :: Symbol) (columns :: [*]).
(table ~ Table name columns, KnownSymbol name,
 ReadableFrom table record) =>
Connection -> IO [record]
selectFrom conn :: Connection
conn@MkConnection{Socket
sock :: Connection -> Socket
sock :: Socket
sock, ChString
user :: Connection -> ChString
user :: ChString
user, ProtocolRevision
revision :: Connection -> ProtocolRevision
revision :: ProtocolRevision
revision} = do
  let query :: Builder
query
        = Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall hasColumns record. ReadableFrom hasColumns record => Builder
readingColumns @table @record
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder
byteString (ByteString -> Builder)
-> (HostName -> ByteString) -> HostName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> ByteString
BS8.pack) (Proxy name -> HostName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> HostName
symbolVal (Proxy name -> HostName) -> Proxy name -> HostName
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (  ProtocolRevision -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
revision ChString
user (Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Builder
query))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    )
  forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @table Connection
conn ByteString
emptyBuffer [record] -> IO [record]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

select ::
  forall columns record
  .
  ReadableFrom (Columns columns) record
  =>
  Connection -> ChString -> IO [record]
select :: forall (columns :: [*]) record.
ReadableFrom (Columns columns) record =>
Connection -> ChString -> IO [record]
select conn :: Connection
conn@MkConnection{Socket
sock :: Connection -> Socket
sock :: Socket
sock, ChString
user :: Connection -> ChString
user :: ChString
user, ProtocolRevision
revision :: Connection -> ProtocolRevision
revision :: ProtocolRevision
revision} ChString
query = do
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (  ProtocolRevision -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
revision ChString
user ChString
query)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    )
  forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @(Columns columns) Connection
conn ByteString
emptyBuffer [record] -> IO [record]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance HasColumns (View name columns parameters) where
  type GetColumns (View _ columns _) = columns

data View (name :: Symbol) (columns :: [Type]) (parameters :: [Type])

selectFromView ::
  forall view record name columns parameters passedParameters
  .
  ( ReadableFrom view record
  , KnownSymbol name
  , view ~ View name columns parameters
  , CheckParameters parameters passedParameters
  )
  => Connection -> (Parameters '[] -> Parameters passedParameters) -> IO [record]
selectFromView :: forall view record (name :: Symbol) (columns :: [*])
       (parameters :: [*]) (passedParameters :: [*]).
(ReadableFrom view record, KnownSymbol name,
 view ~ View name columns parameters,
 CheckParameters parameters passedParameters) =>
Connection
-> (Parameters '[] -> Parameters passedParameters) -> IO [record]
selectFromView conn :: Connection
conn@MkConnection{Int64
Socket
ProtocolRevision
ChString
sock :: Connection -> Socket
user :: Connection -> ChString
bufferSize :: Connection -> Int64
revision :: Connection -> ProtocolRevision
sock :: Socket
user :: ChString
bufferSize :: Int64
revision :: ProtocolRevision
..} Parameters '[] -> Parameters passedParameters
interpreter = do
  let query :: Builder
query =
        Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall hasColumns record. ReadableFrom hasColumns record => Builder
readingColumns @view @record Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder
byteString (ByteString -> Builder)
-> (Proxy name -> ByteString) -> Proxy name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> ByteString
BS8.pack (HostName -> ByteString)
-> (Proxy name -> HostName) -> Proxy name -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> HostName
symbolVal @name) Proxy name
forall {k} (t :: k). Proxy t
Proxy Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Parameters '[] -> Parameters passedParameters) -> Builder
forall (passedParameters :: [*]).
(Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters Parameters '[] -> Parameters passedParameters
interpreter
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (  ProtocolRevision -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
revision ChString
user (Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Builder
query))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    )
  forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @view Connection
conn ByteString
emptyBuffer [record] -> IO [record]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- *** Streaming

streamSelectFrom ::
  forall table record name columns a
  .
  ( table ~ Table name columns
  , KnownSymbol name
  , ReadableFrom table record
  , NFData a
  )
  =>
  Connection -> ([record] -> IO [a]) -> IO [a]
streamSelectFrom :: forall table record (name :: Symbol) (columns :: [*]) a.
(table ~ Table name columns, KnownSymbol name,
 ReadableFrom table record, NFData a) =>
Connection -> ([record] -> IO [a]) -> IO [a]
streamSelectFrom conn :: Connection
conn@MkConnection{Socket
sock :: Connection -> Socket
sock :: Socket
sock, ChString
user :: Connection -> ChString
user :: ChString
user, ProtocolRevision
revision :: Connection -> ProtocolRevision
revision :: ProtocolRevision
revision} [record] -> IO [a]
f = do
  let query :: Builder
query
        = Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall hasColumns record. ReadableFrom hasColumns record => Builder
readingColumns @table @record
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder
byteString (ByteString -> Builder)
-> (HostName -> ByteString) -> HostName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> ByteString
BS8.pack) (Proxy name -> HostName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> HostName
symbolVal (Proxy name -> HostName) -> Proxy name -> HostName
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (  ProtocolRevision -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
revision ChString
user (Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Builder
query))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    )
  let f' :: [record] -> IO [a]
f' [record]
x = [a] -> [a]
forall a. a -> a
id ([a] -> [a]) -> IO [a] -> IO [a]
forall (m :: * -> *) b a.
(Monad m, NFData b) =>
(a -> b) -> m a -> m b
<$!!> [record] -> IO [a]
f [record]
x
  forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @table Connection
conn ByteString
emptyBuffer [record] -> IO [a]
f'

streamSelect ::
  forall columns record a
  .
  (ReadableFrom (Columns columns) record, NFData a)
  =>
  Connection -> ChString -> ([record] -> IO [a]) -> IO [a]
streamSelect :: forall (columns :: [*]) record a.
(ReadableFrom (Columns columns) record, NFData a) =>
Connection -> ChString -> ([record] -> IO [a]) -> IO [a]
streamSelect conn :: Connection
conn@MkConnection{Socket
sock :: Connection -> Socket
sock :: Socket
sock, ChString
user :: Connection -> ChString
user :: ChString
user, ProtocolRevision
revision :: Connection -> ProtocolRevision
revision :: ProtocolRevision
revision} ChString
query [record] -> IO [a]
f = do
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (  ProtocolRevision -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
revision ChString
user ChString
query)
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    )
  let f' :: [record] -> IO [a]
f' [record]
x = [a] -> [a]
forall a. a -> a
id ([a] -> [a]) -> IO [a] -> IO [a]
forall (m :: * -> *) b a.
(Monad m, NFData b) =>
(a -> b) -> m a -> m b
<$!!> [record] -> IO [a]
f [record]
x
  forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @(Columns columns) Connection
conn ByteString
emptyBuffer [record] -> IO [a]
f'

streamSelectFromView ::
  forall view record name columns parameters passedParameters a
  .
  ( ReadableFrom view record
  , KnownSymbol name
  , view ~ View name columns parameters
  , NFData a
  , CheckParameters parameters passedParameters
  )
  => Connection -> (Parameters '[] -> Parameters passedParameters) -> ([record] -> IO [a]) -> IO [a]
streamSelectFromView :: forall view record (name :: Symbol) (columns :: [*])
       (parameters :: [*]) (passedParameters :: [*]) a.
(ReadableFrom view record, KnownSymbol name,
 view ~ View name columns parameters, NFData a,
 CheckParameters parameters passedParameters) =>
Connection
-> (Parameters '[] -> Parameters passedParameters)
-> ([record] -> IO [a])
-> IO [a]
streamSelectFromView conn :: Connection
conn@MkConnection{Int64
Socket
ProtocolRevision
ChString
sock :: Connection -> Socket
user :: Connection -> ChString
bufferSize :: Connection -> Int64
revision :: Connection -> ProtocolRevision
sock :: Socket
user :: ChString
bufferSize :: Int64
revision :: ProtocolRevision
..} Parameters '[] -> Parameters passedParameters
interpreter [record] -> IO [a]
f = do
  let query :: Builder
query =
        Builder
"SELECT " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall hasColumns record. ReadableFrom hasColumns record => Builder
readingColumns @view @record Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<>
        Builder
" FROM " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder
byteString (ByteString -> Builder)
-> (Proxy name -> ByteString) -> Proxy name -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> ByteString
BS8.pack (HostName -> ByteString)
-> (Proxy name -> HostName) -> Proxy name -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> HostName
symbolVal @name) Proxy name
forall {k} (t :: k). Proxy t
Proxy Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (Parameters '[] -> Parameters passedParameters) -> Builder
forall (passedParameters :: [*]).
(Parameters '[] -> Parameters passedParameters) -> Builder
viewParameters Parameters '[] -> Parameters passedParameters
interpreter
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (  ProtocolRevision -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
revision ChString
user (Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Builder
query))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    )
  let f' :: [record] -> IO [a]
f' [record]
x = [a] -> [a]
forall a. a -> a
id ([a] -> [a]) -> IO [a] -> IO [a]
forall (m :: * -> *) b a.
(Monad m, NFData b) =>
(a -> b) -> m a -> m b
<$!!> [record] -> IO [a]
f [record]
x
  forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @view Connection
conn ByteString
emptyBuffer [record] -> IO [a]
f'

-- *** Internal

handleSelect ::
  forall hasColumns record a
  .
  ReadableFrom hasColumns record
  =>
  Connection -> Buffer -> ([record] -> IO [a])  -> IO [a]
handleSelect :: forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect conn :: Connection
conn@MkConnection{Int64
Socket
ProtocolRevision
ChString
sock :: Connection -> Socket
user :: Connection -> ChString
bufferSize :: Connection -> Int64
revision :: Connection -> ProtocolRevision
sock :: Socket
user :: ChString
bufferSize :: Int64
revision :: ProtocolRevision
..} ByteString
previousBuffer [record] -> IO [a]
f = do
  (ServerPacketType
packet, ByteString
buffer) <- ByteString
-> Get ServerPacketType
-> Socket
-> Int64
-> IO (ServerPacketType, ByteString)
forall packet.
ByteString
-> Get packet -> Socket -> Int64 -> IO (packet, ByteString)
rawBufferizedRead ByteString
previousBuffer (ProtocolRevision -> Get ServerPacketType
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision) Socket
sock Int64
bufferSize  
  case ServerPacketType
packet of
    DataResponse MkDataPacket{UVarInt
columns_count :: UVarInt
$sel:columns_count:MkDataPacket :: DataPacket -> UVarInt
columns_count, UVarInt
rows_count :: UVarInt
$sel:rows_count:MkDataPacket :: DataPacket -> UVarInt
rows_count} -> do
      case (UVarInt
columns_count, UVarInt
rows_count) of
        (UVarInt
0, UVarInt
0) -> forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @hasColumns Connection
conn ByteString
buffer [record] -> IO [a]
f
        (UVarInt
_, UVarInt
rows) -> do
          ([record]
columns, ByteString
nextBuffer) <- ByteString
-> Get [record] -> Socket -> Int64 -> IO ([record], ByteString)
forall packet.
ByteString
-> Get packet -> Socket -> Int64 -> IO (packet, ByteString)
rawBufferizedRead ByteString
buffer (forall hasColumns record.
ReadableFrom hasColumns record =>
ProtocolRevision -> UVarInt -> Get [record]
deserializeColumns @hasColumns ProtocolRevision
revision UVarInt
rows) Socket
sock Int64
bufferSize
          [a]
processedColumns <- [record] -> IO [a]
f [record]
columns
          ([a]
processedColumns [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++) ([a] -> [a]) -> IO [a] -> IO [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @hasColumns Connection
conn ByteString
nextBuffer [record] -> IO [a]
f 
    Progress          ProgressPacket
_ -> forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @hasColumns Connection
conn ByteString
buffer [record] -> IO [a]
f
    ProfileInfo       ProfileInfo
_ -> forall hasColumns record a.
ReadableFrom hasColumns record =>
Connection -> ByteString -> ([record] -> IO [a]) -> IO [a]
handleSelect @hasColumns Connection
conn ByteString
buffer [record] -> IO [a]
f
    ServerPacketType
EndOfStream         -> [a] -> IO [a]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
    Exception ExceptionPacket
exception -> ClientError -> IO [a]
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
    ServerPacketType
otherPacket         -> ClientError -> IO [a]
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ProtocolImplementationError -> ClientError
ProtocolImplementationError -> ClientError
ProtocolImplementationError (ProtocolImplementationError -> ClientError)
-> ProtocolImplementationError -> ClientError
forall a b. (a -> b) -> a -> b
$ ServerPacketType -> ProtocolImplementationError
UnexpectedPacketType ServerPacketType
otherPacket)


-- ** Inserting

insertInto ::
  forall table record name columns
  .
  ( table ~ Table name columns
  , WritableInto table record
  , KnownSymbol name
  )
  => Connection -> [record] -> IO ()
insertInto :: forall table record (name :: Symbol) (columns :: [*]).
(table ~ Table name columns, WritableInto table record,
 KnownSymbol name) =>
Connection -> [record] -> IO ()
insertInto conn :: Connection
conn@MkConnection{Socket
sock :: Connection -> Socket
sock :: Socket
sock, ChString
user :: Connection -> ChString
user :: ChString
user, ProtocolRevision
revision :: Connection -> ProtocolRevision
revision :: ProtocolRevision
revision} [record]
columnsData = do
  let query :: Builder
query =
        Builder
"INSERT INTO " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (ByteString -> Builder
byteString (ByteString -> Builder)
-> (HostName -> ByteString) -> HostName -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HostName -> ByteString
BS8.pack) (Proxy name -> HostName
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> HostName
symbolVal (Proxy name -> HostName) -> Proxy name -> HostName
forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
forall (t :: Symbol). Proxy t
Proxy @name)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" (" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall columns record. WritableInto columns record => Builder
writingColumns @table @record Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
") VALUES"
  (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
    (  ProtocolRevision -> QueryPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ProtocolRevision -> ChString -> ChString -> QueryPacket
mkQueryPacket ProtocolRevision
revision ChString
user (Builder -> ChString
forall chType inputType.
ToChType chType inputType =>
inputType -> chType
toChType Builder
query))
    Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
    )
  forall columns record.
WritableInto columns record =>
Connection -> ByteString -> [record] -> IO ()
handleInsertResult @table Connection
conn ByteString
emptyBuffer [record]
columnsData

handleInsertResult :: forall columns record . WritableInto columns record => Connection -> Buffer -> [record] -> IO ()
handleInsertResult :: forall columns record.
WritableInto columns record =>
Connection -> ByteString -> [record] -> IO ()
handleInsertResult conn :: Connection
conn@MkConnection{Int64
Socket
ProtocolRevision
ChString
sock :: Connection -> Socket
user :: Connection -> ChString
bufferSize :: Connection -> Int64
revision :: Connection -> ProtocolRevision
sock :: Socket
user :: ChString
bufferSize :: Int64
revision :: ProtocolRevision
..} ByteString
buffer [record]
records = do
  (ServerPacketType
firstPacket, ByteString
buffer1) <- ByteString
-> Get ServerPacketType
-> Socket
-> Int64
-> IO (ServerPacketType, ByteString)
forall packet.
ByteString
-> Get packet -> Socket -> Int64 -> IO (packet, ByteString)
rawBufferizedRead ByteString
buffer (ProtocolRevision -> Get ServerPacketType
forall chType.
Deserializable chType =>
ProtocolRevision -> Get chType
deserialize ProtocolRevision
revision) Socket
sock Int64
bufferSize
  case ServerPacketType
firstPacket of
    TableColumns      TableColumns
_ -> forall columns record.
WritableInto columns record =>
Connection -> ByteString -> [record] -> IO ()
handleInsertResult @columns Connection
conn ByteString
buffer1 [record]
records
    DataResponse (MkDataPacket{UVarInt
$sel:rows_count:MkDataPacket :: DataPacket -> UVarInt
rows_count :: UVarInt
rows_count}) -> do
      (Columns (GetColumns columns)
_emptyDataPacket, ByteString
buffer2)
        <- ByteString
-> Get (Columns (GetColumns columns))
-> Socket
-> Int64
-> IO (Columns (GetColumns columns), ByteString)
forall packet.
ByteString
-> Get packet -> Socket -> Int64 -> IO (packet, ByteString)
rawBufferizedRead ByteString
buffer1 (forall columns.
DeserializableColumns columns =>
ProtocolRevision -> UVarInt -> Get columns
deserializeRawColumns @(Columns (GetColumns columns)) ProtocolRevision
revision UVarInt
rows_count) Socket
sock Int64
bufferSize
      (Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ())
-> (Builder -> ByteString) -> Builder -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString)
        (  ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" (forall columns record. WritableInto columns record => UVarInt
columnsCount @columns @record) (Int -> UVarInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UVarInt) -> Int -> UVarInt
forall a b. (a -> b) -> a -> b
$ [record] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [record]
records))
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> forall columns record.
WritableInto columns record =>
ProtocolRevision -> [record] -> Builder
serializeRecords @columns ProtocolRevision
revision [record]
records
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ProtocolRevision -> DataPacket -> Builder
forall chType.
Serializable chType =>
ProtocolRevision -> chType -> Builder
serialize ProtocolRevision
revision (ChString -> UVarInt -> UVarInt -> DataPacket
mkDataPacket ChString
"" UVarInt
0 UVarInt
0)
        )
      forall columns record.
WritableInto columns record =>
Connection -> ByteString -> [record] -> IO ()
handleInsertResult @columns @record Connection
conn ByteString
buffer2 []
    ServerPacketType
EndOfStream         -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Exception ExceptionPacket
exception -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ExceptionPacket -> ClientError
ExceptionPacket -> ClientError
DatabaseException ExceptionPacket
exception)
    ServerPacketType
otherPacket         -> ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (HasCallStack => ProtocolImplementationError -> ClientError
ProtocolImplementationError -> ClientError
ProtocolImplementationError (ProtocolImplementationError -> ClientError)
-> ProtocolImplementationError -> ClientError
forall a b. (a -> b) -> a -> b
$ ServerPacketType -> ProtocolImplementationError
UnexpectedPacketType ServerPacketType
otherPacket)




-- * Bufferization

type Buffer = LazyByteString

emptyBuffer :: Buffer
emptyBuffer :: ByteString
emptyBuffer = ByteString
BL.Empty

rawBufferizedRead :: Buffer -> Get packet -> Socket -> Int64 -> IO (packet, Buffer)
rawBufferizedRead :: forall packet.
ByteString
-> Get packet -> Socket -> Int64 -> IO (packet, ByteString)
rawBufferizedRead ByteString
buffer Get packet
parser Socket
sock Int64
bufSize = IO ByteString
-> ByteString -> Decoder packet -> IO (packet, ByteString)
forall packet.
IO ByteString
-> ByteString -> Decoder packet -> IO (packet, ByteString)
runBufferReader (Socket -> Int64 -> IO ByteString
recv Socket
sock Int64
bufSize) ByteString
buffer (Get packet -> Decoder packet
forall a. Get a -> Decoder a
runGetIncremental Get packet
parser)

runBufferReader :: IO LazyByteString -> Buffer -> Decoder packet -> IO (packet, Buffer)
runBufferReader :: forall packet.
IO ByteString
-> ByteString -> Decoder packet -> IO (packet, ByteString)
runBufferReader IO ByteString
bufferFiller ByteString
buffer = \case
  (Partial Maybe ByteString -> Decoder packet
decoder) -> case ByteString
buffer of
    BL.Chunk ByteString
bs ByteString
mChunk -> IO ByteString
-> ByteString -> Decoder packet -> IO (packet, ByteString)
forall packet.
IO ByteString
-> ByteString -> Decoder packet -> IO (packet, ByteString)
runBufferReader IO ByteString
bufferFiller ByteString
mChunk (Maybe ByteString -> Decoder packet
decoder (Maybe ByteString -> Decoder packet)
-> Maybe ByteString -> Decoder packet
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)
    ByteString
BL.Empty ->
      IO ByteString
bufferFiller IO ByteString
-> (ByteString -> IO (packet, ByteString))
-> IO (packet, ByteString)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        BL.Chunk ByteString
bs ByteString
mChunk -> IO ByteString
-> ByteString -> Decoder packet -> IO (packet, ByteString)
forall packet.
IO ByteString
-> ByteString -> Decoder packet -> IO (packet, ByteString)
runBufferReader IO ByteString
bufferFiller ByteString
mChunk (Maybe ByteString -> Decoder packet
decoder (Maybe ByteString -> Decoder packet)
-> Maybe ByteString -> Decoder packet
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs)
        ByteString
BL.Empty -> ProtocolImplementationError -> IO (packet, ByteString)
forall e a. Exception e => e -> IO a
throwIO (HostName -> ProtocolImplementationError
DeserializationError HostName
"Expected more bytes while reading packet")
  (Done !ByteString
leftover Int64
_consumed !packet
packet) -> (packet, ByteString) -> IO (packet, ByteString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (packet
packet, ByteString -> ByteString
fromStrict ByteString
leftover)
  (Fail ByteString
_leftover Int64
_consumed HostName
msg) -> ProtocolImplementationError -> IO (packet, ByteString)
forall e a. Exception e => e -> IO a
throwIO (HostName -> ProtocolImplementationError
DeserializationError HostName
msg)




-- * Errors handling

data ClientError where
  ConnectionError :: HasCallStack => ConnectionError -> ClientError
  DatabaseException :: HasCallStack => ExceptionPacket -> ClientError
  ProtocolImplementationError :: HasCallStack => ProtocolImplementationError -> ClientError

instance Show ClientError where
  show :: ClientError -> HostName
show (ConnectionError ConnectionError
connError) = HostName
"ConnectionError" HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> ConnectionError -> HostName
forall a. Show a => a -> HostName
show ConnectionError
connError HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> HostName
"\n" HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> CallStack -> HostName
prettyCallStack CallStack
HasCallStack => CallStack
callStack
  show (DatabaseException ExceptionPacket
exception) = HostName
"DatabaseException" HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> ExceptionPacket -> HostName
forall a. Show a => a -> HostName
show ExceptionPacket
exception HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> HostName
"\n" HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> CallStack -> HostName
prettyCallStack CallStack
HasCallStack => CallStack
callStack
  show (ProtocolImplementationError ProtocolImplementationError
err) = HostName
"ConnectionError" HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> ProtocolImplementationError -> HostName
forall a. Show a => a -> HostName
show ProtocolImplementationError
err HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> HostName
"\n" HostName -> ShowS
forall a. Semigroup a => a -> a -> a
<> CallStack -> HostName
prettyCallStack CallStack
HasCallStack => CallStack
callStack

deriving anyclass instance Exception ClientError

{- |
  You shouldn't see this exceptions. Please report a bug if it appears
-}
data ProtocolImplementationError
  = UnexpectedPacketType ServerPacketType
  | DeserializationError String
  deriving (Int -> ProtocolImplementationError -> ShowS
[ProtocolImplementationError] -> ShowS
ProtocolImplementationError -> HostName
(Int -> ProtocolImplementationError -> ShowS)
-> (ProtocolImplementationError -> HostName)
-> ([ProtocolImplementationError] -> ShowS)
-> Show ProtocolImplementationError
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProtocolImplementationError -> ShowS
showsPrec :: Int -> ProtocolImplementationError -> ShowS
$cshow :: ProtocolImplementationError -> HostName
show :: ProtocolImplementationError -> HostName
$cshowList :: [ProtocolImplementationError] -> ShowS
showList :: [ProtocolImplementationError] -> ShowS
Show, Show ProtocolImplementationError
Typeable ProtocolImplementationError
(Typeable ProtocolImplementationError,
 Show ProtocolImplementationError) =>
(ProtocolImplementationError -> SomeException)
-> (SomeException -> Maybe ProtocolImplementationError)
-> (ProtocolImplementationError -> HostName)
-> Exception ProtocolImplementationError
SomeException -> Maybe ProtocolImplementationError
ProtocolImplementationError -> HostName
ProtocolImplementationError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> HostName) -> Exception e
$ctoException :: ProtocolImplementationError -> SomeException
toException :: ProtocolImplementationError -> SomeException
$cfromException :: SomeException -> Maybe ProtocolImplementationError
fromException :: SomeException -> Maybe ProtocolImplementationError
$cdisplayException :: ProtocolImplementationError -> HostName
displayException :: ProtocolImplementationError -> HostName
Exception)

data ConnectionError
  = NoAdressResolved
  | EstablishTimeout
  deriving (Int -> ConnectionError -> ShowS
[ConnectionError] -> ShowS
ConnectionError -> HostName
(Int -> ConnectionError -> ShowS)
-> (ConnectionError -> HostName)
-> ([ConnectionError] -> ShowS)
-> Show ConnectionError
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConnectionError -> ShowS
showsPrec :: Int -> ConnectionError -> ShowS
$cshow :: ConnectionError -> HostName
show :: ConnectionError -> HostName
$cshowList :: [ConnectionError] -> ShowS
showList :: [ConnectionError] -> ShowS
Show, Show ConnectionError
Typeable ConnectionError
(Typeable ConnectionError, Show ConnectionError) =>
(ConnectionError -> SomeException)
-> (SomeException -> Maybe ConnectionError)
-> (ConnectionError -> HostName)
-> Exception ConnectionError
SomeException -> Maybe ConnectionError
ConnectionError -> HostName
ConnectionError -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e) -> (e -> HostName) -> Exception e
$ctoException :: ConnectionError -> SomeException
toException :: ConnectionError -> SomeException
$cfromException :: SomeException -> Maybe ConnectionError
fromException :: SomeException -> Maybe ConnectionError
$cdisplayException :: ConnectionError -> HostName
displayException :: ConnectionError -> HostName
Exception)