{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- |
-- Module:      Network.Riak.Content
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>
-- Stability:   experimental
-- Portability: portable
--
-- im in ur msg system taggin ur msg types

module Network.Riak.Tag
    (
      putTag
    , getTag
    ) where

import Data.Binary.Get (Get, getWord8)
import Data.Binary.Put (Put, putWord8)
import Data.Word (Word8)
import qualified Data.HashMap.Strict as HM
#if __GLASGOW_HASKELL__ <= 708
import Control.Applicative
#endif
import Data.Riak.Proto
import Data.Tuple (swap)
import Network.Riak.Types.Internal as Types

instance Tagged RpbErrorResp where
    messageTag :: RpbErrorResp -> MessageTag
messageTag RpbErrorResp
_ = MessageTag
Types.ErrorResponse
    {-# INLINE messageTag #-}

instance Response RpbErrorResp

instance Tagged RpbPingReq where
    messageTag :: RpbPingReq -> MessageTag
messageTag RpbPingReq
_ = MessageTag
Types.PingRequest
    {-# INLINE messageTag #-}

instance Request RpbPingReq where
    expectedResponse :: RpbPingReq -> MessageTag
expectedResponse RpbPingReq
_ = MessageTag
Types.PingResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbGetClientIdReq where
    messageTag :: RpbGetClientIdReq -> MessageTag
messageTag RpbGetClientIdReq
_ = MessageTag
Types.GetClientIDRequest
    {-# INLINE messageTag #-}

instance Request RpbGetClientIdReq where
    expectedResponse :: RpbGetClientIdReq -> MessageTag
expectedResponse RpbGetClientIdReq
_ = MessageTag
Types.GetClientIDResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbGetClientIdResp where
    messageTag :: RpbGetClientIdResp -> MessageTag
messageTag RpbGetClientIdResp
_ = MessageTag
Types.GetClientIDResponse
    {-# INLINE messageTag #-}

instance Response RpbGetClientIdResp

instance Exchange RpbGetClientIdReq RpbGetClientIdResp

instance Tagged RpbSetClientIdReq where
    messageTag :: RpbSetClientIdReq -> MessageTag
messageTag RpbSetClientIdReq
_ = MessageTag
Types.SetClientIDRequest
    {-# INLINE messageTag #-}

instance Request RpbSetClientIdReq where
    expectedResponse :: RpbSetClientIdReq -> MessageTag
expectedResponse RpbSetClientIdReq
_ = MessageTag
Types.SetClientIDResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbGetServerInfoReq where
    messageTag :: RpbGetServerInfoReq -> MessageTag
messageTag RpbGetServerInfoReq
_ = MessageTag
Types.GetServerInfoRequest
    {-# INLINE messageTag #-}

instance Request RpbGetServerInfoReq where
    expectedResponse :: RpbGetServerInfoReq -> MessageTag
expectedResponse RpbGetServerInfoReq
_ = MessageTag
Types.GetServerInfoResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbGetServerInfoResp where
    messageTag :: RpbGetServerInfoResp -> MessageTag
messageTag RpbGetServerInfoResp
_ = MessageTag
Types.GetServerInfoResponse
    {-# INLINE messageTag #-}

instance Response RpbGetServerInfoResp

instance Exchange RpbGetServerInfoReq RpbGetServerInfoResp

instance Tagged RpbGetReq where
    messageTag :: RpbGetReq -> MessageTag
messageTag RpbGetReq
_ = MessageTag
Types.GetRequest
    {-# INLINE messageTag #-}

instance Tagged RpbIndexReq where
    messageTag :: RpbIndexReq -> MessageTag
messageTag RpbIndexReq
_ = MessageTag
Types.IndexRequest
    {-# INLINE messageTag #-}

instance Request RpbGetReq where
    expectedResponse :: RpbGetReq -> MessageTag
expectedResponse RpbGetReq
_ = MessageTag
Types.GetResponse
    {-# INLINE expectedResponse #-}

instance Request RpbIndexReq where
    expectedResponse :: RpbIndexReq -> MessageTag
expectedResponse RpbIndexReq
_ = MessageTag
Types.IndexResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbGetResp where
    messageTag :: RpbGetResp -> MessageTag
messageTag RpbGetResp
_ = MessageTag
Types.GetResponse
    {-# INLINE messageTag #-}

instance Tagged RpbIndexResp where
    messageTag :: RpbIndexResp -> MessageTag
messageTag RpbIndexResp
_ = MessageTag
Types.IndexResponse
    {-# INLINE messageTag #-}

instance Response RpbGetResp

instance Response RpbIndexResp

instance Exchange RpbGetReq RpbGetResp

instance Exchange RpbIndexReq RpbIndexResp

instance Tagged RpbPutReq where
    messageTag :: RpbPutReq -> MessageTag
messageTag RpbPutReq
_ = MessageTag
Types.PutRequest
    {-# INLINE messageTag #-}

instance Request RpbPutReq where
    expectedResponse :: RpbPutReq -> MessageTag
expectedResponse RpbPutReq
_ = MessageTag
Types.PutResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbPutResp where
    messageTag :: RpbPutResp -> MessageTag
messageTag RpbPutResp
_ = MessageTag
Types.PutResponse
    {-# INLINE messageTag #-}

instance Response RpbPutResp

instance Exchange RpbPutReq RpbPutResp

instance Tagged RpbDelReq where
    messageTag :: RpbDelReq -> MessageTag
messageTag RpbDelReq
_ = MessageTag
Types.DeleteRequest
    {-# INLINE messageTag #-}

instance Request RpbDelReq where
    expectedResponse :: RpbDelReq -> MessageTag
expectedResponse RpbDelReq
_ = MessageTag
Types.DeleteResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbListBucketsReq where
    messageTag :: RpbListBucketsReq -> MessageTag
messageTag RpbListBucketsReq
_ = MessageTag
Types.ListBucketsRequest
    {-# INLINE messageTag #-}

instance Request RpbListBucketsReq where
    expectedResponse :: RpbListBucketsReq -> MessageTag
expectedResponse RpbListBucketsReq
_ = MessageTag
Types.ListBucketsResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbListBucketsResp where
    messageTag :: RpbListBucketsResp -> MessageTag
messageTag RpbListBucketsResp
_ = MessageTag
Types.ListBucketsResponse
    {-# INLINE messageTag #-}

instance Response RpbListBucketsResp

instance Exchange RpbListBucketsReq RpbListBucketsResp

instance Tagged RpbListKeysReq where
    messageTag :: RpbListKeysReq -> MessageTag
messageTag RpbListKeysReq
_ = MessageTag
Types.ListKeysRequest
    {-# INLINE messageTag #-}

instance Request RpbListKeysReq where
    expectedResponse :: RpbListKeysReq -> MessageTag
expectedResponse RpbListKeysReq
_ = MessageTag
Types.ListKeysResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbListKeysResp where
    messageTag :: RpbListKeysResp -> MessageTag
messageTag RpbListKeysResp
_ = MessageTag
Types.ListKeysResponse
    {-# INLINE messageTag #-}

instance Response RpbListKeysResp

instance Tagged RpbGetBucketReq where
    messageTag :: RpbGetBucketReq -> MessageTag
messageTag RpbGetBucketReq
_ = MessageTag
Types.GetBucketRequest
    {-# INLINE messageTag #-}

instance Request RpbGetBucketReq where
    expectedResponse :: RpbGetBucketReq -> MessageTag
expectedResponse RpbGetBucketReq
_ = MessageTag
Types.GetBucketResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbGetBucketResp where
    messageTag :: RpbGetBucketResp -> MessageTag
messageTag RpbGetBucketResp
_ = MessageTag
Types.GetBucketResponse
    {-# INLINE messageTag #-}

instance Response RpbGetBucketResp

instance Exchange RpbGetBucketReq RpbGetBucketResp

instance Tagged RpbSetBucketReq where
    messageTag :: RpbSetBucketReq -> MessageTag
messageTag RpbSetBucketReq
_ = MessageTag
Types.SetBucketRequest
    {-# INLINE messageTag #-}

instance Request RpbSetBucketReq where
    expectedResponse :: RpbSetBucketReq -> MessageTag
expectedResponse RpbSetBucketReq
_ = MessageTag
Types.SetBucketResponse
    {-# INLINE expectedResponse #-}

instance Request RpbGetBucketTypeReq where
    expectedResponse :: RpbGetBucketTypeReq -> MessageTag
expectedResponse RpbGetBucketTypeReq
_ = MessageTag
Types.GetBucketResponse

instance Tagged RpbGetBucketTypeReq where
    messageTag :: RpbGetBucketTypeReq -> MessageTag
messageTag RpbGetBucketTypeReq
_ = MessageTag
Types.GetBucketTypeRequest

instance Exchange RpbGetBucketTypeReq RpbGetBucketResp

instance Tagged RpbMapRedReq where
    messageTag :: RpbMapRedReq -> MessageTag
messageTag RpbMapRedReq
_ = MessageTag
Types.MapReduceRequest
    {-# INLINE messageTag #-}

instance Request RpbMapRedReq where
    expectedResponse :: RpbMapRedReq -> MessageTag
expectedResponse RpbMapRedReq
_ = MessageTag
Types.MapReduceResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbMapRedResp where
    messageTag :: RpbMapRedResp -> MessageTag
messageTag RpbMapRedResp
_ = MessageTag
Types.MapReduceResponse
    {-# INLINE messageTag #-}


instance Response RpbMapRedResp

instance Exchange RpbMapRedReq RpbMapRedResp

instance Tagged DtFetchReq where
    messageTag :: DtFetchReq -> MessageTag
messageTag DtFetchReq
_ = MessageTag
Types.DtFetchRequest
    {-# INLINE messageTag #-}

instance Tagged DtFetchResp where
    messageTag :: DtFetchResp -> MessageTag
messageTag DtFetchResp
_ = MessageTag
Types.DtFetchResponse
    {-# INLINE messageTag #-}

instance Request DtFetchReq where
    expectedResponse :: DtFetchReq -> MessageTag
expectedResponse DtFetchReq
_ = MessageTag
Types.DtFetchResponse
    {-# INLINE expectedResponse #-}

instance Response DtFetchResp

instance Exchange DtFetchReq DtFetchResp

instance Tagged DtUpdateReq where
    messageTag :: DtUpdateReq -> MessageTag
messageTag DtUpdateReq
_ = MessageTag
Types.DtUpdateRequest
    {-# INLINE messageTag #-}

instance Tagged DtUpdateResp where
    messageTag :: DtUpdateResp -> MessageTag
messageTag DtUpdateResp
_ = MessageTag
Types.DtUpdateResponse
    {-# INLINE messageTag #-}

instance Request DtUpdateReq where
    expectedResponse :: DtUpdateReq -> MessageTag
expectedResponse DtUpdateReq
_ = MessageTag
Types.DtUpdateResponse
    {-# INLINE expectedResponse #-}

instance Response DtUpdateResp

instance Exchange DtUpdateReq DtUpdateResp

instance Tagged RpbSearchQueryReq where
    messageTag :: RpbSearchQueryReq -> MessageTag
messageTag RpbSearchQueryReq
_ = MessageTag
Types.SearchQueryRequest
    {-# INLINE messageTag #-}

instance Request RpbSearchQueryReq where
    expectedResponse :: RpbSearchQueryReq -> MessageTag
expectedResponse RpbSearchQueryReq
_ = MessageTag
Types.SearchQueryResponse
    {-# INLINE expectedResponse #-}

instance Tagged RpbSearchQueryResp where
    messageTag :: RpbSearchQueryResp -> MessageTag
messageTag RpbSearchQueryResp
_ = MessageTag
Types.SearchQueryResponse
    {-# INLINE messageTag #-}

instance Response RpbSearchQueryResp

instance Exchange RpbSearchQueryReq RpbSearchQueryResp

instance Tagged RpbYokozunaIndexGetReq where
    messageTag :: RpbYokozunaIndexGetReq -> MessageTag
messageTag RpbYokozunaIndexGetReq
_ = MessageTag
Types.YokozunaIndexGetRequest

instance Request RpbYokozunaIndexGetReq where
    expectedResponse :: RpbYokozunaIndexGetReq -> MessageTag
expectedResponse RpbYokozunaIndexGetReq
_ = MessageTag
Types.YokozunaIndexGetResponse

instance Tagged RpbYokozunaIndexGetResp where
    messageTag :: RpbYokozunaIndexGetResp -> MessageTag
messageTag RpbYokozunaIndexGetResp
_ = MessageTag
Types.YokozunaIndexGetResponse

instance Response RpbYokozunaIndexGetResp

instance Exchange RpbYokozunaIndexGetReq RpbYokozunaIndexGetResp

instance Request RpbYokozunaIndexPutReq where
  expectedResponse :: RpbYokozunaIndexPutReq -> MessageTag
expectedResponse RpbYokozunaIndexPutReq
_ = MessageTag
Types.YokozunaIndexPutRequest

instance Tagged RpbYokozunaIndexPutReq where
  messageTag :: RpbYokozunaIndexPutReq -> MessageTag
messageTag RpbYokozunaIndexPutReq
_ = MessageTag
Types.YokozunaIndexPutRequest

instance Exchange RpbYokozunaIndexPutReq RpbPutResp

instance Tagged RpbYokozunaIndexDeleteReq where
    messageTag :: RpbYokozunaIndexDeleteReq -> MessageTag
messageTag RpbYokozunaIndexDeleteReq
_ = MessageTag
Types.YokozunaIndexDeleteRequest

instance Request RpbYokozunaIndexDeleteReq where
    expectedResponse :: RpbYokozunaIndexDeleteReq -> MessageTag
expectedResponse RpbYokozunaIndexDeleteReq
_ = MessageTag
Types.DeleteResponse

putTag :: MessageTag -> Put
putTag :: MessageTag -> Put
putTag MessageTag
m = Word8 -> Put
putWord8 (Word8 -> Put) -> Word8 -> Put
forall a b. (a -> b) -> a -> b
$ HashMap MessageTag Word8
message2code HashMap MessageTag Word8 -> MessageTag -> Word8
forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! MessageTag
m
{-# INLINE putTag #-}

getTag :: Get MessageTag
getTag :: Get MessageTag
getTag = do
  Word8
n <- Get Word8
getWord8
  Get MessageTag
-> (MessageTag -> Get MessageTag)
-> Maybe MessageTag
-> Get MessageTag
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Word8 -> Get MessageTag
forall a a. Show a => a -> a
err Word8
n) MessageTag -> Get MessageTag
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe MessageTag -> Get MessageTag)
-> Maybe MessageTag -> Get MessageTag
forall a b. (a -> b) -> a -> b
$ Word8 -> HashMap Word8 MessageTag -> Maybe MessageTag
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Word8
n HashMap Word8 MessageTag
code2message
      where
        err :: a -> a
err a
n = String -> String -> a
forall a. String -> String -> a
moduleError String
"getTag" (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"invalid riak message code: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
{-# INLINE getTag #-}

moduleError :: String -> String -> a
moduleError :: String -> String -> a
moduleError = String -> String -> String -> a
forall a. String -> String -> String -> a
netError String
"Network.Riak.Tag"


code2message :: HM.HashMap Word8 MessageTag
code2message :: HashMap Word8 MessageTag
code2message = [(Word8, MessageTag)] -> HashMap Word8 MessageTag
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList [(Word8, MessageTag)]
messageCodes

message2code :: HM.HashMap MessageTag Word8
message2code :: HashMap MessageTag Word8
message2code = [(MessageTag, Word8)] -> HashMap MessageTag Word8
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList ([(MessageTag, Word8)] -> HashMap MessageTag Word8)
-> ([(Word8, MessageTag)] -> [(MessageTag, Word8)])
-> [(Word8, MessageTag)]
-> HashMap MessageTag Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word8, MessageTag) -> (MessageTag, Word8))
-> [(Word8, MessageTag)] -> [(MessageTag, Word8)]
forall a b. (a -> b) -> [a] -> [b]
map (Word8, MessageTag) -> (MessageTag, Word8)
forall a b. (a, b) -> (b, a)
swap ([(Word8, MessageTag)] -> HashMap MessageTag Word8)
-> [(Word8, MessageTag)] -> HashMap MessageTag Word8
forall a b. (a -> b) -> a -> b
$ [(Word8, MessageTag)]
messageCodes

messageCodes :: [(Word8, MessageTag)]
messageCodes :: [(Word8, MessageTag)]
messageCodes = [
 -- From riak-2.1.3/deps/riak_pb/src/riak_pb_messages.csv
 --
 -- This is a list of all known riak messages (with appropriate
 -- message codes).  Most of them are described at
 -- http://docs.basho.com/riak/2.1.3/dev/references/protocol-buffers/
 --
 -- Commented ones are messages we don't use/support yet.
 (Word8
0, MessageTag
Types.ErrorResponse),
 (Word8
1, MessageTag
Types.PingRequest),
 (Word8
2, MessageTag
Types.PingResponse),
 (Word8
3, MessageTag
Types.GetClientIDResponse),
 (Word8
4, MessageTag
Types.GetClientIDResponse),
 (Word8
5, MessageTag
Types.SetClientIDRequest),
 (Word8
6, MessageTag
Types.SetClientIDResponse),
 (Word8
7, MessageTag
Types.GetServerInfoRequest),
 (Word8
8, MessageTag
Types.GetServerInfoResponse),
 (Word8
9, MessageTag
Types.GetRequest),
 (Word8
10, MessageTag
Types.GetResponse),
 (Word8
11, MessageTag
Types.PutRequest),
 (Word8
12, MessageTag
Types.PutResponse),
 (Word8
13, MessageTag
Types.DeleteRequest),
 (Word8
14, MessageTag
Types.DeleteResponse),
 (Word8
15, MessageTag
Types.ListBucketsRequest),
 (Word8
16, MessageTag
Types.ListBucketsResponse),
 (Word8
17, MessageTag
Types.ListKeysRequest),
 (Word8
18, MessageTag
Types.ListKeysResponse),
 (Word8
19, MessageTag
Types.GetBucketRequest),
 (Word8
20, MessageTag
Types.GetBucketResponse),
 (Word8
21, MessageTag
Types.SetBucketRequest),
 (Word8
22, MessageTag
Types.SetBucketResponse),
 (Word8
23, MessageTag
Types.MapReduceRequest),
 (Word8
24, MessageTag
Types.MapReduceResponse),
 (Word8
25, MessageTag
Types.IndexRequest),
 (Word8
26, MessageTag
Types.IndexResponse),
 (Word8
27, MessageTag
Types.SearchQueryRequest),
 (Word8
28, MessageTag
Types.SearchQueryResponse),
 -- (29,ResetBucketRequest),
 -- (30,ResetBucketResp),
 (Word8
31, MessageTag
Types.GetBucketTypeRequest),
 -- (32,SetBucketTypeReq),
 -- (33,GetBucketKeyPreflistReq),
 -- (34,GetBucketKeyPreflistResp),
 -- (40,CSBucketReq),
 -- (41,CSBucketResp),
 -- (50,CounterUpdateReq),
 -- (51,CounterUpdateResp),
 -- (52,CounterGetReq),
 -- (53,CounterGetResp),
 (Word8
54, MessageTag
Types.YokozunaIndexGetRequest),
 (Word8
55, MessageTag
Types.YokozunaIndexGetResponse),
 (Word8
56, MessageTag
Types.YokozunaIndexPutRequest),
 (Word8
57, MessageTag
Types.YokozunaIndexDeleteRequest),
 -- (58,YokozunaSchemaGetReq),
 -- (59,YokozunaSchemaGetResp),
 -- (60,YokozunaSchemaPutReq),
 (Word8
80, MessageTag
Types.DtFetchRequest),
 (Word8
81, MessageTag
Types.DtFetchResponse),
 (Word8
82, MessageTag
Types.DtUpdateRequest),
 (Word8
83, MessageTag
Types.DtUpdateResponse)
 -- (253,RpbAuthReq),
 -- (254,RpbAuthResp),
 -- (255,RpbStartTls)
 ]