{-# LANGUAGE BangPatterns, DeriveDataTypeable, FunctionalDependencies,
    MultiParamTypeClasses, RecordWildCards, DeriveGeneric #-}

-- |
-- Module:      Network.Riak.Types.Internal
-- Copyright:   (c) 2011 MailRank, Inc.
-- License:     Apache
-- Maintainer:  Mark Hibberd <mark@hibberd.id.au>, Nathan Hunter <nhunter@janrain.com>
-- Stability:   experimental
-- Portability: portable
--
-- Basic types.

module Network.Riak.Types.Internal
    (
    -- * Client management
      ClientID
    , Client(..)
    -- * Connection management
    , Connection(..)
    -- * Errors
    , RiakException(excModule, excFunction, excMessage)
    , netError
    , typeError
    , unexError
    -- * Data types
    , Bucket
    , BucketType
    , Key
    , Index
    , Schema
    , IndexQuery(..)
    , IndexValue(..)
    , Tag
    , SearchQuery
    , SearchResult(..)
    , Score
    , IndexInfo
    , VClock(..)
    , Job(..)
    , N
    , Timeout
    -- * Quorum management
    , Quorum(..)
    , DW
    , R
    , RW
    , W
    , fromQuorum
    , toQuorum
    -- * Message identification
    , Request(..)
    , Response
    , Exchange
    , MessageTag(..)
    , Tagged(..)
    ) where

import           Control.Exception (Exception, throw)
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LazyByteString
import           Data.Digest.Pure.MD5 (md5)
import           Data.Hashable (Hashable)
import           Data.IORef (IORef)
import qualified Data.Riak.Proto as Proto
import           Data.Typeable (Typeable)
import           Data.Word (Word32)
import           GHC.Generics (Generic)
import           Network.Socket (HostName, ServiceName, Socket)


-- | A client identifier.  This is used by the Riak cluster when
-- logging vector clock changes, and should be unique for each client.
type ClientID = ByteString

data Client = Client {
      Client -> HostName
host :: HostName
    -- ^ Name of the server to connect to.
    , Client -> HostName
port :: ServiceName
    -- ^ Port number to connect to (default is 8087).
    , Client -> ClientID
clientID :: ClientID
    -- ^ Client identifier.
    } deriving (Client -> Client -> Bool
(Client -> Client -> Bool)
-> (Client -> Client -> Bool) -> Eq Client
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Client -> Client -> Bool
$c/= :: Client -> Client -> Bool
== :: Client -> Client -> Bool
$c== :: Client -> Client -> Bool
Eq, Int -> Client -> ShowS
[Client] -> ShowS
Client -> HostName
(Int -> Client -> ShowS)
-> (Client -> HostName) -> ([Client] -> ShowS) -> Show Client
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Client] -> ShowS
$cshowList :: [Client] -> ShowS
show :: Client -> HostName
$cshow :: Client -> HostName
showsPrec :: Int -> Client -> ShowS
$cshowsPrec :: Int -> Client -> ShowS
Show, Typeable)

-- | A connection to a Riak server.
data Connection = Connection {
      Connection -> Socket
connSock :: Socket
    , Connection -> Client
connClient :: Client
    -- ^ The configuration we connected with.
    , Connection -> IORef ClientID
connBuffer :: IORef ByteString
    -- ^ Received data that has not yet been consumed.
    } deriving (Connection -> Connection -> Bool
(Connection -> Connection -> Bool)
-> (Connection -> Connection -> Bool) -> Eq Connection
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Connection -> Connection -> Bool
$c/= :: Connection -> Connection -> Bool
== :: Connection -> Connection -> Bool
$c== :: Connection -> Connection -> Bool
Eq)

-- | The main Riak exception type.
data RiakException = NetException {
      RiakException -> HostName
excModule :: String
    , RiakException -> HostName
excFunction :: String
    , RiakException -> HostName
excMessage :: String
    } | TypeException {
      excModule :: String
    , excFunction :: String
    , excMessage :: String
    } | UnexpectedResponse {
      excModule :: String
    , excFunction :: String
    , excMessage :: String
    }deriving (RiakException -> RiakException -> Bool
(RiakException -> RiakException -> Bool)
-> (RiakException -> RiakException -> Bool) -> Eq RiakException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RiakException -> RiakException -> Bool
$c/= :: RiakException -> RiakException -> Bool
== :: RiakException -> RiakException -> Bool
$c== :: RiakException -> RiakException -> Bool
Eq, Typeable)

showRiakException :: RiakException -> String
showRiakException :: RiakException -> HostName
showRiakException exc :: RiakException
exc@NetException{HostName
excMessage :: HostName
excFunction :: HostName
excModule :: HostName
excMessage :: RiakException -> HostName
excFunction :: RiakException -> HostName
excModule :: RiakException -> HostName
..} =
    HostName
"Riak network error " HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ RiakException -> HostName
formatRiakException RiakException
exc
showRiakException exc :: RiakException
exc@TypeException{HostName
excMessage :: HostName
excFunction :: HostName
excModule :: HostName
excMessage :: RiakException -> HostName
excFunction :: RiakException -> HostName
excModule :: RiakException -> HostName
..} =
    HostName
"Riak type error " HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ RiakException -> HostName
formatRiakException RiakException
exc
showRiakException exc :: RiakException
exc@UnexpectedResponse{HostName
excMessage :: HostName
excFunction :: HostName
excModule :: HostName
excMessage :: RiakException -> HostName
excFunction :: RiakException -> HostName
excModule :: RiakException -> HostName
..} =
    HostName
"Riak server sent unexpected response " HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ RiakException -> HostName
formatRiakException RiakException
exc

formatRiakException :: RiakException -> String
formatRiakException :: RiakException -> HostName
formatRiakException RiakException
exc =
    HostName
"(" HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ RiakException -> HostName
excModule RiakException
exc HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ HostName
"." HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ RiakException -> HostName
excFunction RiakException
exc HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ HostName
"): " HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ RiakException -> HostName
excMessage RiakException
exc

instance Show RiakException where
    show :: RiakException -> HostName
show = RiakException -> HostName
showRiakException

instance Exception RiakException

netError :: String -> String -> String -> a
netError :: HostName -> HostName -> HostName -> a
netError HostName
modu HostName
func HostName
msg = RiakException -> a
forall a e. Exception e => e -> a
throw (HostName -> HostName -> HostName -> RiakException
NetException HostName
modu HostName
func HostName
msg)

typeError :: String -> String -> String -> a
typeError :: HostName -> HostName -> HostName -> a
typeError HostName
modu HostName
func HostName
msg = RiakException -> a
forall a e. Exception e => e -> a
throw (HostName -> HostName -> HostName -> RiakException
TypeException HostName
modu HostName
func HostName
msg)

unexError :: String -> String -> String -> a
unexError :: HostName -> HostName -> HostName -> a
unexError HostName
modu HostName
func HostName
msg = RiakException -> a
forall a e. Exception e => e -> a
throw (HostName -> HostName -> HostName -> RiakException
UnexpectedResponse HostName
modu HostName
func HostName
msg)

instance Show Connection where
    show :: Connection -> HostName
show Connection
conn = [HostName] -> HostName
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [HostName
"Connection ", Client -> HostName
host Client
c, HostName
":", Client -> HostName
port Client
c]
        where c :: Client
c = Connection -> Client
connClient Connection
conn

-- | A Bucket is a container and keyspace for data stored in Riak,
-- with a set of common properties for its contents (the number of
-- replicas, for instance).
type Bucket = ByteString

-- | Bucket types is a riak >= 2.0 feature allowing groups of buckets
-- to share configuration details
type BucketType = ByteString

-- | Keys are unique object identifiers in Riak and are scoped within
-- buckets.
type Key = ByteString

-- | Name of a secondary index
type Index = ByteString

-- | Name of an index schema
type Schema = ByteString

-- | Index query. Can be exact or range, int or bin. Index name should
-- not contain the "_bin" or "_int" part, since it's determined from
-- data constructor.
data IndexQuery = IndexQueryExactInt !Index !Int
                | IndexQueryExactBin !Index !ByteString
                | IndexQueryRangeInt !Index !Int !Int
                | IndexQueryRangeBin !Index !ByteString !ByteString
    deriving (Int -> IndexQuery -> ShowS
[IndexQuery] -> ShowS
IndexQuery -> HostName
(Int -> IndexQuery -> ShowS)
-> (IndexQuery -> HostName)
-> ([IndexQuery] -> ShowS)
-> Show IndexQuery
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [IndexQuery] -> ShowS
$cshowList :: [IndexQuery] -> ShowS
show :: IndexQuery -> HostName
$cshow :: IndexQuery -> HostName
showsPrec :: Int -> IndexQuery -> ShowS
$cshowsPrec :: Int -> IndexQuery -> ShowS
Show, IndexQuery -> IndexQuery -> Bool
(IndexQuery -> IndexQuery -> Bool)
-> (IndexQuery -> IndexQuery -> Bool) -> Eq IndexQuery
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexQuery -> IndexQuery -> Bool
$c/= :: IndexQuery -> IndexQuery -> Bool
== :: IndexQuery -> IndexQuery -> Bool
$c== :: IndexQuery -> IndexQuery -> Bool
Eq)

data IndexValue = IndexInt !Index !Int
                | IndexBin !Index !ByteString
    deriving (Int -> IndexValue -> ShowS
[IndexValue] -> ShowS
IndexValue -> HostName
(Int -> IndexValue -> ShowS)
-> (IndexValue -> HostName)
-> ([IndexValue] -> ShowS)
-> Show IndexValue
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [IndexValue] -> ShowS
$cshowList :: [IndexValue] -> ShowS
show :: IndexValue -> HostName
$cshow :: IndexValue -> HostName
showsPrec :: Int -> IndexValue -> ShowS
$cshowsPrec :: Int -> IndexValue -> ShowS
Show, IndexValue -> IndexValue -> Bool
(IndexValue -> IndexValue -> Bool)
-> (IndexValue -> IndexValue -> Bool) -> Eq IndexValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndexValue -> IndexValue -> Bool
$c/= :: IndexValue -> IndexValue -> Bool
== :: IndexValue -> IndexValue -> Bool
$c== :: IndexValue -> IndexValue -> Bool
Eq)

-- | An application-specific identifier for a link.  See
-- <http://wiki.basho.com/Links.html> for details.
type Tag = ByteString

-- | A specification of a MapReduce
-- job. <http://wiki.basho.com/MapReduce.html>.
data Job = JSON ByteString
         | Erlang ByteString
           deriving (Job -> Job -> Bool
(Job -> Job -> Bool) -> (Job -> Job -> Bool) -> Eq Job
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Job -> Job -> Bool
$c/= :: Job -> Job -> Bool
== :: Job -> Job -> Bool
$c== :: Job -> Job -> Bool
Eq, Int -> Job -> ShowS
[Job] -> ShowS
Job -> HostName
(Int -> Job -> ShowS)
-> (Job -> HostName) -> ([Job] -> ShowS) -> Show Job
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Job] -> ShowS
$cshowList :: [Job] -> ShowS
show :: Job -> HostName
$cshow :: Job -> HostName
showsPrec :: Int -> Job -> ShowS
$cshowsPrec :: Int -> Job -> ShowS
Show, Typeable)

-- | Search request
type SearchQuery = ByteString

-- | Search result score
type Score = Double

-- | Search index info
type IndexInfo = Proto.RpbYokozunaIndex

-- | N value
--
-- http://docs.basho.com/riak/kv/2.1.4/learn/concepts/replication/
type N = Word32

-- | Timeout in milliseconds
type Timeout = Word32

-- | Solr search result
data SearchResult = SearchResult
  { SearchResult -> [[(ClientID, Maybe ClientID)]]
docs     :: ![[(ByteString, Maybe ByteString)]]
  , SearchResult -> Maybe Float
maxScore :: !(Maybe Float)
  , SearchResult -> Maybe Word32
numFound :: !(Maybe Word32)
  } deriving (SearchResult -> SearchResult -> Bool
(SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> Bool) -> Eq SearchResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SearchResult -> SearchResult -> Bool
$c/= :: SearchResult -> SearchResult -> Bool
== :: SearchResult -> SearchResult -> Bool
$c== :: SearchResult -> SearchResult -> Bool
Eq, Eq SearchResult
Eq SearchResult
-> (SearchResult -> SearchResult -> Ordering)
-> (SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> Bool)
-> (SearchResult -> SearchResult -> SearchResult)
-> (SearchResult -> SearchResult -> SearchResult)
-> Ord SearchResult
SearchResult -> SearchResult -> Bool
SearchResult -> SearchResult -> Ordering
SearchResult -> SearchResult -> SearchResult
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SearchResult -> SearchResult -> SearchResult
$cmin :: SearchResult -> SearchResult -> SearchResult
max :: SearchResult -> SearchResult -> SearchResult
$cmax :: SearchResult -> SearchResult -> SearchResult
>= :: SearchResult -> SearchResult -> Bool
$c>= :: SearchResult -> SearchResult -> Bool
> :: SearchResult -> SearchResult -> Bool
$c> :: SearchResult -> SearchResult -> Bool
<= :: SearchResult -> SearchResult -> Bool
$c<= :: SearchResult -> SearchResult -> Bool
< :: SearchResult -> SearchResult -> Bool
$c< :: SearchResult -> SearchResult -> Bool
compare :: SearchResult -> SearchResult -> Ordering
$ccompare :: SearchResult -> SearchResult -> Ordering
$cp1Ord :: Eq SearchResult
Ord, Int -> SearchResult -> ShowS
[SearchResult] -> ShowS
SearchResult -> HostName
(Int -> SearchResult -> ShowS)
-> (SearchResult -> HostName)
-> ([SearchResult] -> ShowS)
-> Show SearchResult
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SearchResult] -> ShowS
$cshowList :: [SearchResult] -> ShowS
show :: SearchResult -> HostName
$cshow :: SearchResult -> HostName
showsPrec :: Int -> SearchResult -> ShowS
$cshowsPrec :: Int -> SearchResult -> ShowS
Show)

-- | List of (known to us) inbound or outbound message identifiers.
data MessageTag = ErrorResponse
                | PingRequest
                | PingResponse
                | GetClientIDRequest
                | GetClientIDResponse
                | SetClientIDRequest
                | SetClientIDResponse
                | GetServerInfoRequest
                | GetServerInfoResponse
                | GetRequest
                | GetResponse
                | PutRequest
                | PutResponse
                | DeleteRequest
                | DeleteResponse
                | ListBucketsRequest
                | ListBucketsResponse
                | ListKeysRequest
                | ListKeysResponse
                | GetBucketRequest
                | GetBucketResponse
                | SetBucketRequest
                | SetBucketResponse
                | GetBucketTypeRequest
                | MapReduceRequest
                | MapReduceResponse
                | IndexRequest
                | IndexResponse
                | DtFetchRequest
                | DtFetchResponse
                | DtUpdateRequest
                | DtUpdateResponse
                | SearchQueryRequest
                | SearchQueryResponse
                | YokozunaIndexGetRequest
                | YokozunaIndexGetResponse
                | YokozunaIndexPutRequest
                | YokozunaIndexDeleteRequest
                  deriving (MessageTag -> MessageTag -> Bool
(MessageTag -> MessageTag -> Bool)
-> (MessageTag -> MessageTag -> Bool) -> Eq MessageTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageTag -> MessageTag -> Bool
$c/= :: MessageTag -> MessageTag -> Bool
== :: MessageTag -> MessageTag -> Bool
$c== :: MessageTag -> MessageTag -> Bool
Eq, Int -> MessageTag -> ShowS
[MessageTag] -> ShowS
MessageTag -> HostName
(Int -> MessageTag -> ShowS)
-> (MessageTag -> HostName)
-> ([MessageTag] -> ShowS)
-> Show MessageTag
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [MessageTag] -> ShowS
$cshowList :: [MessageTag] -> ShowS
show :: MessageTag -> HostName
$cshow :: MessageTag -> HostName
showsPrec :: Int -> MessageTag -> ShowS
$cshowsPrec :: Int -> MessageTag -> ShowS
Show, (forall x. MessageTag -> Rep MessageTag x)
-> (forall x. Rep MessageTag x -> MessageTag) -> Generic MessageTag
forall x. Rep MessageTag x -> MessageTag
forall x. MessageTag -> Rep MessageTag x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MessageTag x -> MessageTag
$cfrom :: forall x. MessageTag -> Rep MessageTag x
Generic)

instance Hashable MessageTag

-- | Messages are tagged.
class Tagged msg where
    messageTag :: msg -> MessageTag -- ^ Retrieve a message's tag.

instance Tagged MessageTag where
    messageTag :: MessageTag -> MessageTag
messageTag MessageTag
m = MessageTag
m
    {-# INLINE messageTag #-}

-- | A message representing a request from client to server.
class (Proto.Message msg, Show msg, Tagged msg) => Request msg
    where expectedResponse :: msg -> MessageTag

-- | A message representing a response from server to client.
class (Proto.Message msg, Show msg, Tagged msg) => Response msg

class (Request req, Response resp) => Exchange req resp
    | req -> resp

-- | A wrapper that keeps Riak vector clocks opaque.
newtype VClock = VClock {
      VClock -> ClientID
fromVClock :: ByteString
    -- ^ Unwrap the 'ByteString'.  (This is really only useful for
    -- printing the raw vclock string.)
    } deriving (VClock -> VClock -> Bool
(VClock -> VClock -> Bool)
-> (VClock -> VClock -> Bool) -> Eq VClock
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VClock -> VClock -> Bool
$c/= :: VClock -> VClock -> Bool
== :: VClock -> VClock -> Bool
$c== :: VClock -> VClock -> Bool
Eq, Typeable)

instance Show VClock where
    show :: VClock -> HostName
show (VClock ClientID
s) = HostName
"VClock " HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ MD5Digest -> HostName
forall a. Show a => a -> HostName
show (ByteString -> MD5Digest
md5 (ClientID -> ByteString
LazyByteString.fromStrict ClientID
s))

-- | A read/write quorum.  The quantity of replicas that must respond
-- to a read or write request before it is considered successful. This
-- is defined as a bucket property or as one of the relevant
-- parameters to a single request ('R','W','DW','RW').
data Quorum = Default   -- ^ Use the default quorum settings for the bucket.
            | One       -- ^ Success after one server has responded.
            | Quorum    -- ^ Success after a quorum of servers has responded.
            | All       -- ^ Success after all servers have responded.
              deriving (Quorum
Quorum -> Quorum -> Bounded Quorum
forall a. a -> a -> Bounded a
maxBound :: Quorum
$cmaxBound :: Quorum
minBound :: Quorum
$cminBound :: Quorum
Bounded, Quorum -> Quorum -> Bool
(Quorum -> Quorum -> Bool)
-> (Quorum -> Quorum -> Bool) -> Eq Quorum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quorum -> Quorum -> Bool
$c/= :: Quorum -> Quorum -> Bool
== :: Quorum -> Quorum -> Bool
$c== :: Quorum -> Quorum -> Bool
Eq, Int -> Quorum
Quorum -> Int
Quorum -> [Quorum]
Quorum -> Quorum
Quorum -> Quorum -> [Quorum]
Quorum -> Quorum -> Quorum -> [Quorum]
(Quorum -> Quorum)
-> (Quorum -> Quorum)
-> (Int -> Quorum)
-> (Quorum -> Int)
-> (Quorum -> [Quorum])
-> (Quorum -> Quorum -> [Quorum])
-> (Quorum -> Quorum -> [Quorum])
-> (Quorum -> Quorum -> Quorum -> [Quorum])
-> Enum Quorum
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Quorum -> Quorum -> Quorum -> [Quorum]
$cenumFromThenTo :: Quorum -> Quorum -> Quorum -> [Quorum]
enumFromTo :: Quorum -> Quorum -> [Quorum]
$cenumFromTo :: Quorum -> Quorum -> [Quorum]
enumFromThen :: Quorum -> Quorum -> [Quorum]
$cenumFromThen :: Quorum -> Quorum -> [Quorum]
enumFrom :: Quorum -> [Quorum]
$cenumFrom :: Quorum -> [Quorum]
fromEnum :: Quorum -> Int
$cfromEnum :: Quorum -> Int
toEnum :: Int -> Quorum
$ctoEnum :: Int -> Quorum
pred :: Quorum -> Quorum
$cpred :: Quorum -> Quorum
succ :: Quorum -> Quorum
$csucc :: Quorum -> Quorum
Enum, Eq Quorum
Eq Quorum
-> (Quorum -> Quorum -> Ordering)
-> (Quorum -> Quorum -> Bool)
-> (Quorum -> Quorum -> Bool)
-> (Quorum -> Quorum -> Bool)
-> (Quorum -> Quorum -> Bool)
-> (Quorum -> Quorum -> Quorum)
-> (Quorum -> Quorum -> Quorum)
-> Ord Quorum
Quorum -> Quorum -> Bool
Quorum -> Quorum -> Ordering
Quorum -> Quorum -> Quorum
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Quorum -> Quorum -> Quorum
$cmin :: Quorum -> Quorum -> Quorum
max :: Quorum -> Quorum -> Quorum
$cmax :: Quorum -> Quorum -> Quorum
>= :: Quorum -> Quorum -> Bool
$c>= :: Quorum -> Quorum -> Bool
> :: Quorum -> Quorum -> Bool
$c> :: Quorum -> Quorum -> Bool
<= :: Quorum -> Quorum -> Bool
$c<= :: Quorum -> Quorum -> Bool
< :: Quorum -> Quorum -> Bool
$c< :: Quorum -> Quorum -> Bool
compare :: Quorum -> Quorum -> Ordering
$ccompare :: Quorum -> Quorum -> Ordering
$cp1Ord :: Eq Quorum
Ord, Int -> Quorum -> ShowS
[Quorum] -> ShowS
Quorum -> HostName
(Int -> Quorum -> ShowS)
-> (Quorum -> HostName) -> ([Quorum] -> ShowS) -> Show Quorum
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Quorum] -> ShowS
$cshowList :: [Quorum] -> ShowS
show :: Quorum -> HostName
$cshow :: Quorum -> HostName
showsPrec :: Int -> Quorum -> ShowS
$cshowsPrec :: Int -> Quorum -> ShowS
Show, Typeable)

-- | Read/write quorum.  How many replicas need to collaborate when
-- deleting a value.
type RW = Quorum

-- | Read quorum.  How many replicas need to agree when retrieving a
-- value.
type R  = Quorum

-- | Write quorum.  How many replicas to write to before returning a
-- successful response.
type W  = Quorum

-- | Durable write quorum.  How many replicas to commit to durable
-- storage before returning a successful response.
type DW = Quorum

fromQuorum :: Quorum -> Maybe Word32
fromQuorum :: Quorum -> Maybe Word32
fromQuorum Quorum
Default = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
4294967291
fromQuorum Quorum
One     = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
4294967294
fromQuorum Quorum
Quorum  = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
4294967293
fromQuorum Quorum
All     = Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
4294967292
{-# INLINE fromQuorum #-}

toQuorum :: Word32 -> Maybe Quorum
toQuorum :: Word32 -> Maybe Quorum
toQuorum Word32
4294967294 = Quorum -> Maybe Quorum
forall a. a -> Maybe a
Just Quorum
One
toQuorum Word32
4294967293 = Quorum -> Maybe Quorum
forall a. a -> Maybe a
Just Quorum
Quorum
toQuorum Word32
4294967292 = Quorum -> Maybe Quorum
forall a. a -> Maybe a
Just Quorum
All
toQuorum Word32
4294967291 = Quorum -> Maybe Quorum
forall a. a -> Maybe a
Just Quorum
Default
toQuorum Word32
v          = HostName -> Maybe Quorum
forall a. HasCallStack => HostName -> a
error (HostName -> Maybe Quorum) -> HostName -> Maybe Quorum
forall a b. (a -> b) -> a -> b
$ HostName
"invalid quorum value " HostName -> ShowS
forall a. [a] -> [a] -> [a]
++ Word32 -> HostName
forall a. Show a => a -> HostName
show Word32
v
{-# INLINE toQuorum #-}