Commit 796ac473 authored by Toralf Wittner's avatar Toralf Wittner

Release as version 3.0.0

parents fb3e7cc1 c75d9148
CQL Binary Protocol v2
======================
CQL Binary Protocol Implementation
==================================
Implementation of [Cassandra's CQL Binary Protocol Version 2](https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v2.spec).
This Haskell library implements Cassandra's CQL Binary Protocol [Version 2][1]
and [Version 3][2]. It provides encoding and decoding functionality as well as
representations of the various protocol related types.
[1]: https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v2.spec
[2]: https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v3.spec
name: cql
version: 2.0.0.6
version: 3.0.0
synopsis: Cassandra CQL binary protocol.
stability: experimental
license: OtherLicense
......@@ -7,13 +7,24 @@ license-file: LICENSE
author: Toralf Wittner, Roman S. Borschel
maintainer: Toralf Wittner <tw@dtex.org>
copyright: 2014 Toralf Wittner, Roman S. Borschel
homepage: https://github.com/twittner/cql/
bug-reports: https://github.com/twittner/cql/issues
category: Database
build-type: Simple
cabal-version: >= 1.10
extra-source-files: README.md
description:
Implementation of Cassandra's CQL binary protocol (version 2).
Implementation of Cassandra's CQL Binary Protocol
<https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v2.spec Version 2>
and
<https://github.com/apache/cassandra/blob/trunk/doc/native_protocol_v3.spec Version 3>.
.
It provides encoding and decoding functionality as well as representations
of the various protocol related types.
.
Thus it can serve as a building block for writing Cassandra drivers, such
as <http://hackage.haskell.org/package/cql-io cql-io>.
source-repository head
type: git
......@@ -32,26 +43,26 @@ library
other-modules:
Database.CQL.Protocol.Class
Database.CQL.Protocol.Codec
Database.CQL.Protocol.Header
Database.CQL.Protocol.Record
Database.CQL.Protocol.Request
Database.CQL.Protocol.Response
Database.CQL.Protocol.Tuple
Database.CQL.Protocol.Tuple.TH
Database.CQL.Protocol.Types
Database.CQL.Protocol.Header
Database.CQL.Protocol.Request
Database.CQL.Protocol.Response
build-depends:
base == 4.*
, bytestring >= 0.10 && < 0.11
base >= 4.5 && < 5.0
, bytestring >= 0.10 && < 1.0
, cereal >= 0.3 && < 0.5
, Decimal >= 0.3 && < 0.5
, network >= 2.4 && < 2.6
, text >= 0.11 && < 1.2
, tagged == 0.7.*
, Decimal >= 0.3 && < 1.0
, iproute >= 1.3 && < 1.4
, network >= 2.4 && < 3.0
, text >= 0.11 && < 2.0
, template-haskell
, time == 1.4.*
, transformers >= 0.3
, uuid >= 1.2.6 && < 1.4
, time >= 1.4 && < 2.0
, transformers >= 0.3 && < 0.5
, uuid >= 1.2.6 && < 2.0
test-suite cql-tests
type: exitcode-stdio-1.0
......@@ -66,9 +77,11 @@ test-suite cql-tests
, cereal
, cql
, Decimal
, iproute
, network
, QuickCheck
, tasty == 0.8.*
, tasty-quickcheck == 0.8.*
, tasty >= 0.8
, tasty-quickcheck >= 0.8
, text
, time
, uuid
......
......@@ -2,18 +2,151 @@
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.
-- | The CQL native protocol is a binary frame-based protocol where
-- each frame has a 'Header', a 'Length' and a body. The protocol
-- distinguishes 'Request's and 'Response's.
--
-- Some usage examples:
--
-- __Constructing and Serialising a Request__
--
-- @
-- let q = QueryString "select peer from system.peers where data_center = ? and rack = ?"
-- p = QueryParams One False ("uk-1", "r-0") Nothing Nothing Nothing
-- r = RqQuery (Query q p :: Query R (Text, Text) (Identity IP))
-- i = mkStreamId 0
-- in pack V3 noCompression False i r
-- @
--
-- __Deserialising a Response__
--
-- @
-- -- assuming 'bh' contains the raw header byte string and 'bb' the raw
-- -- body byte string.
-- case header V3 bh of
-- Left e -> ...
-- Right h -> unpack noCompression h bb
-- @
--
-- __A generic query processing function__
--
-- @
-- query :: (Tuple a, Tuple b) => Version -> Socket -> QueryString k a b -> QueryParams a -> IO (Response k a b)
-- query v s q p = do
-- let i = mkStreamId 0
-- sendToServer s (pack v noCompression False i (RqQuery (Query q p)))
-- b <- recv (if v == V3 then 9 else 8) s
-- h <- either (throwIO . MyException) return (header v b)
-- when (headerType h == RqHeader) $
-- throwIO UnexpectedRequestHeader
-- let len = lengthRepr (bodyLength h)
-- x <- recv (fromIntegral len) s
-- case unpack noCompression h x of
-- Left e -> throwIO $ AnotherException e
-- Right (RsError _ e) -> throwIO e
-- Right response -> return response
-- @
--
module Database.CQL.Protocol
( Cql (..)
, Tuple
, Encoding
, module M
( -- * Cql type-class
Cql (..)
-- * Basic type definitions
, module Database.CQL.Protocol.Types
-- * Header
, Header (..)
, HeaderType (..)
, header
-- ** Length
, Length (..)
-- ** StreamId
, StreamId
, mkStreamId
, fromStreamId
-- ** Flags
, Flags
, compress
, tracing
, isSet
-- * Request
, Request (..)
, getOpCode
, pack
-- ** Options
, Options (..)
-- ** Startup
, Startup (..)
-- ** Auth Response
, AuthResponse (..)
-- ** Register
, Register (..)
, EventType (..)
-- ** Query
, Query (..)
, QueryParams (..)
, SerialConsistency (..)
-- ** Batch
, Batch (..)
, BatchQuery (..)
, BatchType (..)
-- ** Prepare
, Prepare (..)
-- ** Execute
, Execute (..)
-- * Response
, Response (..)
, unpack
-- ** Ready
, Ready (..)
-- ** Authenticate
, Authenticate (..)
, AuthChallenge (..)
, AuthSuccess (..)
-- ** Result
, Result (..)
, MetaData (..)
, ColumnSpec (..)
-- ** Supported
, Supported (..)
-- ** Event
, Event (..)
, TopologyChange (..)
, SchemaChange (..)
, StatusChange (..)
, Change (..)
-- ** Error
, Error (..)
, WriteType (..)
-- * Tuple and Record
, module Database.CQL.Protocol.Tuple
, module Database.CQL.Protocol.Record
) where
import Database.CQL.Protocol.Class
import Database.CQL.Protocol.Header as M
import Database.CQL.Protocol.Request as M
import Database.CQL.Protocol.Response as M
import Database.CQL.Protocol.Record as M
import Database.CQL.Protocol.Types as M
import Database.CQL.Protocol.Header
import Database.CQL.Protocol.Record
import Database.CQL.Protocol.Request
import Database.CQL.Protocol.Response
import Database.CQL.Protocol.Tuple
import Database.CQL.Protocol.Codec
import Database.CQL.Protocol.Types
......@@ -11,13 +11,14 @@ import Control.Applicative
import Control.Arrow
import Data.Decimal
import Data.Int
import Data.Tagged
import Data.IP
import Data.Text (Text)
import Data.Time
import Data.Time.Clock.POSIX
import Data.UUID (UUID)
import Database.CQL.Protocol.Types
-- | A type that can be converted from and to some CQL 'Value'.
class Cql a where
ctype :: Tagged a ColumnType
toCql :: a -> Value
......@@ -107,7 +108,7 @@ instance Cql Ascii where
------------------------------------------------------------------------------
-- IP Address
instance Cql Inet where
instance Cql IP where
ctype = Tagged InetColumn
toCql = CqlInet
fromCql (CqlInet i) = Right i
......@@ -170,7 +171,7 @@ instance Cql TimeUuid where
------------------------------------------------------------------------------
-- [a]
instance (Cql a) => Cql [a] where
instance Cql a => Cql [a] where
ctype = Tagged (ListColumn (untag (ctype :: Tagged a ColumnType)))
toCql = CqlList . map toCql
fromCql (CqlList l) = mapM fromCql l
......@@ -182,7 +183,7 @@ instance (Cql a) => Cql [a] where
-- | Please note that due to the fact that Cassandra internally represents
-- empty collection type values (i.e. lists, maps and sets) as @null@, we
-- can not distinguish @Just []@ from @Nothing@ on response decoding.
instance (Cql a) => Cql (Maybe a) where
instance Cql a => Cql (Maybe a) where
ctype = Tagged (MaybeColumn (untag (ctype :: Tagged a ColumnType)))
toCql = CqlMaybe . fmap toCql
fromCql (CqlMaybe (Just m)) = Just <$> fromCql m
......@@ -203,7 +204,7 @@ instance (Cql a, Cql b) => Cql (Map a b) where
------------------------------------------------------------------------------
-- Set a
instance (Cql a) => Cql (Set a) where
instance Cql a => Cql (Set a) where
ctype = Tagged (SetColumn (untag (ctype :: Tagged a ColumnType)))
toCql (Set a) = CqlSet $ map toCql a
fromCql (CqlSet a) = Set <$> mapM fromCql a
......
This diff is collapsed.
......@@ -5,14 +5,29 @@
module Database.CQL.Protocol.Header
( Header (..)
, HeaderType (..)
, Version (..)
, Flags
, StreamId (..)
, Length (..)
, header
, encodeHeader
, decodeHeader
-- ** Length
, Length (..)
, encodeLength
, decodeLength
-- ** StreamId
, StreamId
, mkStreamId
, fromStreamId
, encodeStreamId
, decodeStreamId
-- ** Flags
, Flags
, compress
, tracing
, isSet
, encodeFlags
, decodeFlags
) where
import Control.Applicative
......@@ -20,11 +35,12 @@ import Data.Bits
import Data.ByteString.Lazy (ByteString)
import Data.Int
import Data.Monoid
import Data.Serialize hiding (encode, decode)
import Data.Serialize
import Data.Word
import Database.CQL.Protocol.Codec
import Database.CQL.Protocol.Types
-- | Protocol frame header.
data Header = Header
{ headerType :: !HeaderType
, version :: !Version
......@@ -32,92 +48,115 @@ data Header = Header
, streamId :: !StreamId
, opCode :: !OpCode
, bodyLength :: !Length
} deriving (Show)
instance Encoding Header where
encode h = do
encode $ case headerType h of
RqHeader -> mapVersion (version h)
RsHeader -> mapVersion (version h) `setBit` 7
encode (flags h)
encode (streamId h)
encode (opCode h)
encode (bodyLength h)
where
mapVersion :: Version -> Word8
mapVersion V2 = 2
instance Decoding Header where
decode = do
b <- getWord8
Header (mapHeaderType b)
<$> decVersion (b .&. 0x7F)
<*> decode
<*> decode
<*> decode
<*> decode
where
mapHeaderType b = if b `testBit` 7 then RsHeader else RqHeader
decVersion :: Word8 -> Get Version
decVersion 1 = fail "decode-version: CQL Protocol V1 not supported."
decVersion 2 = return V2
decVersion w = fail $ "decode-version: unknown: " ++ show w
} deriving Show
data HeaderType
= RqHeader
| RsHeader
deriving (Show)
= RqHeader -- ^ A request frame header.
| RsHeader -- ^ A response frame header.
deriving Show
encodeHeader :: Version -> HeaderType -> Flags -> StreamId -> OpCode -> Length -> PutM ()
encodeHeader v t f i o l = do
encodeByte $ case t of
RqHeader -> mapVersion v
RsHeader -> mapVersion v `setBit` 7
encodeFlags f
encodeStreamId v i
encodeOpCode o
encodeLength l
decodeHeader :: Version -> Get Header
decodeHeader v = do
b <- getWord8
Header (mapHeaderType b)
<$> toVersion (b .&. 0x7F)
<*> decodeFlags
<*> decodeStreamId v
<*> decodeOpCode
<*> decodeLength
mapHeaderType :: Word8 -> HeaderType
mapHeaderType b = if b `testBit` 7 then RsHeader else RqHeader
-- | Deserialise a frame header using the version specific decoding format.
header :: Version -> ByteString -> Either String Header
header v = runGetLazy (decodeHeader v)
------------------------------------------------------------------------------
-- Version
data Version = V2
deriving (Eq, Show)
mapVersion :: Version -> Word8
mapVersion V3 = 3
mapVersion V2 = 2
header :: ByteString -> Either String Header
header = decReadLazy
toVersion :: Word8 -> Get Version
toVersion 2 = return V2
toVersion 3 = return V3
toVersion w = fail $ "decode-version: unknown: " ++ show w
------------------------------------------------------------------------------
-- Length
-- | The type denoting a protocol frame length.
newtype Length = Length { lengthRepr :: Int32 } deriving (Eq, Show)
instance Encoding Length where
encode (Length x) = encode x
encodeLength :: Putter Length
encodeLength (Length x) = encodeInt x
instance Decoding Length where
decode = Length <$> decode
decodeLength :: Get Length
decodeLength = Length <$> decodeInt
------------------------------------------------------------------------------
-- StreamId
newtype StreamId = StreamId { streamRepr :: Int8 } deriving (Eq, Show)
-- | Streams allow multiplexing of requests over a single communication
-- channel. The 'StreamId' correlates 'Request's with 'Response's.
newtype StreamId = StreamId Int16 deriving (Eq, Show)
-- | Create a StreamId from the given integral value. In version 2,
-- a StreamId is an 'Int8' and in version 3 an 'Int16'.
mkStreamId :: Integral i => i -> StreamId
mkStreamId = StreamId . fromIntegral
-- | Convert the stream ID to an integer.
fromStreamId :: StreamId -> Int
fromStreamId (StreamId i) = fromIntegral i
instance Encoding StreamId where
encode (StreamId x) = encode x
encodeStreamId :: Version -> Putter StreamId
encodeStreamId V3 (StreamId x) = encodeSignedShort (fromIntegral x)
encodeStreamId V2 (StreamId x) = encodeSignedByte (fromIntegral x)
instance Decoding StreamId where
decode = StreamId <$> decode
decodeStreamId :: Version -> Get StreamId
decodeStreamId V3 = StreamId <$> decodeSignedShort
decodeStreamId V2 = StreamId . fromIntegral <$> decodeSignedByte
------------------------------------------------------------------------------
-- Flags
newtype Flags = Flags Word8
deriving (Eq, Show)
-- | Type representing header flags. Flags form a monoid and can be used
-- as in @compress <> tracing <> mempty@.
newtype Flags = Flags Word8 deriving (Eq, Show)
instance Monoid Flags where
mempty = Flags 0
mappend (Flags a) (Flags b) = Flags (a .|. b)
instance Encoding Flags where
encode (Flags x) = encode x
encodeFlags :: Putter Flags
encodeFlags (Flags x) = encodeByte x
instance Decoding Flags where
decode = Flags <$> decode
decodeFlags :: Get Flags
decodeFlags = Flags <$> decodeByte
-- | Compression flag. If set, the frame body is compressed.
compress :: Flags
compress = Flags 1
-- | Tracing flag. If a request support tracing and the tracing flag was set,
-- the response to this request will have the tracing flag set and contain
-- tracing information.
tracing :: Flags
tracing = Flags 2
-- | Check if a particular flag is present.
isSet :: Flags -> Flags -> Bool
isSet (Flags a) (Flags b) = a .&. b == a
......@@ -2,12 +2,37 @@
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.
module Database.CQL.Protocol.Internal (module M) where
import Database.CQL.Protocol.Class as M
import Database.CQL.Protocol.Types as M
import Database.CQL.Protocol.Header as M
import Database.CQL.Protocol.Request as M
import Database.CQL.Protocol.Response as M
import Database.CQL.Protocol.Tuple as M
import Database.CQL.Protocol.Codec as M
-- | Like "Database.CQL.Protocol" but exports the whole
-- encode/decode machinery for all types.
module Database.CQL.Protocol.Internal
( -- * Cql type-class
module Database.CQL.Protocol.Class
-- * Basic type definitions
, module Database.CQL.Protocol.Types
-- * Header
, module Database.CQL.Protocol.Header
-- * Request
, module Database.CQL.Protocol.Request
-- * Response
, module Database.CQL.Protocol.Response
-- * Tuple and Record
, module Database.CQL.Protocol.Tuple
, module Database.CQL.Protocol.Record
-- * Codec
, module Database.CQL.Protocol.Codec
) where
import Database.CQL.Protocol.Class
import Database.CQL.Protocol.Codec
import Database.CQL.Protocol.Header
import Database.CQL.Protocol.Record
import Database.CQL.Protocol.Request
import Database.CQL.Protocol.Response
import Database.CQL.Protocol.Tuple
import Database.CQL.Protocol.Types
......@@ -23,6 +23,32 @@ typeSynDecl x y z = TySynInstD x (TySynEqn y z)
type family TupleType a
-- | Record/Tuple conversion.
-- For example:
--
-- @
-- data Peer = Peer
-- { peerAddr :: IP
-- , peerRPC :: IP
-- , peerDC :: Text
-- , peerRack :: Text
-- } deriving Show
--
-- recordInstance ''Peer
--
-- map asRecord \<$\> performQuery "SELECT peer, rpc_address, data_center, rack FROM system.peers"
-- @
--
-- The generated type-class instance maps between record and tuple constructors:
--
-- @
-- type instance TupleType Peer = (IP, IP, Text, Text)
--
-- instance Record Peer where
-- asTuple (Peer a b c d) = (a, b, c, d)
-- asRecord (a, b, c, d) = Peer a b c d
-- @
--
class Record a where
asTuple :: a -> TupleType a
asRecord :: TupleType a -> a
......
This diff is collapsed.
This diff is collapsed.
......@@ -6,6 +6,8 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | A tuple represents the types of multiple cassandra columns. It is used
-- to check that column-types match.
module Database.CQL.Protocol.Tuple
( Tuple
, count
......@@ -16,10 +18,9 @@ module Database.CQL.Protocol.Tuple
import Control.Applicative
import Data.Serialize
import Data.Tagged
import Data.Word
import Database.CQL.Protocol.Class
import Database.CQL.Protocol.Codec
import Database.CQL.Protocol.Codec (putValue)
import Database.CQL.Protocol.Types
import Database.CQL.Protocol.Tuple.TH
......
......@@ -10,10 +10,9 @@ import Control.Applicative
import Control.Monad
import Data.Functor.Identity
import Data.Serialize
import Data.Tagged
import Data.Word
import Database.CQL.Protocol.Class
import Database.CQL.Protocol.Codec
import Database.CQL.Protocol.Codec (putValue, getValue)
import Database.CQL.Protocol.Types
import Language.Haskell.TH
......@@ -22,8 +21,8 @@ import Language.Haskell.TH
class PrivateTuple a where
count :: Tagged a Int
check :: Tagged a ([ColumnType] -> [ColumnType])
tuple :: Get a
store :: Putter a
tuple :: Version -> Get a
store :: Version -> Putter a
class PrivateTuple a => Tuple a
......@@ -31,22 +30,22 @@ class PrivateTuple a => Tuple a
-- Manual instances
instance PrivateTuple () where
count = Tagged 0
check = Tagged $ const []
tuple = return ()
store = const $ return ()
count = Tagged 0
check = Tagged $ const []
tuple _ = return ()
store _ = const $ return ()
instance Tuple ()
instance (Cql a) => PrivateTuple (Identity a) where
count = Tagged 1
check = Tagged $ typecheck [untag (ctype :: Tagged a ColumnType)]
tuple = Identity <$> element ctype
store (Identity a) = do
instance Cql a => PrivateTuple (Identity a) where
count = Tagged 1
check = Tagged $ typecheck [untag (ctype :: Tagged a ColumnType)]
tuple v = Identity <$> element v ctype
store v (Identity a) = do
put (1 :: Word16)
putValue (toCql a)
putValue v (toCql a)
instance (Cql a) => Tuple (Identity a)
instance Cql a => Tuple (Identity a)
------------------------------------------------------------------------------
-- Templated instances
......@@ -56,10 +55,11 @@ genInstances n = join <$> mapM tupleInstance [2 .. n]
tupleInstance :: Int -> Q [Dec]
tupleInstance n = do
let cql = mkName "Cql"
vnames <- replicateM n (newName "a")
let vtypes = map VarT vnames
let tupleType = foldl1 ($:) (TupleT n : vtypes)
let ctx = map (ClassP (mkName "Cql") . (:[])) vtypes
let ctx = map (\t -> ClassP cql [t]) vtypes
td <- tupleDecl n
sd <- storeDecl n
return
......@@ -77,6 +77,11 @@ countDecl n = Clause [] (NormalB body) []
where
body = con "Tagged" $$ litInt n
-- check = Tagged $
-- typecheck [ untag (ctype :: Tagged x ColumnType)
-- , untag (ctype :: Tagged y ColumnType)
-- , ...
-- ])
checkDecl :: [Name] -> Clause
checkDecl names = Clause [] (NormalB body) []
where
......@@ -84,25 +89,32 @@ checkDecl names = Clause [] (NormalB body) []
fn n = var "untag" $$ SigE (var "ctype") (tty n)
tty n = tcon "Tagged" $: VarT n $: tcon "ColumnType"
-- tuple v = (,) <$> element v ctype <*> element v ctype
-- tuple v = (,,) <$> element v ctype <*> element v ctype <*> element v ctype
-- ...
tupleDecl :: Int -> Q Clause
tupleDecl n = Clause [] (NormalB body) <$> comb
tupleDecl n = do
let v = mkName "v"
Clause [VarP v] (NormalB $ body v) <$> comb
where
body = UInfixE (var "combine") (var "<$>") (foldl1 star elts)
elts = replicate n (var "element" $$ var "ctype")
star = flip UInfixE (var "<*>")
comb = do
body v = UInfixE (var "combine") (var "<$>") (foldl1 star (elts v))
elts v = replicate n (var "element" $$ VarE v $$ var "ctype")
star = flip UInfixE (var "<*>")
comb = do
names <- replicateM n (newName "x")