{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}

{-|
Module      : Database.Memcache.Socket
Description : Connection Handling
Copyright   : (c) David Terei, 2016
License     : BSD
Maintainer  : code@davidterei.com
Stability   : stable
Portability : GHC

Handles a single Memcached connection, sending and receiving requests.
-}
module Database.Memcache.Socket (
        -- * Types
        Socket, Request(..), Response(..),

        -- * Operations
        send, recv,

        -- * Serialization / Deserialization
        szRequest, szResponse, dzHeader, dzResponse
    ) where

-- FIXME: Wire works with lazy bytestrings but we receive strict bytestrings
-- from the network...

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 a request to the Memcached server.
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)

-- | Retrieve a single response from the Memcached server.
-- FIXME: read into buffer to minimize read syscalls
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 (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 (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 (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 (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 :: String -> ProtocolError
UnexpectedEOF { protocolError :: String
protocolError = String
"" }

-- | Serialize a response to a ByteString Builder.
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)

-- | Serialize a request to a ByteString Builder.
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)

-- Extract needed info from an OpRequest for serialization.
-- FIXME: Make sure this is optimized well (no tuple, boxing, unboxing, inlined)
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
    -- FIXME: make sure this isn't a thunk! (c)
    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 -- Quiet
                                   | Bool
otherwise                    = Word8
0x0D -- Quiet && IncludeKey
                             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)
    -- FIXME: beware allocation.
    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)

    -- XXX: Should kill in future, ugly
    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

-- | Deserialize a Header from a ByteString.
dzHeader :: PktType -> Get Header
{-# INLINE dzHeader #-}
dzHeader :: PktType -> Get Header
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 :: String -> 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 :: String -> 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 -- unused data type field
    Status
st  <- Get Status
dzStatus
    Word32
bl  <- Get Word32
getWord32be
    Word32
opq <- Get Word32
getWord32be
    Word64
ver <- Get Word64
getWord64be
    Header -> Get Header
forall (m :: * -> *) a. Monad m => a -> m a
return Header :: Word8
-> Word16
-> Word8
-> Status
-> Word32
-> Word32
-> Word64
-> Header
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
        }

-- | Deserialize a Response body.
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
        -- SASL
        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 :: String -> ProtocolError
UnknownOp { protocolError :: String
protocolError = Word8 -> String
forall a. Show a => a -> String
show (Header -> Word8
op Header
h) }

-- | Deserialize the body of a Response that contains nothing.
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 (m :: * -> *) a. Monad m => a -> m a
return Res :: OpResponse -> Status -> Word32 -> Word64 -> Response
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
        }

-- | Deserialize the body of a Get Response (Extras [flags] & Value).
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Get Word32
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 (m :: * -> *) a. Monad m => a -> m a
return Res :: OpResponse -> Status -> Word32 -> Word64 -> Response
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
    
-- | Deserialize the body of a GetK Response (Extras [flags] & Key & Value).
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Get Word32
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"
    -- FIXME: check strictness ($!)
    Response -> Get Response
forall (m :: * -> *) a. Monad m => a -> m a
return Res :: OpResponse -> Status -> Word32 -> Word64 -> Response
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

-- | Deserialize the body of a Incr/Decr Response (Value [Word64]).
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Get Word64
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 (m :: * -> *) a. Monad m => a -> m a
return Res :: OpResponse -> Status -> Word32 -> Word64 -> Response
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
        }

-- | Deserialize the body of a general response that just has a value (no key
-- or extras).
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 (m :: * -> *) a. Monad m => a -> m a
return Res :: OpResponse -> Status -> Word32 -> Word64 -> Response
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
        }

-- | Deserialize the body of a general response that just has a key and value
-- (no extras).
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 (m :: * -> *) a. Monad m => a -> m a
return Res :: OpResponse -> Status -> Word32 -> Word64 -> Response
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

-- | Deserialize a Response status code.
dzStatus :: Get Status
dzStatus :: Get Status
dzStatus = do
    Word16
st <- Get Word16
getWord16be
    Status -> Get Status
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 :: String -> ProtocolError
UnknownStatus { protocolError :: String
protocolError = Word16 -> String
forall a. Show a => a -> String
show Word16
st }

-- | Check the length of a header field is as expected, throwing a
-- ProtocolError exception if it is not.
chkLength :: (Eq a, Show a) => a -> a -> String -> Get ()
{-# INLINE chkLength #-}
chkLength :: 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 (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 :: String -> 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
  }