{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
module Database.Memcache.Socket (
Socket, Request(..), Response(..),
send, recv,
szRequest, szResponse, dzHeader, dzResponse
) where
import Database.Memcache.Errors
import Database.Memcache.Types
import Blaze.ByteString.Builder
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Exception (throw, throwIO)
import Control.Monad
import Data.Binary.Get
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.Word
import Network.Socket (Socket)
import qualified Network.Socket.ByteString as N
send :: Socket -> Request -> IO ()
{-# INLINE send #-}
send :: Socket -> Request -> IO ()
send Socket
s Request
m = Socket -> ByteString -> IO ()
N.sendAll Socket
s (Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Request -> Builder
szRequest Request
m)
recv :: Socket -> IO Response
{-# INLINE recv #-}
recv :: Socket -> IO Response
recv Socket
s = do
ByteString
header <- Int -> Builder -> IO ByteString
recvAll Int
mEMCACHE_HEADER_SIZE Builder
forall a. Monoid a => a
mempty
let h :: Header
h = Get Header -> ByteString -> Header
forall a. Get a -> ByteString -> a
runGet (PktType -> Get Header
dzHeader PktType
PktResponse) ([ByteString] -> ByteString
L.fromChunks [ByteString
header])
if Header -> Word32
bodyLen Header
h Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
0
then do
let bytesToRead :: Int
bytesToRead = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word32
bodyLen Header
h
ByteString
body <- Int -> Builder -> IO ByteString
recvAll Int
bytesToRead Builder
forall a. Monoid a => a
mempty
Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Header -> ByteString -> Response
dzResponse Header
h ([ByteString] -> ByteString
L.fromChunks [ByteString
body])
else Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response -> IO Response) -> Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Header -> ByteString -> Response
dzResponse Header
h ByteString
L.empty
where
recvAll :: Int -> Builder -> IO B.ByteString
recvAll :: Int -> Builder -> IO ByteString
recvAll Int
0 !Builder
acc = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! Builder -> ByteString
toByteString Builder
acc
recvAll !Int
n !Builder
acc = do
ByteString
buf <- Socket -> Int -> IO ByteString
N.recv Socket
s Int
n
case ByteString -> Int
B.length ByteString
buf of
Int
0 -> MemcacheError -> IO ByteString
forall e a. Exception e => e -> IO a
throwIO MemcacheError
errEOF
Int
bl | Int
bl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n ->
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$! (Builder -> ByteString
toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$! Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
buf)
Int
bl -> Int -> Builder -> IO ByteString
recvAll (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
bl) (Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
fromByteString ByteString
buf)
errEOF :: MemcacheError
errEOF :: MemcacheError
errEOF = ProtocolError -> MemcacheError
ProtocolError UnexpectedEOF { protocolError :: String
protocolError = String
"" }
szResponse :: Response -> Builder
szResponse :: Response -> Builder
szResponse Response
res =
Word8 -> Builder
fromWord8 Word8
0x81
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
fromWord8 Word8
c
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
fromWord16be (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyl)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
fromWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
extl)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
fromWord8 Word8
0
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
fromWord16be Word16
0
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
fromWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
extl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vall)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
fromWord32be (Response -> Word32
resOpaque Response
res)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
fromWord64be (Response -> Word64
resCas Response
res)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ext'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
key'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val'
where
(Word8
c, Maybe ByteString
k', Maybe ByteString
v', Builder
ext', Int
extl) = OpResponse
-> (Word8, Maybe ByteString, Maybe ByteString, Builder, Int)
szOpResponse (Response -> OpResponse
resOp Response
res)
(Int
keyl, Builder
key') = case Maybe ByteString
k' of
Just ByteString
k -> (ByteString -> Int
B.length ByteString
k, ByteString -> Builder
fromByteString ByteString
k)
Maybe ByteString
Nothing -> (Int
0, Builder
forall a. Monoid a => a
mempty)
(Int
vall, Builder
val') = case Maybe ByteString
v' of
Just ByteString
v -> (ByteString -> Int
B.length ByteString
v, ByteString -> Builder
fromByteString ByteString
v)
Maybe ByteString
Nothing -> (Int
0, Builder
forall a. Monoid a => a
mempty)
szOpResponse :: OpResponse -> (Word8, Maybe Key, Maybe Value, Builder, Int)
szOpResponse :: OpResponse
-> (Word8, Maybe ByteString, Maybe ByteString, Builder, Int)
szOpResponse OpResponse
o = case OpResponse
o of
ResGet Q
Loud ByteString
v Word32
f -> (Word8
0x00, Maybe ByteString
forall a. Maybe a
Nothing, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResGet Q
Quiet ByteString
v Word32
f -> (Word8
0x09, Maybe ByteString
forall a. Maybe a
Nothing, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResGetK Q
Loud ByteString
k ByteString
v Word32
f -> (Word8
0x0C, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResGetK Q
Quiet ByteString
k ByteString
v Word32
f -> (Word8
0x0D, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResSet Q
Loud -> (Word8
0x01, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResSet Q
Quiet -> (Word8
0x11, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResAdd Q
Loud -> (Word8
0x02, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResAdd Q
Quiet -> (Word8
0x12, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResReplace Q
Loud -> (Word8
0x03, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResReplace Q
Quiet -> (Word8
0x13, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResDelete Q
Loud -> (Word8
0x04, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResDelete Q
Quiet -> (Word8
0x14, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResIncrement Q
Loud Word64
f -> (Word8
0x05, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Word64 -> Builder
fromWord64be Word64
f, Int
8)
ResIncrement Q
Quiet Word64
f -> (Word8
0x15, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Word64 -> Builder
fromWord64be Word64
f, Int
8)
ResDecrement Q
Loud Word64
f -> (Word8
0x06, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Word64 -> Builder
fromWord64be Word64
f, Int
8)
ResDecrement Q
Quiet Word64
f -> (Word8
0x16, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Word64 -> Builder
fromWord64be Word64
f, Int
8)
ResAppend Q
Loud -> (Word8
0x0E, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResAppend Q
Quiet -> (Word8
0x19, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResPrepend Q
Loud -> (Word8
0x0F, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResPrepend Q
Quiet -> (Word8
0x1A, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
OpResponse
ResTouch -> (Word8
0x1C, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResGAT Q
Loud ByteString
v Word32
f -> (Word8
0x1D, Maybe ByteString
forall a. Maybe a
Nothing, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResGAT Q
Quiet ByteString
v Word32
f -> (Word8
0x1E, Maybe ByteString
forall a. Maybe a
Nothing, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResGATK Q
Loud ByteString
k ByteString
v Word32
f -> (Word8
0x23, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResGATK Q
Quiet ByteString
k ByteString
v Word32
f -> (Word8
0x24, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Word32 -> Builder
fromWord32be Word32
f, Int
4)
ResFlush Q
Loud -> (Word8
0x08, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResFlush Q
Quiet -> (Word8
0x18, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
OpResponse
ResNoop -> (Word8
0x0A, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResVersion ByteString
v -> (Word8
0x0B, Maybe ByteString
forall a. Maybe a
Nothing, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ResStat ByteString
k ByteString
v -> (Word8
0x10, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
k, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ResQuit Q
Loud -> (Word8
0x07, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResQuit Q
Quiet -> (Word8
0x17, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ResSASLList ByteString
v -> (Word8
0x20, Maybe ByteString
forall a. Maybe a
Nothing, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
OpResponse
ResSASLStart -> (Word8
0x21, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
OpResponse
ResSASLStep -> (Word8
0x22, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
szRequest :: Request -> Builder
szRequest :: Request -> Builder
szRequest Request
req =
Word8 -> Builder
fromWord8 Word8
0x80
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
fromWord8 Word8
c
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
fromWord16be (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
keyl)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
fromWord8 (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
extl)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word8 -> Builder
fromWord8 Word8
0
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word16 -> Builder
fromWord16be Word16
0
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
fromWord32be (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ Int
extl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
keyl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vall)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
fromWord32be (Request -> Word32
reqOpaque Request
req)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
fromWord64be (Request -> Word64
reqCas Request
req)
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
ext'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
key'
Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
val'
where
(Word8
c, Maybe ByteString
k', Maybe ByteString
v', Builder
ext', Int
extl) = OpRequest
-> (Word8, Maybe ByteString, Maybe ByteString, Builder, Int)
szOpRequest (Request -> OpRequest
reqOp Request
req)
(Int
keyl, Builder
key') = case Maybe ByteString
k' of
Just ByteString
k -> (ByteString -> Int
B.length ByteString
k, ByteString -> Builder
fromByteString ByteString
k)
Maybe ByteString
Nothing -> (Int
0, Builder
forall a. Monoid a => a
mempty)
(Int
vall, Builder
val') = case Maybe ByteString
v' of
Just ByteString
v -> (ByteString -> Int
B.length ByteString
v, ByteString -> Builder
fromByteString ByteString
v)
Maybe ByteString
Nothing -> (Int
0, Builder
forall a. Monoid a => a
mempty)
szOpRequest :: OpRequest -> (Word8, Maybe Key, Maybe Value, Builder, Int)
szOpRequest :: OpRequest
-> (Word8, Maybe ByteString, Maybe ByteString, Builder, Int)
szOpRequest OpRequest
o = case OpRequest
o of
ReqGet Q
q K
k ByteString
key -> let c :: Word8
c | Q
q Q -> Q -> Bool
forall a. Eq a => a -> a -> Bool
== Q
Loud Bool -> Bool -> Bool
&& K
k K -> K -> Bool
forall a. Eq a => a -> a -> Bool
== K
NoKey = Word8
0x00
| Q
q Q -> Q -> Bool
forall a. Eq a => a -> a -> Bool
== Q
Loud Bool -> Bool -> Bool
&& K
k K -> K -> Bool
forall a. Eq a => a -> a -> Bool
== K
IncludeKey = Word8
0x0C
| K
k K -> K -> Bool
forall a. Eq a => a -> a -> Bool
== K
NoKey = Word8
0x09
| Bool
otherwise = Word8
0x0D
in (Word8
c, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqSet Q
Loud ByteString
key ByteString
v SESet
e -> (Word8
0x01, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, SESet -> Builder
szSESet SESet
e, Int
8)
ReqSet Q
Quiet ByteString
key ByteString
v SESet
e -> (Word8
0x11, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, SESet -> Builder
szSESet SESet
e, Int
8)
ReqAdd Q
Loud ByteString
key ByteString
v SESet
e -> (Word8
0x02, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, SESet -> Builder
szSESet SESet
e, Int
8)
ReqAdd Q
Quiet ByteString
key ByteString
v SESet
e -> (Word8
0x12, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, SESet -> Builder
szSESet SESet
e, Int
8)
ReqReplace Q
Loud ByteString
key ByteString
v SESet
e -> (Word8
0x03, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, SESet -> Builder
szSESet SESet
e, Int
8)
ReqReplace Q
Quiet ByteString
key ByteString
v SESet
e -> (Word8
0x13, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, SESet -> Builder
szSESet SESet
e, Int
8)
ReqDelete Q
Loud ByteString
key -> (Word8
0x04, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqDelete Q
Quiet ByteString
key -> (Word8
0x14, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqIncrement Q
Loud ByteString
key SEIncr
e -> (Word8
0x05, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, SEIncr -> Builder
szSEIncr SEIncr
e, Int
20)
ReqIncrement Q
Quiet ByteString
key SEIncr
e -> (Word8
0x15, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, SEIncr -> Builder
szSEIncr SEIncr
e, Int
20)
ReqDecrement Q
Loud ByteString
key SEIncr
e -> (Word8
0x06, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, SEIncr -> Builder
szSEIncr SEIncr
e, Int
20)
ReqDecrement Q
Quiet ByteString
key SEIncr
e -> (Word8
0x16, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, SEIncr -> Builder
szSEIncr SEIncr
e, Int
20)
ReqAppend Q
Loud ByteString
key ByteString
v -> (Word8
0x0E, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqAppend Q
Quiet ByteString
key ByteString
v -> (Word8
0x19, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqPrepend Q
Loud ByteString
key ByteString
v -> (Word8
0x0F, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqPrepend Q
Quiet ByteString
key ByteString
v -> (Word8
0x1A, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqTouch ByteString
key SETouch
e -> (Word8
0x1C, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, SETouch -> Builder
szSETouch SETouch
e, Int
4)
ReqGAT Q
q K
k ByteString
key SETouch
e -> let c :: Word8
c | Q
q Q -> Q -> Bool
forall a. Eq a => a -> a -> Bool
== Q
Quiet Bool -> Bool -> Bool
&& K
k K -> K -> Bool
forall a. Eq a => a -> a -> Bool
== K
IncludeKey = Word8
0x24
| Q
q Q -> Q -> Bool
forall a. Eq a => a -> a -> Bool
== Q
Quiet Bool -> Bool -> Bool
&& K
k K -> K -> Bool
forall a. Eq a => a -> a -> Bool
== K
NoKey = Word8
0x1E
| K
k K -> K -> Bool
forall a. Eq a => a -> a -> Bool
== K
IncludeKey = Word8
0x23
| Bool
otherwise = Word8
0x1D
in (Word8
c, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, SETouch -> Builder
szSETouch SETouch
e, Int
4)
ReqFlush Q
Loud (Just SETouch
e) -> (Word8
0x08, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, SETouch -> Builder
szSETouch SETouch
e, Int
4)
ReqFlush Q
Quiet (Just SETouch
e) -> (Word8
0x18, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, SETouch -> Builder
szSETouch SETouch
e, Int
4)
ReqFlush Q
Loud Maybe SETouch
Nothing -> (Word8
0x08, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqFlush Q
Quiet Maybe SETouch
Nothing -> (Word8
0x18, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
OpRequest
ReqNoop -> (Word8
0x0A, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
OpRequest
ReqVersion -> (Word8
0x0B, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqStat Maybe ByteString
key -> (Word8
0x10, Maybe ByteString
key, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqQuit Q
Loud -> (Word8
0x07, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqQuit Q
Quiet -> (Word8
0x17, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
OpRequest
ReqSASLList -> (Word8
0x20, Maybe ByteString
forall a. Maybe a
Nothing, Maybe ByteString
forall a. Maybe a
Nothing, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqSASLStart ByteString
key ByteString
v -> (Word8
0x21, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqSASLStep ByteString
key ByteString
v -> (Word8
0x22, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
key, ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
v, Builder
forall a. Monoid a => a
mempty, Int
0)
ReqRaw Word8
c Maybe ByteString
k Maybe ByteString
v (SERaw Builder
e Int
n) -> (Word8
c, Maybe ByteString
k, Maybe ByteString
v, Builder
e, Int
n)
where
szSESet :: SESet -> Builder
szSESet (SESet Word32
f Word32
e) = Word32 -> Builder
fromWord32be Word32
f Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
fromWord32be Word32
e
szSEIncr :: SEIncr -> Builder
szSEIncr (SEIncr Word64
i Word64
d Word32
e) = Word64 -> Builder
fromWord64be Word64
i Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
fromWord64be Word64
d Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word32 -> Builder
fromWord32be Word32
e
szSETouch :: SETouch -> Builder
szSETouch (SETouch Word32
e) = Word32 -> Builder
fromWord32be Word32
e
dzHeader :: PktType -> Get Header
{-# INLINE dzHeader #-}
PktType
pkt = do
Word8
m <- Get Word8
getWord8
case PktType
pkt of
PktType
PktResponse -> Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x81) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
MemcacheError -> Get ()
forall a e. Exception e => e -> a
throw (MemcacheError -> Get ()) -> MemcacheError -> Get ()
forall a b. (a -> b) -> a -> b
$ ProtocolError -> MemcacheError
ProtocolError UnknownPkt { protocolError :: String
protocolError = Word8 -> String
forall a. Show a => a -> String
show Word8
m }
PktType
PktRequest -> Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
m Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x80) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
MemcacheError -> Get ()
forall a e. Exception e => e -> a
throw (MemcacheError -> Get ()) -> MemcacheError -> Get ()
forall a b. (a -> b) -> a -> b
$ ProtocolError -> MemcacheError
ProtocolError UnknownPkt { protocolError :: String
protocolError = Word8 -> String
forall a. Show a => a -> String
show Word8
m }
Word8
o <- Get Word8
getWord8
Word16
kl <- Get Word16
getWord16be
Word8
el <- Get Word8
getWord8
Int -> Get ()
skip Int
1
Status
st <- Get Status
dzStatus
Word32
bl <- Get Word32
getWord32be
Word32
opq <- Get Word32
getWord32be
Word64
ver <- Get Word64
getWord64be
Header -> Get Header
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Header {
op :: Word8
op = Word8
o,
keyLen :: Word16
keyLen = Word16
kl,
extraLen :: Word8
extraLen = Word8
el,
status :: Status
status = Status
st,
bodyLen :: Word32
bodyLen = Word32
bl,
opaque :: Word32
opaque = Word32
opq,
cas :: Word64
cas = Word64
ver
}
dzResponse :: Header -> L.ByteString -> Response
dzResponse :: Header -> ByteString -> Response
dzResponse Header
h = Get Response -> ByteString -> Response
forall a. Get a -> ByteString -> a
runGet (Get Response -> ByteString -> Response)
-> Get Response -> ByteString -> Response
forall a b. (a -> b) -> a -> b
$
case Header -> Word8
op Header
h of
Word8
0x00 -> Header -> (ByteString -> Word32 -> OpResponse) -> Get Response
dzGetResponse Header
h ((ByteString -> Word32 -> OpResponse) -> Get Response)
-> (ByteString -> Word32 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> Word32 -> OpResponse
ResGet Q
Loud
Word8
0x09 -> Header -> (ByteString -> Word32 -> OpResponse) -> Get Response
dzGetResponse Header
h ((ByteString -> Word32 -> OpResponse) -> Get Response)
-> (ByteString -> Word32 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> Word32 -> OpResponse
ResGet Q
Quiet
Word8
0x1D -> Header -> (ByteString -> Word32 -> OpResponse) -> Get Response
dzGetResponse Header
h ((ByteString -> Word32 -> OpResponse) -> Get Response)
-> (ByteString -> Word32 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> Word32 -> OpResponse
ResGAT Q
Loud
Word8
0x1E -> Header -> (ByteString -> Word32 -> OpResponse) -> Get Response
dzGetResponse Header
h ((ByteString -> Word32 -> OpResponse) -> Get Response)
-> (ByteString -> Word32 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> Word32 -> OpResponse
ResGAT Q
Quiet
Word8
0x0C -> Header
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
dzGetKResponse Header
h ((ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response)
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> ByteString -> Word32 -> OpResponse
ResGetK Q
Loud
Word8
0x0D -> Header
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
dzGetKResponse Header
h ((ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response)
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> ByteString -> Word32 -> OpResponse
ResGetK Q
Quiet
Word8
0x23 -> Header
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
dzGetKResponse Header
h ((ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response)
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> ByteString -> Word32 -> OpResponse
ResGATK Q
Loud
Word8
0x24 -> Header
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
dzGetKResponse Header
h ((ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response)
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> ByteString -> ByteString -> Word32 -> OpResponse
ResGATK Q
Quiet
Word8
0x05 -> Header -> (Word64 -> OpResponse) -> Get Response
dzNumericResponse Header
h ((Word64 -> OpResponse) -> Get Response)
-> (Word64 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> Word64 -> OpResponse
ResIncrement Q
Loud
Word8
0x15 -> Header -> (Word64 -> OpResponse) -> Get Response
dzNumericResponse Header
h ((Word64 -> OpResponse) -> Get Response)
-> (Word64 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> Word64 -> OpResponse
ResIncrement Q
Quiet
Word8
0x06 -> Header -> (Word64 -> OpResponse) -> Get Response
dzNumericResponse Header
h ((Word64 -> OpResponse) -> Get Response)
-> (Word64 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> Word64 -> OpResponse
ResDecrement Q
Loud
Word8
0x16 -> Header -> (Word64 -> OpResponse) -> Get Response
dzNumericResponse Header
h ((Word64 -> OpResponse) -> Get Response)
-> (Word64 -> OpResponse) -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> Word64 -> OpResponse
ResDecrement Q
Quiet
Word8
0x01 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResSet Q
Loud
Word8
0x11 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResSet Q
Quiet
Word8
0x02 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResAdd Q
Loud
Word8
0x12 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResAdd Q
Quiet
Word8
0x03 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResReplace Q
Loud
Word8
0x13 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResReplace Q
Quiet
Word8
0x04 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResDelete Q
Loud
Word8
0x14 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResDelete Q
Quiet
Word8
0x0E -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResAppend Q
Loud
Word8
0x19 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResAppend Q
Quiet
Word8
0x0F -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResPrepend Q
Loud
Word8
0x1A -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResPrepend Q
Quiet
Word8
0x1C -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h OpResponse
ResTouch
Word8
0x07 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResQuit Q
Loud
Word8
0x17 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResQuit Q
Quiet
Word8
0x08 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResFlush Q
Loud
Word8
0x18 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h (OpResponse -> Get Response) -> OpResponse -> Get Response
forall a b. (a -> b) -> a -> b
$ Q -> OpResponse
ResFlush Q
Quiet
Word8
0x0A -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h OpResponse
ResNoop
Word8
0x10 -> Header -> (ByteString -> ByteString -> OpResponse) -> Get Response
dzKeyValueResponse Header
h ByteString -> ByteString -> OpResponse
ResStat
Word8
0x0B -> Header -> (ByteString -> OpResponse) -> Get Response
dzValueResponse Header
h ByteString -> OpResponse
ResVersion
Word8
0x20 -> Header -> (ByteString -> OpResponse) -> Get Response
dzValueResponse Header
h ByteString -> OpResponse
ResSASLList
Word8
0x21 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h OpResponse
ResSASLStart
Word8
0x22 -> Header -> OpResponse -> Get Response
dzGenericResponse Header
h OpResponse
ResSASLStep
Word8
_ -> MemcacheError -> Get Response
forall a e. Exception e => e -> a
throw (MemcacheError -> Get Response) -> MemcacheError -> Get Response
forall a b. (a -> b) -> a -> b
$ ProtocolError -> MemcacheError
ProtocolError UnknownOp { protocolError :: String
protocolError = Word8 -> String
forall a. Show a => a -> String
show (Header -> Word8
op Header
h) }
dzGenericResponse :: Header -> OpResponse -> Get Response
dzGenericResponse :: Header -> OpResponse -> Get Response
dzGenericResponse Header
h OpResponse
o = do
Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word32
bodyLen Header
h)
Word8 -> Word8 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word8
0 (Header -> Word8
extraLen Header
h) String
"Extra"
Word16 -> Word16 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word16
0 (Header -> Word16
keyLen Header
h) String
"Key"
Word32 -> Word32 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word32
0 (Header -> Word32
bodyLen Header
h) String
"Body"
Response -> Get Response
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Res {
resOp :: OpResponse
resOp = OpResponse
o,
resStatus :: Status
resStatus = Header -> Status
status Header
h,
resOpaque :: Word32
resOpaque = Header -> Word32
opaque Header
h,
resCas :: Word64
resCas = Header -> Word64
cas Header
h
}
dzGetResponse :: Header -> (Value -> Flags -> OpResponse) -> Get Response
dzGetResponse :: Header -> (ByteString -> Word32 -> OpResponse) -> Get Response
dzGetResponse Header
h ByteString -> Word32 -> OpResponse
o = do
Word32
e <- if Header -> Status
status Header
h Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
NoError Bool -> Bool -> Bool
&& Int
el Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
then Get Word32
getWord32be
else Int -> Get ()
skip Int
el Get () -> Get Word32 -> Get Word32
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Get Word32
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
ByteString
v <- Int -> Get ByteString
getByteString Int
vl
Int -> Int -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Int
4 Int
el String
"Extra"
Word16 -> Word16 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word16
0 (Header -> Word16
keyLen Header
h) String
"Key"
Response -> Get Response
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Res {
resOp :: OpResponse
resOp = ByteString -> Word32 -> OpResponse
o ByteString
v Word32
e,
resStatus :: Status
resStatus = Header -> Status
status Header
h,
resOpaque :: Word32
resOpaque = Header -> Word32
opaque Header
h,
resCas :: Word64
resCas = Header -> Word64
cas Header
h
}
where
el :: Int
el = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word8
extraLen Header
h
vl :: Int
vl = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Header -> Word32
bodyLen Header
h) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
el
dzGetKResponse :: Header -> (Key -> Value -> Flags -> OpResponse) -> Get Response
dzGetKResponse :: Header
-> (ByteString -> ByteString -> Word32 -> OpResponse)
-> Get Response
dzGetKResponse Header
h ByteString -> ByteString -> Word32 -> OpResponse
o = do
Word32
e <- if Header -> Status
status Header
h Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
NoError Bool -> Bool -> Bool
&& Int
el Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4
then Get Word32
getWord32be
else Int -> Get ()
skip Int
el Get () -> Get Word32 -> Get Word32
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Get Word32
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
0
ByteString
k <- Int -> Get ByteString
getByteString Int
kl
ByteString
v <- Int -> Get ByteString
getByteString Int
vl
Int -> Int -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Int
4 Int
el String
"Extra"
Response -> Get Response
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Res {
resOp :: OpResponse
resOp = ByteString -> ByteString -> Word32 -> OpResponse
o ByteString
k ByteString
v Word32
e,
resStatus :: Status
resStatus = Header -> Status
status Header
h,
resOpaque :: Word32
resOpaque = Header -> Word32
opaque Header
h,
resCas :: Word64
resCas = Header -> Word64
cas Header
h
}
where
el :: Int
el = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Int) -> Word8 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word8
extraLen Header
h
kl :: Int
kl = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word16
keyLen Header
h
vl :: Int
vl = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Header -> Word32
bodyLen Header
h) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
el Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
kl
dzNumericResponse :: Header -> (Word64 -> OpResponse) -> Get Response
dzNumericResponse :: Header -> (Word64 -> OpResponse) -> Get Response
dzNumericResponse Header
h Word64 -> OpResponse
o = do
Word64
v <- if Header -> Status
status Header
h Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
NoError Bool -> Bool -> Bool
&& Header -> Word32
bodyLen Header
h Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
8
then Get Word64
getWord64be
else Int -> Get ()
skip (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word32
bodyLen Header
h) Get () -> Get Word64 -> Get Word64
forall a b. Get a -> Get b -> Get b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Get Word64
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
0
Word8 -> Word8 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word8
0 (Header -> Word8
extraLen Header
h) String
"Extra"
Word16 -> Word16 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word16
0 (Header -> Word16
keyLen Header
h) String
"Key"
Word32 -> Word32 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word32
8 (Header -> Word32
bodyLen Header
h) String
"Body"
Response -> Get Response
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Res {
resOp :: OpResponse
resOp = Word64 -> OpResponse
o Word64
v,
resStatus :: Status
resStatus = Header -> Status
status Header
h,
resOpaque :: Word32
resOpaque = Header -> Word32
opaque Header
h,
resCas :: Word64
resCas = Header -> Word64
cas Header
h
}
dzValueResponse :: Header -> (Value -> OpResponse) -> Get Response
dzValueResponse :: Header -> (ByteString -> OpResponse) -> Get Response
dzValueResponse Header
h ByteString -> OpResponse
o = do
ByteString
v <- Int -> Get ByteString
getByteString (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> Word32 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word32
bodyLen Header
h)
Word8 -> Word8 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word8
0 (Header -> Word8
extraLen Header
h) String
"Extra"
Word16 -> Word16 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word16
0 (Header -> Word16
keyLen Header
h) String
"Key"
Response -> Get Response
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Res {
resOp :: OpResponse
resOp = ByteString -> OpResponse
o ByteString
v,
resStatus :: Status
resStatus = Header -> Status
status Header
h,
resOpaque :: Word32
resOpaque = Header -> Word32
opaque Header
h,
resCas :: Word64
resCas = Header -> Word64
cas Header
h
}
dzKeyValueResponse :: Header -> (Key -> Value -> OpResponse) -> Get Response
dzKeyValueResponse :: Header -> (ByteString -> ByteString -> OpResponse) -> Get Response
dzKeyValueResponse Header
h ByteString -> ByteString -> OpResponse
o = do
ByteString
k <- Int -> Get ByteString
getByteString Int
kl
ByteString
v <- Int -> Get ByteString
getByteString Int
vl
Word8 -> Word8 -> String -> Get ()
forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength Word8
0 (Header -> Word8
extraLen Header
h) String
"Extra"
Response -> Get Response
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Res {
resOp :: OpResponse
resOp = ByteString -> ByteString -> OpResponse
o ByteString
k ByteString
v,
resStatus :: Status
resStatus = Header -> Status
status Header
h,
resOpaque :: Word32
resOpaque = Header -> Word32
opaque Header
h,
resCas :: Word64
resCas = Header -> Word64
cas Header
h
}
where
kl :: Int
kl = Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int) -> Word16 -> Int
forall a b. (a -> b) -> a -> b
$ Header -> Word16
keyLen Header
h
vl :: Int
vl = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Header -> Word32
bodyLen Header
h) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
kl
dzStatus :: Get Status
dzStatus :: Get Status
dzStatus = do
Word16
st <- Get Word16
getWord16be
Status -> Get Status
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (Status -> Get Status) -> Status -> Get Status
forall a b. (a -> b) -> a -> b
$ case Word16
st of
Word16
0x00 -> Status
NoError
Word16
0x01 -> Status
ErrKeyNotFound
Word16
0x02 -> Status
ErrKeyExists
Word16
0x03 -> Status
ErrValueTooLarge
Word16
0x04 -> Status
ErrInvalidArgs
Word16
0x05 -> Status
ErrItemNotStored
Word16
0x06 -> Status
ErrValueNonNumeric
Word16
0x81 -> Status
ErrUnknownCommand
Word16
0x82 -> Status
ErrOutOfMemory
Word16
0x20 -> Status
SaslAuthFail
Word16
0x21 -> Status
SaslAuthContinue
Word16
_ -> MemcacheError -> Status
forall a e. Exception e => e -> a
throw (MemcacheError -> Status) -> MemcacheError -> Status
forall a b. (a -> b) -> a -> b
$ ProtocolError -> MemcacheError
ProtocolError UnknownStatus { protocolError :: String
protocolError = Word16 -> String
forall a. Show a => a -> String
show Word16
st }
chkLength :: (Eq a, Show a) => a -> a -> String -> Get ()
{-# INLINE chkLength #-}
chkLength :: forall a. (Eq a, Show a) => a -> a -> String -> Get ()
chkLength a
expected a
l String
msg = Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a
l a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
expected) (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$
() -> Get ()
forall a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Get ()) -> () -> Get ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> ()
forall a e. Exception e => e -> a
throw (MemcacheError -> ()) -> MemcacheError -> ()
forall a b. (a -> b) -> a -> b
$ ProtocolError -> MemcacheError
ProtocolError BadLength { protocolError :: String
protocolError =
String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" length expected " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
expected String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
l
}