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

Stores the various types needed by Memcached. Mostly concerned with the
representation of the protocol.
-}
module Database.Memcache.Types (
        -- * SASL Authentication
        Authentication(..), Username, Password,

        -- * Fields & Values
        Q(..), K(..), Key, Value, Extras, Initial, Delta, Expiration, Flags,
        Version, Status(..),

        -- * Header
        Header(..), mEMCACHE_HEADER_SIZE, PktType(..),

        -- * Requests
        Request(..), OpRequest(..), SESet(..), SEIncr(..), SETouch(..),
        SERaw(..), emptyReq,

        -- * Responses
        Response(..), OpResponse(..), emptyRes
    ) where

import Blaze.ByteString.Builder (Builder)
import Data.ByteString (ByteString)
import Data.Word

-- | SASL Authentication information for a server.
data Authentication
    = Auth { Authentication -> Username
username :: !Username, Authentication -> Username
password :: !Password }
    | NoAuth
    deriving (Authentication -> Authentication -> Bool
(Authentication -> Authentication -> Bool)
-> (Authentication -> Authentication -> Bool) -> Eq Authentication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Authentication -> Authentication -> Bool
$c/= :: Authentication -> Authentication -> Bool
== :: Authentication -> Authentication -> Bool
$c== :: Authentication -> Authentication -> Bool
Eq, Int -> Authentication -> ShowS
[Authentication] -> ShowS
Authentication -> String
(Int -> Authentication -> ShowS)
-> (Authentication -> String)
-> ([Authentication] -> ShowS)
-> Show Authentication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Authentication] -> ShowS
$cshowList :: [Authentication] -> ShowS
show :: Authentication -> String
$cshow :: Authentication -> String
showsPrec :: Int -> Authentication -> ShowS
$cshowsPrec :: Int -> Authentication -> ShowS
Show)

-- | Username for authentication.
type Username = ByteString

-- | Password for authentication.
type Password = ByteString

{- MEMCACHED MESSAGE:

    header {
        magic    :: Word8
        op       :: Word8
        keyLen   :: Word16
        extraLen :: Word8
        datatype :: Word8
        status / reserved :: Word16
        bodyLen  :: Word32 (total body length)
        opaque   :: Word32
        cas      :: Word64
    }
    extras :: ByteString
    key    :: ByteString
    value  :: ByteString
 -}

mEMCACHE_HEADER_SIZE :: Int
mEMCACHE_HEADER_SIZE :: Int
mEMCACHE_HEADER_SIZE = Int
24

-- | Memcached packet header (for both 'Request' and 'Response').
data Header = Header {
        Header -> Word8
op       :: Word8,
        Header -> Word16
keyLen   :: Word16,
        Header -> Word8
extraLen :: Word8,
        Header -> Status
status   :: Status,
        Header -> Word32
bodyLen  :: Word32,
        Header -> Word32
opaque   :: Word32,
        Header -> Version
cas      :: Version
    } deriving (Header -> Header -> Bool
(Header -> Header -> Bool)
-> (Header -> Header -> Bool) -> Eq Header
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Header -> Header -> Bool
$c/= :: Header -> Header -> Bool
== :: Header -> Header -> Bool
$c== :: Header -> Header -> Bool
Eq, Int -> Header -> ShowS
[Header] -> ShowS
Header -> String
(Int -> Header -> ShowS)
-> (Header -> String) -> ([Header] -> ShowS) -> Show Header
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Header] -> ShowS
$cshowList :: [Header] -> ShowS
show :: Header -> String
$cshow :: Header -> String
showsPrec :: Int -> Header -> ShowS
$cshowsPrec :: Int -> Header -> ShowS
Show)

data PktType = PktRequest | PktResponse
    deriving (PktType -> PktType -> Bool
(PktType -> PktType -> Bool)
-> (PktType -> PktType -> Bool) -> Eq PktType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PktType -> PktType -> Bool
$c/= :: PktType -> PktType -> Bool
== :: PktType -> PktType -> Bool
$c== :: PktType -> PktType -> Bool
Eq, Int -> PktType -> ShowS
[PktType] -> ShowS
PktType -> String
(Int -> PktType -> ShowS)
-> (PktType -> String) -> ([PktType] -> ShowS) -> Show PktType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PktType] -> ShowS
$cshowList :: [PktType] -> ShowS
show :: PktType -> String
$cshow :: PktType -> String
showsPrec :: Int -> PktType -> ShowS
$cshowsPrec :: Int -> PktType -> ShowS
Show)

data Q          = Loud  | Quiet      deriving (Q -> Q -> Bool
(Q -> Q -> Bool) -> (Q -> Q -> Bool) -> Eq Q
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Q -> Q -> Bool
$c/= :: Q -> Q -> Bool
== :: Q -> Q -> Bool
$c== :: Q -> Q -> Bool
Eq, Int -> Q -> ShowS
[Q] -> ShowS
Q -> String
(Int -> Q -> ShowS) -> (Q -> String) -> ([Q] -> ShowS) -> Show Q
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Q] -> ShowS
$cshowList :: [Q] -> ShowS
show :: Q -> String
$cshow :: Q -> String
showsPrec :: Int -> Q -> ShowS
$cshowsPrec :: Int -> Q -> ShowS
Show)
data K          = NoKey | IncludeKey deriving (K -> K -> Bool
(K -> K -> Bool) -> (K -> K -> Bool) -> Eq K
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: K -> K -> Bool
$c/= :: K -> K -> Bool
== :: K -> K -> Bool
$c== :: K -> K -> Bool
Eq, Int -> K -> ShowS
[K] -> ShowS
K -> String
(Int -> K -> ShowS) -> (K -> String) -> ([K] -> ShowS) -> Show K
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [K] -> ShowS
$cshowList :: [K] -> ShowS
show :: K -> String
$cshow :: K -> String
showsPrec :: Int -> K -> ShowS
$cshowsPrec :: Int -> K -> ShowS
Show)
type Key        = ByteString
type Value      = ByteString
type Extras     = ByteString
type Initial    = Word64
type Delta      = Word64
type Expiration = Word32
type Flags      = Word32
type Version    = Word64

data OpRequest
    = ReqGet       Q K Key
    | ReqSet       Q   Key Value SESet
    | ReqAdd       Q   Key Value SESet
    | ReqReplace   Q   Key Value SESet
    | ReqDelete    Q   Key
    | ReqIncrement Q   Key       SEIncr
    | ReqDecrement Q   Key       SEIncr
    | ReqAppend    Q   Key Value
    | ReqPrepend   Q   Key Value
    | ReqTouch         Key       SETouch
    | ReqGAT       Q K Key       SETouch
    | ReqFlush     Q             (Maybe SETouch)
    | ReqNoop
    | ReqVersion
    | ReqStat          (Maybe Key)
    | ReqQuit      Q
    | ReqSASLList
    | ReqSASLStart     Key Value -- key: auth method, value: auth data
    | ReqSASLStep      Key Value -- key: auth method, value: auth data (continued)

    -- | Raw request is custom requests, dangerous as no corresponding raw
    -- response...
    | ReqRaw       Word8 (Maybe Key) (Maybe Value) SERaw
    deriving (OpRequest -> OpRequest -> Bool
(OpRequest -> OpRequest -> Bool)
-> (OpRequest -> OpRequest -> Bool) -> Eq OpRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpRequest -> OpRequest -> Bool
$c/= :: OpRequest -> OpRequest -> Bool
== :: OpRequest -> OpRequest -> Bool
$c== :: OpRequest -> OpRequest -> Bool
Eq, Int -> OpRequest -> ShowS
[OpRequest] -> ShowS
OpRequest -> String
(Int -> OpRequest -> ShowS)
-> (OpRequest -> String)
-> ([OpRequest] -> ShowS)
-> Show OpRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpRequest] -> ShowS
$cshowList :: [OpRequest] -> ShowS
show :: OpRequest -> String
$cshow :: OpRequest -> String
showsPrec :: Int -> OpRequest -> ShowS
$cshowsPrec :: Int -> OpRequest -> ShowS
Show)

{-# WARNING ReqRaw "This is dangerous; no future compatability guaranteed" #-}

data SESet   = SESet   Flags Expiration         deriving (SESet -> SESet -> Bool
(SESet -> SESet -> Bool) -> (SESet -> SESet -> Bool) -> Eq SESet
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SESet -> SESet -> Bool
$c/= :: SESet -> SESet -> Bool
== :: SESet -> SESet -> Bool
$c== :: SESet -> SESet -> Bool
Eq, Int -> SESet -> ShowS
[SESet] -> ShowS
SESet -> String
(Int -> SESet -> ShowS)
-> (SESet -> String) -> ([SESet] -> ShowS) -> Show SESet
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SESet] -> ShowS
$cshowList :: [SESet] -> ShowS
show :: SESet -> String
$cshow :: SESet -> String
showsPrec :: Int -> SESet -> ShowS
$cshowsPrec :: Int -> SESet -> ShowS
Show)
data SEIncr  = SEIncr  Initial Delta Expiration deriving (SEIncr -> SEIncr -> Bool
(SEIncr -> SEIncr -> Bool)
-> (SEIncr -> SEIncr -> Bool) -> Eq SEIncr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SEIncr -> SEIncr -> Bool
$c/= :: SEIncr -> SEIncr -> Bool
== :: SEIncr -> SEIncr -> Bool
$c== :: SEIncr -> SEIncr -> Bool
Eq, Int -> SEIncr -> ShowS
[SEIncr] -> ShowS
SEIncr -> String
(Int -> SEIncr -> ShowS)
-> (SEIncr -> String) -> ([SEIncr] -> ShowS) -> Show SEIncr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SEIncr] -> ShowS
$cshowList :: [SEIncr] -> ShowS
show :: SEIncr -> String
$cshow :: SEIncr -> String
showsPrec :: Int -> SEIncr -> ShowS
$cshowsPrec :: Int -> SEIncr -> ShowS
Show)
data SETouch = SETouch Expiration               deriving (SETouch -> SETouch -> Bool
(SETouch -> SETouch -> Bool)
-> (SETouch -> SETouch -> Bool) -> Eq SETouch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SETouch -> SETouch -> Bool
$c/= :: SETouch -> SETouch -> Bool
== :: SETouch -> SETouch -> Bool
$c== :: SETouch -> SETouch -> Bool
Eq, Int -> SETouch -> ShowS
[SETouch] -> ShowS
SETouch -> String
(Int -> SETouch -> ShowS)
-> (SETouch -> String) -> ([SETouch] -> ShowS) -> Show SETouch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SETouch] -> ShowS
$cshowList :: [SETouch] -> ShowS
show :: SETouch -> String
$cshow :: SETouch -> String
showsPrec :: Int -> SETouch -> ShowS
$cshowsPrec :: Int -> SETouch -> ShowS
Show)
data SERaw   = SERaw   Builder Int

instance Show SERaw where
    show :: SERaw -> String
show SERaw
_ = String
"SERaw _"

instance Eq SERaw where
    == :: SERaw -> SERaw -> Bool
(==) SERaw
_ SERaw
_ = Bool
False

data Request = Req {
        Request -> OpRequest
reqOp     :: OpRequest,
        Request -> Word32
reqOpaque :: Word32,
        Request -> Version
reqCas    :: Version
    } deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq, Int -> Request -> ShowS
[Request] -> ShowS
Request -> String
(Int -> Request -> ShowS)
-> (Request -> String) -> ([Request] -> ShowS) -> Show Request
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Request] -> ShowS
$cshowList :: [Request] -> ShowS
show :: Request -> String
$cshow :: Request -> String
showsPrec :: Int -> Request -> ShowS
$cshowsPrec :: Int -> Request -> ShowS
Show)

-- | Noop request.
emptyReq :: Request
emptyReq :: Request
emptyReq = Req :: OpRequest -> Word32 -> Version -> Request
Req { reqOp :: OpRequest
reqOp = OpRequest
ReqNoop, reqOpaque :: Word32
reqOpaque = Word32
0, reqCas :: Version
reqCas = Version
0 }

data OpResponse
    = ResGet       Q     Value Flags
    | ResGetK      Q Key Value Flags
    | ResSet       Q
    | ResAdd       Q
    | ResReplace   Q
    | ResDelete    Q
    | ResIncrement Q     Word64
    | ResDecrement Q     Word64
    | ResAppend    Q
    | ResPrepend   Q
    | ResTouch
    | ResGAT       Q     Value Flags
    | ResGATK      Q Key Value Flags
    | ResFlush     Q
    | ResNoop
    | ResVersion         Value
    | ResStat        Key Value
    | ResQuit      Q
    | ResSASLList        Value
    | ResSASLStart
    | ResSASLStep
    deriving (OpResponse -> OpResponse -> Bool
(OpResponse -> OpResponse -> Bool)
-> (OpResponse -> OpResponse -> Bool) -> Eq OpResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpResponse -> OpResponse -> Bool
$c/= :: OpResponse -> OpResponse -> Bool
== :: OpResponse -> OpResponse -> Bool
$c== :: OpResponse -> OpResponse -> Bool
Eq, Int -> OpResponse -> ShowS
[OpResponse] -> ShowS
OpResponse -> String
(Int -> OpResponse -> ShowS)
-> (OpResponse -> String)
-> ([OpResponse] -> ShowS)
-> Show OpResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpResponse] -> ShowS
$cshowList :: [OpResponse] -> ShowS
show :: OpResponse -> String
$cshow :: OpResponse -> String
showsPrec :: Int -> OpResponse -> ShowS
$cshowsPrec :: Int -> OpResponse -> ShowS
Show)

-- | The status (success or error) of a Memcached operation returned in a
-- 'Response'.
data Status
    -- | Operation successful.
    = NoError             -- All
    -- | Key not found.
    | ErrKeyNotFound      -- Get, GAT, Touch, Replace, Del, Inc, Dec, App, Pre, Set (key not there and version specified...)
    -- | Key exists when not expected.
    | ErrKeyExists        -- Add, (version): Set, Rep, Del, Inc, Dec, App, Pre
    -- | Value too large to store at server.
    | ErrValueTooLarge    -- Set, Add, Rep, Pre, App
    -- | Invalid arguments for operation.
    | ErrInvalidArgs      -- All
    -- | Key-Value pair not stored at server (internal error).
    | ErrItemNotStored    -- ?
    -- | Value not numeric when increment or decrement requested.
    | ErrValueNonNumeric  -- Incr, Decr
    -- | Server doesn't know requested command.
    | ErrUnknownCommand   -- All
    -- | Server out of memory.
    | ErrOutOfMemory      -- All
    -- | SASL authentication failed.
    | SaslAuthFail        -- SASL
    -- | SASL authentication requires more steps.
    | SaslAuthContinue    -- SASL
    deriving (Status -> Status -> Bool
(Status -> Status -> Bool)
-> (Status -> Status -> Bool) -> Eq Status
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Status -> Status -> Bool
$c/= :: Status -> Status -> Bool
== :: Status -> Status -> Bool
$c== :: Status -> Status -> Bool
Eq, Int -> Status -> ShowS
[Status] -> ShowS
Status -> String
(Int -> Status -> ShowS)
-> (Status -> String) -> ([Status] -> ShowS) -> Show Status
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Status] -> ShowS
$cshowList :: [Status] -> ShowS
show :: Status -> String
$cshow :: Status -> String
showsPrec :: Int -> Status -> ShowS
$cshowsPrec :: Int -> Status -> ShowS
Show)

-- | Memcached response packet.
data Response = Res {
        Response -> OpResponse
resOp     :: OpResponse,
        Response -> Status
resStatus :: Status,
        Response -> Word32
resOpaque :: Word32,
        Response -> Version
resCas    :: Version
    } deriving (Response -> Response -> Bool
(Response -> Response -> Bool)
-> (Response -> Response -> Bool) -> Eq Response
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Response -> Response -> Bool
$c/= :: Response -> Response -> Bool
== :: Response -> Response -> Bool
$c== :: Response -> Response -> Bool
Eq, Int -> Response -> ShowS
[Response] -> ShowS
Response -> String
(Int -> Response -> ShowS)
-> (Response -> String) -> ([Response] -> ShowS) -> Show Response
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Response] -> ShowS
$cshowList :: [Response] -> ShowS
show :: Response -> String
$cshow :: Response -> String
showsPrec :: Int -> Response -> ShowS
$cshowsPrec :: Int -> Response -> ShowS
Show)

-- | Noop response.
emptyRes :: Response
emptyRes :: Response
emptyRes = Res :: OpResponse -> Status -> Word32 -> Version -> Response
Res { resOp :: OpResponse
resOp = OpResponse
ResNoop, resStatus :: Status
resStatus = Status
NoError, resOpaque :: Word32
resOpaque = Word32
0, resCas :: Version
resCas = Version
0 }