packages feed

montage (empty) → 0.1

raw patch · 39 files changed

+2804/−0 lines, 39 filesdep +ListLikedep +aesondep +basesetup-changed

Dependencies added: ListLike, aeson, base, bytestring, containers, old-locale, pool-conduit, protocol-buffers, protocol-buffers-descriptor, riak-bump, safe, stats-web, stm, system-uuid, text, time, unordered-containers, zeromq-haskell

Files

+ LICENSE view
@@ -0,0 +1,25 @@+Copyright 2011 Bump Technologies Inc. All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are+permitted provided that the following conditions are met:++   1. Redistributions of source code must retain the above copyright notice, this list of+      conditions and the following disclaimer.++   2. Redistributions in binary form must reproduce the above copyright notice, this list+      of conditions and the following disclaimer in the documentation and/or other materials+      provided with the distribution.++THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED+WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON+ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.++The views and conclusions contained in the software and documentation are those of the+authors and should not be interpreted as representing official policies, either expressed+or implied, of Bump Technologies Inc.
+ Network/Riak/Montage.hs view
@@ -0,0 +1,101 @@+module Network.Riak.Montage+       (+        -- * Basic proxy+          runDaemon+        , cfg++        -- ** Resolutions+        -- $montageRiakValue++        -- ** Riak connection pools+        -- $pools++        -- ** Configuration+        -- $config++        -- * Proxy types+        , MontageRiakValue(..)+        , Poolable(..)+        , BucketSpec(..)+        , ChainCommand(..)+        , RiakRequest(..)+        , RiakRecord(..)+        , CommandResponse(..)+        , ChainIteration(..)+        , RiakResponse+        , PoolChooser+        , Config(..)+        , LogCallback+        )+       where++import Network.Riak.Montage.Main+import Network.Riak.Montage.Types+import Network.Riak.Montage.Util+import Data.Conduit.Pool (Pool, createPool)+import Network.Riak (defaultClient, connect, disconnect,+                    Client(port), Connection)++-- $montageRiakValue+-- You define your resolutions by saying that your concrete type, ResObject here, is a instance of the 'MontageRiakValue' typeclass:+--+-- @data ResObject = ResObjectConstructorA YourProtobuf+--               | ResObjectConstructorB SomeOtherType+--+--instance 'MontageRiakValue' ResObject where+--    getPB \"bucketA\" = 'BucketSpec'+--                      (ResObjectConstructorA . protobufDeserializer) /-- deserializer/+--                      (\a b -> b) /-- resolution function, here last write wins/+--                      (\(ResObjectConstructorA pb) -> protobufSerializer pb) /-- serializer/+--    getPB \"bucketB\" = 'BucketSpec'+--                     (ResObjectConstructorB . someOtherTypeDeserializer)+--                     (\a b -> a) /-- first write wins/+--                     (\(ResObjectConstructorB x) -> someOtherTypeSerializer x)+--    referenceKey (ResObjectConstructorA pb) = 'Just' (toByteString . intField) $ pb+--    referenceKey (ResObjectConstructorB x) = 'Nothing' /-- no reference key for this type/+-- @+--+-- The getPB function defines how to deserialize your data (as it comes from requests, or from Riak itself), how to resolve siblings if found, and how to serialize your data (to give it back in a response, or to put to Riak).  The reference Key function can define how to make a key from your data, in case you want to chain get requests together (one bucket-key's value is the key to another bucket, etc).+--++-- $pools+-- Montage is setup to allow you to configure buckets to pools, in case you want to process all of your fast fetches on one pool and a few slow fetches on another.  Montage defines the 'Poolable' typeclass for this. For a single pool, where buckets are all handled the same:+--+-- @instance 'Poolable' ('Pool' 'Connection') where+--    chooser p _ = p+-- @+--+-- For two pools:+--+-- @data Pools = Pools {+--    poolA :: 'Pool' 'Connection'+--    poolB :: 'Pool' 'Connection'+-- }+--+-- instance 'Poolable' Pools where+--    chooser p \"bucketA\" = poolA p+--    chooser p \"bucketB\" = poolB p+-- @+--++-- $config+-- To start the proxy, give @runDaemon@ the premade configuration @cfg@, cast to the concrete datatype for which you defined resolutions.  This premade configuration contains a proxyPort which you can modify (or use the default 7078), a 'LogCallback', a stats prefix, and a /non-configurable/ request generator that is the first point of entry into the type inference.+--+-- @import Data.Conduit.Pool (Pool, createPool)+--import Network.Riak (defaultClient, connect, disconnect,+--                    Client(port), Connection)+--+--main :: IO ()+--main = do+--    mainPool <- createPool+--                    (connect $ defaultClient { port = \"8087\" })+--                    disconnect+--                    1 /-- stripes/+--                    10 /-- timeout/+--                    300 /-- max connections/+--    let cfg' = cfg { proxyPort = 7777+--                   , statsPrefix = \"montage.requests.\"}+--    runDaemon (cfg' :: 'Config' ResObject) mainPool+-- @+--+-- See <https://github.com/bumptech/montage/tree/master/examples> for a runnable basic proxy.  See <https://github.com/bumptech/montage-haskell-client/tree/master/examples> for a client and sample requests to run against it.
+ Network/Riak/Montage/Backend.hs view
@@ -0,0 +1,55 @@+module Network.Riak.Montage.Backend where++import Prelude hiding (catch)+import Control.Monad (void, when)+import Control.Exception (catch, throw, SomeException(..))+import Control.Concurrent (threadDelay)+import Data.ByteString.Lazy as L+import Network.Riak.Types+import Network.Riak.Value.Resolvable (getWithLength, put, delete)++import Network.StatsWeb (Stats, incCounter)++import Network.Riak.Montage.Types+import Data.Conduit.Pool (withResource)++maxRetries :: Int+maxRetries = 3++-- We can't actually put in the type signatures below, see+-- http://www.haskell.org/haskellwiki/Type_families#Injectivity.2C_type_inference.2C_and_ambiguity+retryOperation :: IO a -> IO a+retryOperation op =+    retryOperation' 0+  where+    --retryOperation' :: IO a -> Int -> IO a+    retryOperation' retries = catch op (handleError retries)++    --handleError :: (Exception e) => Int -> e -> IO a+    handleError retries e = case retries > maxRetries of+        True -> throw (e :: SomeException)+        False -> do+            threadDelay $ 100000 * retries+            retryOperation' $ retries + 1++doGet :: (MontageRiakValue r) => Stats -> Bucket -> Key -> PoolChooser -> IO (RiakResponse r)+doGet stats buck key chooser' = do+  res <- retryOperation $ withResource (chooser' buck) $ \c -> getWithLength c buck key Default+  case res of+    Just ((resolved, siblings), v) -> do+        let resolvedLength = L.length $ riakSerialize resolved+        when (siblings > 10) $ incCounter "requests.many.siblings" stats+        when (resolvedLength > 1097152) $ incCounter "requests.big" stats+        return $ Just (resolved, v, Just siblings)+    Nothing -> return Nothing++doPut :: (MontageRiakValue r) => Bucket -> Key -> VectorClock -> RiakRecord r -> PoolChooser -> IO (RiakResponse r)+doPut buck key mvc rec chooser' = do+  let riakvc = fmap VClock mvc+  res <- retryOperation $ withResource (chooser' buck) $ \c -> (fmap Just $ put c buck key riakvc rec (Just 1) Default Default)+  return $ fmap (\(r, v) -> (r, v, Nothing)) res++doDelete :: (MontageRiakValue a) => Bucket -> Key -> PoolChooser -> IO (RiakResponse a)+doDelete buck key chooser' = do+  void $ retryOperation $ withResource (chooser' buck) $ (\c -> delete c buck key Default >> return Nothing)+  return Nothing
+ Network/Riak/Montage/Commands.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE BangPatterns #-}+module Network.Riak.Montage.Commands where++import Network.Riak.Montage.Proto.Montage.MontageWireMessages+import Data.List (foldl')+import Data.Maybe (fromMaybe)+import qualified Network.Riak.Types as RT+import qualified Data.Sequence as Seq+import qualified Data.ByteString.Lazy.Char8 as L++import Network.Riak.Types++import Network.Riak.Montage.Proto.Montage.MontageObject (MontageObject(MontageObject))+import Network.Riak.Montage.Proto.Montage.MontageGetResponse+import Network.Riak.Montage.Proto.Montage.MontagePutResponse+import Network.Riak.Montage.Proto.Montage.MontagePutManyResponse+import Network.Riak.Montage.Proto.Montage.MontageGetStatus+import Network.Riak.Montage.Proto.Montage.MontageDeleteResponse++import Network.Riak.Montage.Types+++makeObject :: (MontageRiakValue r) => L.ByteString -> L.ByteString -> (RiakRecord r, VClock, Maybe Int) -> MontageObject+makeObject buck key (rec, vclock, resolutions) =+    MontageObject+        (Just $ RT.fromVClock $ vclock)+        buck+        key+        (riakSerialize rec)+        (fmap fromIntegral resolutions)++++exec :: ( MontageRiakValue r) => ChainCommand r -> ChainIteration r+exec (ChainGet buck key mfollow) =+    IterationRiakCommand [RiakGet buck key] $ fromMaybe finishGet mfollow+  where+    finishGet :: (MontageRiakValue r) => [RiakResponse r] -> ChainCommand r+    finishGet (mres:[]) =+        case mres of+            Just resp -> getResp (Seq.fromList [EXISTS]) obj Seq.empty+              where obj = (Just $ makeObject buck key resp)+            Nothing -> getResp (Seq.fromList [MISSING]) Nothing Seq.empty+    finishGet _ = error "Got unexpected value back from Riak"++    getResp status' master' subs' = ChainReturn $ ResponseProtobuf MONTAGE_GET_RESPONSE $+        MontageGetResponse status' master' subs'++exec (ChainPut vclock buck key rec mcallback) =+    IterationRiakCommand [RiakPut vclock buck key rec] $ fromMaybe finishPut mcallback+  where+    finishPut :: (MontageRiakValue r) => [RiakResponse r] -> ChainCommand r+    finishPut (mres:[]) = ChainReturn $ ResponseProtobuf MONTAGE_PUT_RESPONSE $ makePutResponse buck key mres+    finishPut _  = error "Got unexpected value back from Riak"++exec (ChainPutMany reqs mcallback) =+    IterationRiakCommand [RiakPut vc b k r | (vc, b, k, r) <- reqs] $ fromMaybe finishPutMany mcallback+  where+    finishPutMany :: (MontageRiakValue r) => [RiakResponse r] -> ChainCommand r+    finishPutMany resps =+        ChainReturn $ ResponseProtobuf MONTAGE_PUT_MANY_RESPONSE $ MontagePutManyResponse $ Seq.fromList $ map makeObjectResp $ zip resps reqs++    makeObjectResp :: (MontageRiakValue r) => (RiakResponse r, (VectorClock, RT.Bucket, RT.Key, RiakRecord u)) -> MontagePutResponse+    makeObjectResp (mresp, (_, buck, key, _)) = makePutResponse buck key mresp++exec (ChainGetMany reqs mmaster mcallback) =+    IterationRiakCommand [RiakGet b k | (b, k) <- reqs] $ fromMaybe finishGetMany mcallback+  where+    finishGetMany :: (MontageRiakValue r) => [RiakResponse r] -> ChainCommand r+    finishGetMany rx =+        ChainReturn $ ResponseProtobuf MONTAGE_GET_RESPONSE $+            MontageGetResponse (Seq.fromList $ map doesExist rx) mmaster+                (Seq.fromList $ reverse $ foldl' makeSubObject [] $ zip reqs rx)++    doesExist (Just _) = EXISTS+    doesExist Nothing  = MISSING++    makeSubObject acc (_, Nothing) = acc+    makeSubObject acc ((b, k), Just resp) = (makeObject b k resp) : acc++exec (ChainDelete buck key mcallback) =+    IterationRiakCommand [RiakDelete buck key] $ fromMaybe finishDelete mcallback+  where+    finishDelete :: (MontageRiakValue r) => [RiakResponse r] -> ChainCommand r+    finishDelete [Nothing] = ChainReturn $ ResponseProtobuf MONTAGE_DELETE_RESPONSE MontageDeleteResponse+    finishDelete _ = error "Delete should never return a result"++exec (ChainReference ref key targets) =+    IterationRiakCommand [RiakGet ref key] finishFollowRef+  where+    finishFollowRef :: (MontageRiakValue r) => [RiakResponse r] -> ChainCommand r+    finishFollowRef (r:[]) =+      case r of+            Just resp@(val, _, _) -> case getReferenceKey (ensureEval val) of+                Just realKey -> let firstLookup = (Just $ makeObject ref key resp) in+                    ChainGetMany [ (t, realKey) | t <- targets ] firstLookup Nothing+                Nothing -> nullResp+            Nothing -> nullResp+    finishFollowRef _ = error "Unexpected result back from RiakGet"++    nullResp = ChainReturn $ ResponseProtobuf MONTAGE_GET_RESPONSE $+                    MontageGetResponse Seq.empty Nothing Seq.empty+++exec (ChainCustom cmd arg) = customCommandHandler cmd arg++exec (ChainCommandIO cmd) = ChainIterationIO cmd++-- Finally...+exec (ChainReturn resp) = IterationResponse resp+++makePutResponse :: (MontageRiakValue r) => L.ByteString -> L.ByteString -> RiakResponse r -> MontagePutResponse+makePutResponse buck key mresp =+    case mresp of+        Just resp -> MontagePutResponse True $ makeObject buck key resp+        Nothing -> error "no return value on put??"
+ Network/Riak/Montage/Main.hs view
@@ -0,0 +1,66 @@+module Network.Riak.Montage.Main where++import System.IO (hSetBuffering, BufferMode(..), stdout, stderr)+import Control.Monad (forever, void)+import Control.Concurrent (forkIO, threadDelay)+import qualified Data.Text as T+import qualified Data.ByteString.Lazy.Char8 as B++import Network.StatsWeb (initStats, addCounter, incCounter, runStats, Stats)++import Network.Riak.Montage.Protocol+import Network.Riak.Montage.Process (newEmptyConcurrentState, generateRequest)+import Network.Riak.Montage.Types+import Network.Riak.Montage.Util+++-- | Stats broadcast to localhost, port 3344+montageStats :: [T.Text]+montageStats = [+    "pulse"+  , "requests"+  , "requests.slow"+  , "requests.many.siblings"+  , "requests.big"+  ]++sleepForever :: IO a+sleepForever = forever $ threadDelay (1000000 * 3600)++simpleCallback :: LogCallback+simpleCallback logType _ val = logError $ (B.unpack logType) ++ " " ++ show val++-- | Proxy configuration.  Configurable fields: proxyPort, logger, statsPrefix.  Non-configurable fields: generator.+cfg :: (MontageRiakValue a) => Config a+cfg = Config {+     proxyPort = 7078+   , logger = simpleCallback+   , statsPrefix = "montage"+   , generator = generateRequest+  }++-- | Start the resolution proxy, where you define resolutions for your data @a@, and create one or more Riak connection pools @p@.+runDaemon :: (MontageRiakValue a, Poolable p) => Config a -> p -> IO ()+runDaemon cfg' pools = do+    hSetBuffering stdout LineBuffering+    hSetBuffering stderr LineBuffering++    stats <- initStats (statsPrefix cfg')+    mapM_ (addCounter stats) montageStats++    state <- newEmptyConcurrentState++    let chooser' = chooser pools+    let logging = logger cfg'+    let runOn = "tcp://*:" ++ show (proxyPort cfg')++    void $ forkIO $ loggedSupervise logging "network-zeromq" $ serveMontageZmq (generator cfg') runOn state logging chooser' stats+    void $ forkIO $ loggedSupervise logging "timekeeper" $ timeKeeper stats+    void $ forkIO $ runStats stats 3334+    sleepForever++timeKeeper :: Stats -> IO a+timeKeeper stats = forever $ do+    logError "TICK"+    incCounter "pulse" stats+    threadDelay (5 * 1000000)
+ Network/Riak/Montage/Process.hs view
@@ -0,0 +1,272 @@+module Network.Riak.Montage.Process where++import Control.Monad (void)+import Control.Concurrent (forkIO)+import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar, MVar)+import Control.Concurrent.STM (atomically, newTVarIO)+import Control.Concurrent.STM.TVar (readTVar, writeTVar, TVar)+import Control.Concurrent.STM.TMVar (newEmptyTMVar, readTMVar, putTMVar, TMVar)+import Control.Exception (finally, try, throw, SomeException)+import Text.ProtocolBuffers.WireMessage (messageGet, messagePut)+import System.Timeout (timeout)+import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.Maybe (fromJust)+import Data.Aeson ((.=), object)++import qualified Data.HashMap.Strict as HM+import Control.Applicative++import qualified Network.Riak.Types as RT+import Text.ProtocolBuffers.Basic (toUtf8, utf8)+import qualified Data.Text.Encoding as E+import Data.Foldable (toList)+import qualified Data.ListLike as LL++import qualified Network.Riak.Value as V+import qualified Network.Riak.Content as C++import Network.Riak.Montage.Proto.Montage.MontageEnvelope as ME+import Network.Riak.Montage.Proto.Montage.MontageWireMessages++import Network.StatsWeb (Stats)++import Network.Riak.Montage.Types+import Network.Riak.Montage.Backend+import Network.Riak.Montage.Commands+import Network.Riak.Montage.Util+import qualified Network.Riak.Montage.Proto.Montage.MontageGet as MG+import qualified Network.Riak.Montage.Proto.Montage.MontageGetMany as MGM+import qualified Network.Riak.Montage.Proto.Montage.MontageGetReference as MGR+import qualified Network.Riak.Montage.Proto.Montage.MontagePut as MP+import qualified Network.Riak.Montage.Proto.Montage.MontagePutMany as MPM+import qualified Network.Riak.Montage.Proto.Montage.MontageObject as MO+import qualified Network.Riak.Montage.Proto.Montage.MontageCommand as MC+import qualified Network.Riak.Montage.Proto.Montage.MontageCommandResponse as MCR+import qualified Network.Riak.Montage.Proto.Montage.MontageDelete as MD++-- maxRequests is maximum pending requests before errors are raised+maxRequests :: Int+maxRequests = 500++-- how many requests before printing stats?+statsEvery :: Int+statsEvery = 100++-- how long can a request run before railing?+requestTimeout :: Int+requestTimeout = 30 * 1000000 -- 30s++data ConcurrentState = ConcurrentState {+      concurrentCount :: TVar Int+    , tick            :: TVar Int+    , ts              :: TVar Double+    , pipeline        :: TVar (HM.HashMap (RT.Bucket, RT.Key) (TMVar (Either SomeException CommandResponse)))+    }++newEmptyConcurrentState :: IO ConcurrentState+newEmptyConcurrentState = ConcurrentState <$> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO 0 <*> newTVarIO HM.empty++-- TODO -- include subrequests as part of hash key?+pipelineGet :: (MontageRiakValue t) => ConcurrentState -> ChainCommand t -> IO CommandResponse -> IO CommandResponse+pipelineGet state (ChainGet buck key Nothing) actuallyRun = do+    opt <- eitherAnswerOrMandate+    mans <- case opt of+        Left tmv -> do+            mans <- try actuallyRun+            atomically $ do+                putTMVar tmv mans+                hash <- readTVar (pipeline state)+                let hash' = HM.delete hashkey hash+                writeTVar (pipeline state) hash'+            return mans+        Right tmv -> do+            logError $ "(key request for " ++ (show buck) ++ "/" ++ (show key) ++ " is pipelined)"+            atomically $ readTMVar tmv++    case mans of+        Left (e::SomeException) -> throw e+        Right ans -> return ans+  where+    eitherAnswerOrMandate = atomically $ do+        hash <- readTVar (pipeline state)+        case HM.lookup hashkey hash of+            Just tmv -> return $ Right tmv+            Nothing -> do+                newTmv <- newEmptyTMVar+                let hash' = HM.insert hashkey newTmv hash+                writeTVar (pipeline state) hash'+                return $ Left newTmv++    hashkey = (buck, key)++pipelineGet _ _ actuallyRun = actuallyRun++fromRight :: Either a b -> b+fromRight (Right x) = x+fromRight (Left _) = error "fromRight got Left!"++generateRequest :: (MontageRiakValue r) => MontageEnvelope -> ChainCommand r+generateRequest (MontageEnvelope MONTAGE_GET inp _) =+    ChainGet buck key Nothing+  where+    buck = MG.bucket obj+    key = MG.key obj+    obj = (fst . fromRight $ messageGet $ inp) :: MG.MontageGet++generateRequest (MontageEnvelope MONTAGE_GET_MANY inp _) =+    ChainGetMany gets Nothing Nothing+  where+    wrap = (fst . fromRight $ messageGet $ inp) :: MGM.MontageGetMany+    subs = MGM.gets wrap+    gets = toList $ fmap makeGet subs++    makeGet g = (buck, key)+        where+            buck = MG.bucket g+            key = MG.key g++generateRequest (MontageEnvelope MONTAGE_COMMAND inp _) =+    ChainCustom command arg+  where+    command = E.decodeUtf8 $ lTs $ utf8 $ MC.command obj+    arg = MC.argument obj+    obj = (fst . fromRight $ messageGet $ inp) :: MC.MontageCommand++generateRequest (MontageEnvelope MONTAGE_PUT inp _) =+    ChainPut vclock buck key dat Nothing+  where+    obj = MP.object wrap+    vclock = MO.vclock obj+    buck = MO.bucket obj+    key = MO.key obj+    dat = fromJust $ V.fromContent buck $ C.empty { C.value = MO.data' obj }+    wrap = (fst . fromRight $ messageGet $ inp) :: MP.MontagePut++generateRequest (MontageEnvelope MONTAGE_PUT_MANY inp _) =+    ChainPutMany puts Nothing+  where+    pb = fst $ fromRight $ messageGet inp+    puts = toList $ fmap makePut $ MPM.objects pb+    makePut g = (MO.vclock g, buck, MO.key g, dat)+      where+        buck = MO.bucket g+        dat = fromJust $ V.fromContent buck $ C.empty { C.value = MO.data' g }++generateRequest (MontageEnvelope MONTAGE_GET_REFERENCE inp _) =+    ChainReference buck key targets+  where+    buck = MGR.bucket wrap+    key = MGR.key wrap+    targets = LL.toList $ MGR.target_buckets wrap+    wrap = (fst . fromRight $ messageGet $ inp) :: MGR.MontageGetReference++generateRequest (MontageEnvelope MONTAGE_DELETE inp _) =+    ChainDelete buck key Nothing+  where+    buck = MD.bucket obj+    key = MD.key obj+    obj = (fst . fromRight $ messageGet $ inp) :: MD.MontageDelete++generateRequest (MontageEnvelope MONTAGE_GET_RESPONSE _ _) = error "MONTAGE_GET_RESPONSE is reserved for responses from montage"+generateRequest (MontageEnvelope MONTAGE_COMMAND_RESPONSE _ _) = error "MONTAGE_COMMAND_RESPONSE is reserved for responses from montage"+generateRequest (MontageEnvelope MONTAGE_PUT_RESPONSE _ _) = error "MONTAGE_PUT_RESPONSE is reserved for responses from montage"+generateRequest (MontageEnvelope MONTAGE_PUT_MANY_RESPONSE _ _) = error "MONTAGE_PUT_MANY_RESPONSE is reserved for responses from montage"+generateRequest (MontageEnvelope MONTAGE_ERROR _ _) = error "MONTAGE_ERROR is reserved for responses from montage"+generateRequest (MontageEnvelope MONTAGE_DELETE_RESPONSE _ _) = error "MONTAGE_DELETE_RESPONSE is reserved for responses from montage"+generateRequest (MontageEnvelope DEPRICATED_MONTAGE_SET_REFERENCE _ _) = error "DEPRICATED_MONTAGE_SET_REFERENCE is deprecated!"+++processRequest :: (MontageRiakValue r) => ConcurrentState -> LogCallback -> PoolChooser -> ChainCommand r -> Stats -> IO CommandResponse+processRequest state logCB chooser' cmd stats = do+    mcount <- maybeIncrCount+    case mcount of+        Just count -> do+            logState count+            finally (runWithTimeout (processRequest' chooser' cmd stats)) decrCount+        Nothing -> do+            let errorText = "concurrency limit hit" :: String+            logCB "EXCEPTION" Nothing $ object ["error" .= errorText]+            error errorText+  where+    runWithTimeout actuallyRun = do+        mr <- timeout requestTimeout (pipelineGet state cmd actuallyRun)+        case mr of+            Just r -> do+                return r+            Nothing -> do+                error "montage request timeout!"++    maybeIncrCount = atomically $ do+        count <- readTVar (concurrentCount state)+        if (count < maxRequests)+        then (writeTVar (concurrentCount state) (count + 1) >> return (Just $ count + 1))+        else (return Nothing)++    decrCount = atomically $ do+        count <- readTVar (concurrentCount state)+        writeTVar (concurrentCount state) $ count - 1++    logState count = do+        now <- fmap realToFrac getPOSIXTime+        mlog <- atomically $ do+            tick' <- fmap (+1) $ readTVar (tick state)+            writeTVar (tick state) tick'+            if tick' `mod` statsEvery == 0+            then do+                last' <- readTVar (ts state)+                writeTVar (ts state) now+                return (Just last')+            else (return Nothing)+        case mlog of+            Just last' -> do+                let speed = (fromIntegral statsEvery) / (now - last') -- should never be /0+                logError ("{stats} concurrency=" ++ (show count)+                    ++ " rate=" ++ (show speed))+            Nothing -> return ()++processRequest' :: (MontageRiakValue r) => PoolChooser -> ChainCommand r -> Stats -> IO CommandResponse+processRequest' chooser' cmd stats = do+    let !step = exec cmd+    case step of+        IterationRiakCommand cmds callback -> do+            rs <- runBackendCommands chooser' stats cmds+            let !cmd' = callback rs+            processRequest' chooser' cmd' stats+        IterationResponse final -> return final+        ChainIterationIO ioCmd -> do+            cmd' <- ioCmd+            processRequest' chooser' cmd' stats++runBackendCommands :: (MontageRiakValue r) => PoolChooser -> Stats -> [RiakRequest r] -> IO [RiakResponse r]+runBackendCommands chooser' stats rs = do+    waits <- mapM (runBackendCommand chooser' stats) rs+    results <- mapM takeMVar waits+    return $ map parseResponse results+  where+    parseResponse :: (MontageRiakValue r) => Either SomeException (RiakResponse r) -> RiakResponse r+    parseResponse (Left e) = throw e+    parseResponse (Right res) = res++runBackendCommand' :: (MontageRiakValue r) => IO (RiakResponse r) -> IO (MVar (Either SomeException (RiakResponse r)))+runBackendCommand' f = do+    wait <- newEmptyMVar+    void $ forkIO $ try f >>= putMVar wait+    return wait++runBackendCommand :: (MontageRiakValue r) => PoolChooser -> Stats -> RiakRequest r -> IO (MVar (Either SomeException (RiakResponse r)))+runBackendCommand chooser' stats (RiakGet buck key) =+    runBackendCommand' $ doGet stats buck key chooser'++runBackendCommand chooser' _ (RiakPut mclock buck key value) =+    runBackendCommand' $ doPut buck key mclock value chooser'++runBackendCommand chooser' _ (RiakDelete buck key) =+    runBackendCommand' $ doDelete buck key chooser'++serializeResponse :: MontageEnvelope -> CommandResponse -> MontageEnvelope+serializeResponse env (ResponseProtobuf code proto) =+    env {mtype=code, msg=messagePut proto}+serializeResponse env (ResponseCustom s arg) =+    env {mtype=MONTAGE_COMMAND_RESPONSE,+         msg=messagePut (MCR.MontageCommandResponse (fromRight $ toUtf8 $ sTl $ E.encodeUtf8 s) arg)+    }
+ Network/Riak/Montage/Proto/Montage.hs view
@@ -0,0 +1,21 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage (protoInfo, fileDescriptorProto) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto)+import Text.ProtocolBuffers.Reflections (ProtoInfo)+import qualified Text.ProtocolBuffers.WireMessage as P' (wireGet,getFromBS)+ +protoInfo :: ProtoInfo+protoInfo+ = Prelude'.read+    "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".Montage\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [], baseName = MName \"Montage\"}, protoFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage.hs\"], protoSource = \"montage.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageSubrequestSpec\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageSubrequestSpec\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageSubrequestSpec.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageSubrequestSpec.sub_spec\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageSubrequestSpec\"], baseName' = FName \"sub_spec\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageSubrequestSpec.params\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageSubrequestSpec\"], baseName' = FName \"params\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGet\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGet\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGet.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGet.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGet\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGet.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGet\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGet.sub\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGet\"], baseName' = FName \"sub\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageSubrequestSpec\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageSubrequestSpec\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGetMany\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetMany\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGetMany.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetMany.gets\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetMany\"], baseName' = FName \"gets\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageGet\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGet\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGetReference\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetReference\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGetReference.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetReference.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetReference\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetReference.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetReference\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetReference.target_buckets\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetReference\"], baseName' = FName \"target_buckets\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageObject.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"vclock\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.data\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"data'\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.fetch_resolutions\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"fetch_resolutions\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGetResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGetResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetResponse.status\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetResponse\"], baseName' = FName \"status\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Just (WireTag {getWireTag = 8},WireTag {getWireTag = 10}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageGetStatus\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetStatus\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetResponse.master\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetResponse\"], baseName' = FName \"master\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetResponse.subs\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetResponse\"], baseName' = FName \"subs\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageCommand\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageCommand\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageCommand.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommand.command\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommand\"], baseName' = FName \"command\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommand.argument\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommand\"], baseName' = FName \"argument\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageCommandResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageCommandResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageCommandResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommandResponse.status\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommandResponse\"], baseName' = FName \"status\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommandResponse.value\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommandResponse\"], baseName' = FName \"value\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePut\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePut\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePut.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePut.object\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePut\"], baseName' = FName \"object\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePutResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutResponse.modified\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutResponse\"], baseName' = FName \"modified\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutResponse.object\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutResponse\"], baseName' = FName \"object\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePutMany\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutMany\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePutMany.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutMany.objects\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutMany\"], baseName' = FName \"objects\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePutManyResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutManyResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePutManyResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutManyResponse.objects\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutManyResponse\"], baseName' = FName \"objects\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontagePutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutResponse\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageDelete\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageDelete\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageDelete.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageDelete.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageDelete\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageDelete.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageDelete\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageDeleteResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageDeleteResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageDeleteResponse.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageError\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageError\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageError.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageError.error\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageError\"], baseName' = FName \"error\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False},DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageEnvelope\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageEnvelope\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageEnvelope.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageEnvelope.mtype\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageEnvelope\"], baseName' = FName \"mtype\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageWireMessages\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageWireMessages\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageEnvelope.msg\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageEnvelope\"], baseName' = FName \"msg\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageEnvelope.msgid\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageEnvelope\"], baseName' = FName \"msgid\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}], enums = [EnumInfo {enumName = ProtoName {protobufName = FIName \".Montage.MontageWireMessages\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageWireMessages\"}, enumFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageWireMessages.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"MONTAGE_GET\"),(EnumCode {getEnumCode = 2},\"MONTAGE_GET_REFERENCE\"),(EnumCode {getEnumCode = 3},\"MONTAGE_GET_RESPONSE\"),(EnumCode {getEnumCode = 4},\"MONTAGE_COMMAND\"),(EnumCode {getEnumCode = 5},\"MONTAGE_COMMAND_RESPONSE\"),(EnumCode {getEnumCode = 6},\"MONTAGE_PUT\"),(EnumCode {getEnumCode = 7},\"MONTAGE_PUT_RESPONSE\"),(EnumCode {getEnumCode = 8},\"MONTAGE_GET_MANY\"),(EnumCode {getEnumCode = 9},\"DEPRICATED_MONTAGE_SET_REFERENCE\"),(EnumCode {getEnumCode = 10},\"MONTAGE_PUT_MANY\"),(EnumCode {getEnumCode = 11},\"MONTAGE_PUT_MANY_RESPONSE\"),(EnumCode {getEnumCode = 12},\"MONTAGE_ERROR\"),(EnumCode {getEnumCode = 13},\"MONTAGE_DELETE\"),(EnumCode {getEnumCode = 14},\"MONTAGE_DELETE_RESPONSE\")]},EnumInfo {enumName = ProtoName {protobufName = FIName \".Montage.MontageGetStatus\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetStatus\"}, enumFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGetStatus.hs\"], enumValues = [(EnumCode {getEnumCode = 1},\"EXISTS\"),(EnumCode {getEnumCode = 2},\"MISSING\"),(EnumCode {getEnumCode = 3},\"ERROR\")]}], knownKeyMap = fromList []}"+ +fileDescriptorProto :: FileDescriptorProto+fileDescriptorProto+ = P'.getFromBS (P'.wireGet 11)+    (P'.pack+      "\252\v\n\rmontage.proto\"9\n\NAKMontageSubrequestSpec\DC2\DLE\n\bsub_spec\CAN\SOH \STX(\f\DC2\SO\n\ACKparams\CAN\STX \SOH(\f\"V\n\nMontageGet\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\DC2\v\n\ETXkey\CAN\STX \STX(\f\DC2+\n\ETXsub\CAN\ETX \SOH(\v2\RS.Montage.MontageSubrequestSpec\"3\n\SOMontageGetMany\DC2!\n\EOTgets\CAN\SOH \ETX(\v2\DC3.Montage.MontageGet\"J\n\DC3MontageGetReference\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\DC2\v\n\ETXkey\CAN\STX \STX(\f\DC2\SYN\n\SOtarget_buckets\CAN\ETX \ETX(\f\"e\n\rMontageObject\DC2\SO\n\ACKvclock\CAN\SOH \SOH(\f\DC2\SO\n\ACKbucket\CAN\STX \STX(\f\DC2\v\n\ETXkey\CAN\ETX \STX(\f\DC2\f\n\EOTdata\CAN\EOT \STX(\f\DC2\EM\n\DC1fetch_resolutions\CAN\ENQ \SOH(\r\"\141\SOH\n\DC2MontageGetResponse\DC2)\n\ACKstatus\CAN\SOH \ETX(\SO2\EM.Montage.MontageGetStatus\DC2&\n\ACKmaster\CAN\STX \SOH(\v2\SYN.Montage.MontageObject\DC2$\n\EOTsubs\CAN\ETX \ETX(\v2\SYN.Montage.MontageObject\"3\n\SOMontageCommand\DC2\SI\n\acommand\CAN\SOH \STX(\t\DC2\DLE\n\bargument\CAN\STX \SOH(\f\"7\n\SYNMontageCommandResponse\DC2\SO\n\ACKstatus\CAN\SOH \STX(\t\DC2\r\n\ENQvalue\CAN\STX \SOH(\f\"4\n\nMontagePut\DC2&\n\ACKobject\CAN\SOH \STX(\v2\SYN.Montage.MontageObject\"N\n\DC2MontagePutResponse\DC2\DLE\n\bmodified\CAN\SOH \STX(\b\DC2&\n\ACKobject\CAN\STX \STX(\v2\SYN.Montage.MontageObject\"9\n\SOMontagePutMany\DC2'\n\aobjects\CAN\SOH \ETX(\v2\SYN.Montage.MontageObject\"F\n\SYNMontagePutManyResponse\DC2,\n\aobjects\CAN\SOH \ETX(\v2\ESC.Montage.MontagePutResponse\",\n\rMontageDelete\DC2\SO\n\ACKbucket\CAN\SOH \STX(\f\DC2\v\n\ETXkey\CAN\STX \STX(\f\"\ETB\n\NAKMontageDeleteResponse\"\GS\n\fMontageError\DC2\r\n\ENQerror\CAN\SOH \STX(\t\"Z\n\SIMontageEnvelope\DC2+\n\ENQmtype\CAN\SOH \STX(\SO2\FS.Montage.MontageWireMessages\DC2\v\n\ETXmsg\CAN\STX \STX(\f\DC2\r\n\ENQmsgid\CAN\ETX \SOH(\f*\238\STX\n\DC3MontageWireMessages\DC2\SI\n\vMONTAGE_GET\DLE\SOH\DC2\EM\n\NAKMONTAGE_GET_REFERENCE\DLE\STX\DC2\CAN\n\DC4MONTAGE_GET_RESPONSE\DLE\ETX\DC2\DC3\n\SIMONTAGE_COMMAND\DLE\EOT\DC2\FS\n\CANMONTAGE_COMMAND_RESPONSE\DLE\ENQ\DC2\SI\n\vMONTAGE_PUT\DLE\ACK\DC2\CAN\n\DC4MONTAGE_PUT_RESPONSE\DLE\a\DC2\DC4\n\DLEMONTAGE_GET_MANY\DLE\b\DC2$\n DEPRICATED_MONTAGE_SET_REFERENCE\DLE\t\DC2\DC4\n\DLEMONTAGE_PUT_MANY\DLE\n\DC2\GS\n\EMMONTAGE_PUT_MANY_RESPONSE\DLE\v\DC2\DC1\n\rMONTAGE_ERROR\DLE\f\DC2\DC2\n\SOMONTAGE_DELETE\DLE\r\DC2\ESC\n\ETBMONTAGE_DELETE_RESPONSE\DLE\SO*6\n\DLEMontageGetStatus\DC2\n\n\ACKEXISTS\DLE\SOH\DC2\v\n\aMISSING\DLE\STX\DC2\t\n\ENQERROR\DLE\ETX")
+ Network/Riak/Montage/Proto/Montage/MontageCommand.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageCommand (MontageCommand(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageCommand = MontageCommand{command :: !P'.Utf8, argument :: !(P'.Maybe P'.ByteString)}+                    deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageCommand where+  mergeAppend (MontageCommand x'1 x'2) (MontageCommand y'1 y'2) = MontageCommand (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default MontageCommand where+  defaultValue = MontageCommand P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageCommand where+  wireSize ft' self'@(MontageCommand x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 9 x'1 + P'.wireSizeOpt 1 12 x'2)+  wirePut ft' self'@(MontageCommand x'1 x'2)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 9 x'1+             P'.wirePutOpt 18 12 x'2+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{command = new'Field}) (P'.wireGet 9)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{argument = Prelude'.Just new'Field}) (P'.wireGet 12)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageCommand) MontageCommand where+  getVal m' f' = f' m'+ +instance P'.GPB MontageCommand+ +instance P'.ReflectDescriptor MontageCommand where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageCommand\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageCommand\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageCommand.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommand.command\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommand\"], baseName' = FName \"command\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommand.argument\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommand\"], baseName' = FName \"argument\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageCommandResponse.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageCommandResponse (MontageCommandResponse(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageCommandResponse = MontageCommandResponse{status :: !P'.Utf8, value :: !(P'.Maybe P'.ByteString)}+                            deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageCommandResponse where+  mergeAppend (MontageCommandResponse x'1 x'2) (MontageCommandResponse y'1 y'2)+   = MontageCommandResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default MontageCommandResponse where+  defaultValue = MontageCommandResponse P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageCommandResponse where+  wireSize ft' self'@(MontageCommandResponse x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 9 x'1 + P'.wireSizeOpt 1 12 x'2)+  wirePut ft' self'@(MontageCommandResponse x'1 x'2)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 9 x'1+             P'.wirePutOpt 18 12 x'2+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{status = new'Field}) (P'.wireGet 9)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{value = Prelude'.Just new'Field}) (P'.wireGet 12)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageCommandResponse) MontageCommandResponse where+  getVal m' f' = f' m'+ +instance P'.GPB MontageCommandResponse+ +instance P'.ReflectDescriptor MontageCommandResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageCommandResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageCommandResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageCommandResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommandResponse.status\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommandResponse\"], baseName' = FName \"status\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageCommandResponse.value\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageCommandResponse\"], baseName' = FName \"value\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageDelete.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageDelete (MontageDelete(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageDelete = MontageDelete{bucket :: !P'.ByteString, key :: !P'.ByteString}+                   deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageDelete where+  mergeAppend (MontageDelete x'1 x'2) (MontageDelete y'1 y'2) = MontageDelete (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default MontageDelete where+  defaultValue = MontageDelete P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageDelete where+  wireSize ft' self'@(MontageDelete x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeReq 1 12 x'2)+  wirePut ft' self'@(MontageDelete x'1 x'2)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 12 x'1+             P'.wirePutReq 18 12 x'2+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageDelete) MontageDelete where+  getVal m' f' = f' m'+ +instance P'.GPB MontageDelete+ +instance P'.ReflectDescriptor MontageDelete where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageDelete\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageDelete\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageDelete.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageDelete.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageDelete\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageDelete.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageDelete\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageDeleteResponse.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageDeleteResponse (MontageDeleteResponse(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageDeleteResponse = MontageDeleteResponse{}+                           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageDeleteResponse where+  mergeAppend MontageDeleteResponse MontageDeleteResponse = MontageDeleteResponse+ +instance P'.Default MontageDeleteResponse where+  defaultValue = MontageDeleteResponse+ +instance P'.Wire MontageDeleteResponse where+  wireSize ft' self'@(MontageDeleteResponse)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = 0+  wirePut ft' self'@(MontageDeleteResponse)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             Prelude'.return ()+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageDeleteResponse) MontageDeleteResponse where+  getVal m' f' = f' m'+ +instance P'.GPB MontageDeleteResponse+ +instance P'.ReflectDescriptor MontageDeleteResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageDeleteResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageDeleteResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageDeleteResponse.hs\"], isGroup = False, fields = fromList [], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageEnvelope.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageEnvelope (MontageEnvelope(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontageWireMessages as Montage (MontageWireMessages)+ +data MontageEnvelope = MontageEnvelope{mtype :: !Montage.MontageWireMessages, msg :: !P'.ByteString,+                                       msgid :: !(P'.Maybe P'.ByteString)}+                     deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageEnvelope where+  mergeAppend (MontageEnvelope x'1 x'2 x'3) (MontageEnvelope y'1 y'2 y'3)+   = MontageEnvelope (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default MontageEnvelope where+  defaultValue = MontageEnvelope P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageEnvelope where+  wireSize ft' self'@(MontageEnvelope x'1 x'2 x'3)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 14 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeOpt 1 12 x'3)+  wirePut ft' self'@(MontageEnvelope x'1 x'2 x'3)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 8 14 x'1+             P'.wirePutReq 18 12 x'2+             P'.wirePutOpt 26 12 x'3+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             8 -> Prelude'.fmap (\ !new'Field -> old'Self{mtype = new'Field}) (P'.wireGet 14)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{msg = new'Field}) (P'.wireGet 12)+             26 -> Prelude'.fmap (\ !new'Field -> old'Self{msgid = Prelude'.Just new'Field}) (P'.wireGet 12)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageEnvelope) MontageEnvelope where+  getVal m' f' = f' m'+ +instance P'.GPB MontageEnvelope+ +instance P'.ReflectDescriptor MontageEnvelope where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8, 18]) (P'.fromDistinctAscList [8, 18, 26])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageEnvelope\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageEnvelope\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageEnvelope.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageEnvelope.mtype\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageEnvelope\"], baseName' = FName \"mtype\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageWireMessages\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageWireMessages\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageEnvelope.msg\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageEnvelope\"], baseName' = FName \"msg\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageEnvelope.msgid\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageEnvelope\"], baseName' = FName \"msgid\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageError.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageError (MontageError(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageError = MontageError{error :: !P'.Utf8}+                  deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageError where+  mergeAppend (MontageError x'1) (MontageError y'1) = MontageError (P'.mergeAppend x'1 y'1)+ +instance P'.Default MontageError where+  defaultValue = MontageError P'.defaultValue+ +instance P'.Wire MontageError where+  wireSize ft' self'@(MontageError x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 9 x'1)+  wirePut ft' self'@(MontageError x'1)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 9 x'1+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{error = new'Field}) (P'.wireGet 9)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageError) MontageError where+  getVal m' f' = f' m'+ +instance P'.GPB MontageError+ +instance P'.ReflectDescriptor MontageError where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageError\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageError\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageError.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageError.error\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageError\"], baseName' = FName \"error\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageGet.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageGet (MontageGet(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontageSubrequestSpec as Montage (MontageSubrequestSpec)+ +data MontageGet = MontageGet{bucket :: !P'.ByteString, key :: !P'.ByteString, sub :: !(P'.Maybe Montage.MontageSubrequestSpec)}+                deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageGet where+  mergeAppend (MontageGet x'1 x'2 x'3) (MontageGet y'1 y'2 y'3)+   = MontageGet (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default MontageGet where+  defaultValue = MontageGet P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageGet where+  wireSize ft' self'@(MontageGet x'1 x'2 x'3)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeOpt 1 11 x'3)+  wirePut ft' self'@(MontageGet x'1 x'2 x'3)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 12 x'1+             P'.wirePutReq 18 12 x'2+             P'.wirePutOpt 26 11 x'3+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             26 -> Prelude'.fmap (\ !new'Field -> old'Self{sub = P'.mergeAppend (sub old'Self) (Prelude'.Just new'Field)})+                    (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageGet) MontageGet where+  getVal m' f' = f' m'+ +instance P'.GPB MontageGet+ +instance P'.ReflectDescriptor MontageGet where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18, 26])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGet\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGet\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGet.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGet.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGet\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGet.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGet\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGet.sub\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGet\"], baseName' = FName \"sub\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageSubrequestSpec\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageSubrequestSpec\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageGetMany.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageGetMany (MontageGetMany(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontageGet as Montage (MontageGet)+ +data MontageGetMany = MontageGetMany{gets :: !(P'.Seq Montage.MontageGet)}+                    deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageGetMany where+  mergeAppend (MontageGetMany x'1) (MontageGetMany y'1) = MontageGetMany (P'.mergeAppend x'1 y'1)+ +instance P'.Default MontageGetMany where+  defaultValue = MontageGetMany P'.defaultValue+ +instance P'.Wire MontageGetMany where+  wireSize ft' self'@(MontageGetMany x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 11 x'1)+  wirePut ft' self'@(MontageGetMany x'1)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutRep 10 11 x'1+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{gets = P'.append (gets old'Self) new'Field}) (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageGetMany) MontageGetMany where+  getVal m' f' = f' m'+ +instance P'.GPB MontageGetMany+ +instance P'.ReflectDescriptor MontageGetMany where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGetMany\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetMany\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGetMany.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetMany.gets\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetMany\"], baseName' = FName \"gets\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageGet\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGet\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageGetReference.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageGetReference (MontageGetReference(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageGetReference = MontageGetReference{bucket :: !P'.ByteString, key :: !P'.ByteString,+                                               target_buckets :: !(P'.Seq P'.ByteString)}+                         deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageGetReference where+  mergeAppend (MontageGetReference x'1 x'2 x'3) (MontageGetReference y'1 y'2 y'3)+   = MontageGetReference (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default MontageGetReference where+  defaultValue = MontageGetReference P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageGetReference where+  wireSize ft' self'@(MontageGetReference x'1 x'2 x'3)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeRep 1 12 x'3)+  wirePut ft' self'@(MontageGetReference x'1 x'2 x'3)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 12 x'1+             P'.wirePutReq 18 12 x'2+             P'.wirePutRep 26 12 x'3+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             26 -> Prelude'.fmap (\ !new'Field -> old'Self{target_buckets = P'.append (target_buckets old'Self) new'Field})+                    (P'.wireGet 12)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageGetReference) MontageGetReference where+  getVal m' f' = f' m'+ +instance P'.GPB MontageGetReference+ +instance P'.ReflectDescriptor MontageGetReference where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10, 18]) (P'.fromDistinctAscList [10, 18, 26])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGetReference\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetReference\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGetReference.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetReference.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetReference\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetReference.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetReference\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetReference.target_buckets\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetReference\"], baseName' = FName \"target_buckets\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageGetResponse.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageGetResponse (MontageGetResponse(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontageGetStatus as Montage (MontageGetStatus)+import qualified Network.Riak.Montage.Proto.Montage.MontageObject as Montage (MontageObject)+ +data MontageGetResponse = MontageGetResponse{status :: !(P'.Seq Montage.MontageGetStatus),+                                             master :: !(P'.Maybe Montage.MontageObject), subs :: !(P'.Seq Montage.MontageObject)}+                        deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageGetResponse where+  mergeAppend (MontageGetResponse x'1 x'2 x'3) (MontageGetResponse y'1 y'2 y'3)+   = MontageGetResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3)+ +instance P'.Default MontageGetResponse where+  defaultValue = MontageGetResponse P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageGetResponse where+  wireSize ft' self'@(MontageGetResponse x'1 x'2 x'3)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 14 x'1 + P'.wireSizeOpt 1 11 x'2 + P'.wireSizeRep 1 11 x'3)+  wirePut ft' self'@(MontageGetResponse x'1 x'2 x'3)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutRep 8 14 x'1+             P'.wirePutOpt 18 11 x'2+             P'.wirePutRep 26 11 x'3+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             8 -> Prelude'.fmap (\ !new'Field -> old'Self{status = P'.append (status old'Self) new'Field}) (P'.wireGet 14)+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{status = P'.mergeAppend (status old'Self) new'Field})+                    (P'.wireGetPacked 14)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{master = P'.mergeAppend (master old'Self) (Prelude'.Just new'Field)})+                    (P'.wireGet 11)+             26 -> Prelude'.fmap (\ !new'Field -> old'Self{subs = P'.append (subs old'Self) new'Field}) (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageGetResponse) MontageGetResponse where+  getVal m' f' = f' m'+ +instance P'.GPB MontageGetResponse+ +instance P'.ReflectDescriptor MontageGetResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [8, 10, 18, 26])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageGetResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageGetResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetResponse.status\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetResponse\"], baseName' = FName \"status\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Just (WireTag {getWireTag = 8},WireTag {getWireTag = 10}), wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = True, typeCode = FieldType {getFieldType = 14}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageGetStatus\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageGetStatus\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetResponse.master\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetResponse\"], baseName' = FName \"master\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageGetResponse.subs\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageGetResponse\"], baseName' = FName \"subs\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageGetStatus.hs view
@@ -0,0 +1,63 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageGetStatus (MontageGetStatus(..)) where+import Prelude ((+), (/), (.))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageGetStatus = EXISTS+                      | MISSING+                      | ERROR+                      deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageGetStatus+ +instance Prelude'.Bounded MontageGetStatus where+  minBound = EXISTS+  maxBound = ERROR+ +instance P'.Default MontageGetStatus where+  defaultValue = EXISTS+ +toMaybe'Enum :: Prelude'.Int -> P'.Maybe MontageGetStatus+toMaybe'Enum 1 = Prelude'.Just EXISTS+toMaybe'Enum 2 = Prelude'.Just MISSING+toMaybe'Enum 3 = Prelude'.Just ERROR+toMaybe'Enum _ = Prelude'.Nothing+ +instance Prelude'.Enum MontageGetStatus where+  fromEnum EXISTS = 1+  fromEnum MISSING = 2+  fromEnum ERROR = 3+  toEnum+   = P'.fromMaybe+      (Prelude'.error "hprotoc generated code: toEnum failure for type Network.Riak.Montage.Proto.Montage.MontageGetStatus")+      . toMaybe'Enum+  succ EXISTS = MISSING+  succ MISSING = ERROR+  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Network.Riak.Montage.Proto.Montage.MontageGetStatus"+  pred MISSING = EXISTS+  pred ERROR = MISSING+  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Network.Riak.Montage.Proto.Montage.MontageGetStatus"+ +instance P'.Wire MontageGetStatus where+  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)+  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)+  wireGet 14 = P'.wireGetEnum toMaybe'Enum+  wireGet ft' = P'.wireGetErr ft'+  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum+  wireGetPacked ft' = P'.wireGetErr ft'+ +instance P'.GPB MontageGetStatus+ +instance P'.MessageAPI msg' (msg' -> MontageGetStatus) MontageGetStatus where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum MontageGetStatus where+  reflectEnum = [(1, "EXISTS", EXISTS), (2, "MISSING", MISSING), (3, "ERROR", ERROR)]+  reflectEnumInfo _+   = P'.EnumInfo+      (P'.makePNF (P'.pack ".Montage.MontageGetStatus") ["Network", "Riak", "Montage", "Proto"] ["Montage"] "MontageGetStatus")+      ["Network", "Riak", "Montage", "Proto", "Montage", "MontageGetStatus.hs"]+      [(1, "EXISTS"), (2, "MISSING"), (3, "ERROR")]
+ Network/Riak/Montage/Proto/Montage/MontageObject.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageObject (MontageObject(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageObject = MontageObject{vclock :: !(P'.Maybe P'.ByteString), bucket :: !P'.ByteString, key :: !P'.ByteString,+                                   data' :: !P'.ByteString, fetch_resolutions :: !(P'.Maybe P'.Word32)}+                   deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageObject where+  mergeAppend (MontageObject x'1 x'2 x'3 x'4 x'5) (MontageObject y'1 y'2 y'3 y'4 y'5)+   = MontageObject (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2) (P'.mergeAppend x'3 y'3) (P'.mergeAppend x'4 y'4)+      (P'.mergeAppend x'5 y'5)+ +instance P'.Default MontageObject where+  defaultValue = MontageObject P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageObject where+  wireSize ft' self'@(MontageObject x'1 x'2 x'3 x'4 x'5)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size+         = (P'.wireSizeOpt 1 12 x'1 + P'.wireSizeReq 1 12 x'2 + P'.wireSizeReq 1 12 x'3 + P'.wireSizeReq 1 12 x'4 ++             P'.wireSizeOpt 1 13 x'5)+  wirePut ft' self'@(MontageObject x'1 x'2 x'3 x'4 x'5)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutOpt 10 12 x'1+             P'.wirePutReq 18 12 x'2+             P'.wirePutReq 26 12 x'3+             P'.wirePutReq 34 12 x'4+             P'.wirePutOpt 40 13 x'5+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{vclock = Prelude'.Just new'Field}) (P'.wireGet 12)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{bucket = new'Field}) (P'.wireGet 12)+             26 -> Prelude'.fmap (\ !new'Field -> old'Self{key = new'Field}) (P'.wireGet 12)+             34 -> Prelude'.fmap (\ !new'Field -> old'Self{data' = new'Field}) (P'.wireGet 12)+             40 -> Prelude'.fmap (\ !new'Field -> old'Self{fetch_resolutions = Prelude'.Just new'Field}) (P'.wireGet 13)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageObject) MontageObject where+  getVal m' f' = f' m'+ +instance P'.GPB MontageObject+ +instance P'.ReflectDescriptor MontageObject where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [18, 26, 34]) (P'.fromDistinctAscList [10, 18, 26, 34, 40])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageObject.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.vclock\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"vclock\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.bucket\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"bucket\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.key\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"key\"}, fieldNumber = FieldId {getFieldId = 3}, wireTag = WireTag {getWireTag = 26}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.data\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"data'\"}, fieldNumber = FieldId {getFieldId = 4}, wireTag = WireTag {getWireTag = 34}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageObject.fetch_resolutions\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageObject\"], baseName' = FName \"fetch_resolutions\"}, fieldNumber = FieldId {getFieldId = 5}, wireTag = WireTag {getWireTag = 40}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontagePut.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontagePut (MontagePut(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontageObject as Montage (MontageObject)+ +data MontagePut = MontagePut{object :: !Montage.MontageObject}+                deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontagePut where+  mergeAppend (MontagePut x'1) (MontagePut y'1) = MontagePut (P'.mergeAppend x'1 y'1)+ +instance P'.Default MontagePut where+  defaultValue = MontagePut P'.defaultValue+ +instance P'.Wire MontagePut where+  wireSize ft' self'@(MontagePut x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 11 x'1)+  wirePut ft' self'@(MontagePut x'1)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 11 x'1+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{object = P'.mergeAppend (object old'Self) (new'Field)}) (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontagePut) MontagePut where+  getVal m' f' = f' m'+ +instance P'.GPB MontagePut+ +instance P'.ReflectDescriptor MontagePut where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePut\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePut\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePut.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePut.object\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePut\"], baseName' = FName \"object\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontagePutMany.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontagePutMany (MontagePutMany(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontageObject as Montage (MontageObject)+ +data MontagePutMany = MontagePutMany{objects :: !(P'.Seq Montage.MontageObject)}+                    deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontagePutMany where+  mergeAppend (MontagePutMany x'1) (MontagePutMany y'1) = MontagePutMany (P'.mergeAppend x'1 y'1)+ +instance P'.Default MontagePutMany where+  defaultValue = MontagePutMany P'.defaultValue+ +instance P'.Wire MontagePutMany where+  wireSize ft' self'@(MontagePutMany x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 11 x'1)+  wirePut ft' self'@(MontagePutMany x'1)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutRep 10 11 x'1+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{objects = P'.append (objects old'Self) new'Field}) (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontagePutMany) MontagePutMany where+  getVal m' f' = f' m'+ +instance P'.GPB MontagePutMany+ +instance P'.ReflectDescriptor MontagePutMany where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePutMany\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutMany\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePutMany.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutMany.objects\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutMany\"], baseName' = FName \"objects\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontagePutManyResponse.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontagePutManyResponse (MontagePutManyResponse(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontagePutResponse as Montage (MontagePutResponse)+ +data MontagePutManyResponse = MontagePutManyResponse{objects :: !(P'.Seq Montage.MontagePutResponse)}+                            deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontagePutManyResponse where+  mergeAppend (MontagePutManyResponse x'1) (MontagePutManyResponse y'1) = MontagePutManyResponse (P'.mergeAppend x'1 y'1)+ +instance P'.Default MontagePutManyResponse where+  defaultValue = MontagePutManyResponse P'.defaultValue+ +instance P'.Wire MontagePutManyResponse where+  wireSize ft' self'@(MontagePutManyResponse x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeRep 1 11 x'1)+  wirePut ft' self'@(MontagePutManyResponse x'1)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutRep 10 11 x'1+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{objects = P'.append (objects old'Self) new'Field}) (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontagePutManyResponse) MontagePutManyResponse where+  getVal m' f' = f' m'+ +instance P'.GPB MontagePutManyResponse+ +instance P'.ReflectDescriptor MontagePutManyResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList []) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePutManyResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutManyResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePutManyResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutManyResponse.objects\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutManyResponse\"], baseName' = FName \"objects\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = True, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontagePutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutResponse\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontagePutResponse.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontagePutResponse (MontagePutResponse(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import qualified Network.Riak.Montage.Proto.Montage.MontageObject as Montage (MontageObject)+ +data MontagePutResponse = MontagePutResponse{modified :: !P'.Bool, object :: !Montage.MontageObject}+                        deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontagePutResponse where+  mergeAppend (MontagePutResponse x'1 x'2) (MontagePutResponse y'1 y'2)+   = MontagePutResponse (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default MontagePutResponse where+  defaultValue = MontagePutResponse P'.defaultValue P'.defaultValue+ +instance P'.Wire MontagePutResponse where+  wireSize ft' self'@(MontagePutResponse x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 8 x'1 + P'.wireSizeReq 1 11 x'2)+  wirePut ft' self'@(MontagePutResponse x'1 x'2)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 8 8 x'1+             P'.wirePutReq 18 11 x'2+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             8 -> Prelude'.fmap (\ !new'Field -> old'Self{modified = new'Field}) (P'.wireGet 8)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{object = P'.mergeAppend (object old'Self) (new'Field)}) (P'.wireGet 11)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontagePutResponse) MontagePutResponse where+  getVal m' f' = f' m'+ +instance P'.GPB MontagePutResponse+ +instance P'.ReflectDescriptor MontagePutResponse where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8, 18]) (P'.fromDistinctAscList [8, 18])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontagePutResponse\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontagePutResponse\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontagePutResponse.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutResponse.modified\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutResponse\"], baseName' = FName \"modified\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 8}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontagePutResponse.object\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontagePutResponse\"], baseName' = FName \"object\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 11}, typeName = Just (ProtoName {protobufName = FIName \".Montage.MontageObject\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageObject\"}), hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageSubrequestSpec.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageSubrequestSpec (MontageSubrequestSpec(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageSubrequestSpec = MontageSubrequestSpec{sub_spec :: !P'.ByteString, params :: !(P'.Maybe P'.ByteString)}+                           deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageSubrequestSpec where+  mergeAppend (MontageSubrequestSpec x'1 x'2) (MontageSubrequestSpec y'1 y'2)+   = MontageSubrequestSpec (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default MontageSubrequestSpec where+  defaultValue = MontageSubrequestSpec P'.defaultValue P'.defaultValue+ +instance P'.Wire MontageSubrequestSpec where+  wireSize ft' self'@(MontageSubrequestSpec x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 12 x'1 + P'.wireSizeOpt 1 12 x'2)+  wirePut ft' self'@(MontageSubrequestSpec x'1 x'2)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 12 x'1+             P'.wirePutOpt 18 12 x'2+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{sub_spec = new'Field}) (P'.wireGet 12)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{params = Prelude'.Just new'Field}) (P'.wireGet 12)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> MontageSubrequestSpec) MontageSubrequestSpec where+  getVal m' f' = f' m'+ +instance P'.GPB MontageSubrequestSpec+ +instance P'.ReflectDescriptor MontageSubrequestSpec where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10, 18])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".Montage.MontageSubrequestSpec\", haskellPrefix = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule = [MName \"Montage\"], baseName = MName \"MontageSubrequestSpec\"}, descFilePath = [\"Network\",\"Riak\",\"Montage\",\"Proto\",\"Montage\",\"MontageSubrequestSpec.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageSubrequestSpec.sub_spec\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageSubrequestSpec\"], baseName' = FName \"sub_spec\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".Montage.MontageSubrequestSpec.params\", haskellPrefix' = [MName \"Network\",MName \"Riak\",MName \"Montage\",MName \"Proto\"], parentModule' = [MName \"Montage\",MName \"MontageSubrequestSpec\"], baseName' = FName \"params\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ Network/Riak/Montage/Proto/Montage/MontageWireMessages.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module Network.Riak.Montage.Proto.Montage.MontageWireMessages (MontageWireMessages(..)) where+import Prelude ((+), (/), (.))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data MontageWireMessages = MONTAGE_GET+                         | MONTAGE_GET_REFERENCE+                         | MONTAGE_GET_RESPONSE+                         | MONTAGE_COMMAND+                         | MONTAGE_COMMAND_RESPONSE+                         | MONTAGE_PUT+                         | MONTAGE_PUT_RESPONSE+                         | MONTAGE_GET_MANY+                         | DEPRICATED_MONTAGE_SET_REFERENCE+                         | MONTAGE_PUT_MANY+                         | MONTAGE_PUT_MANY_RESPONSE+                         | MONTAGE_ERROR+                         | MONTAGE_DELETE+                         | MONTAGE_DELETE_RESPONSE+                         deriving (Prelude'.Read, Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable MontageWireMessages+ +instance Prelude'.Bounded MontageWireMessages where+  minBound = MONTAGE_GET+  maxBound = MONTAGE_DELETE_RESPONSE+ +instance P'.Default MontageWireMessages where+  defaultValue = MONTAGE_GET+ +toMaybe'Enum :: Prelude'.Int -> P'.Maybe MontageWireMessages+toMaybe'Enum 1 = Prelude'.Just MONTAGE_GET+toMaybe'Enum 2 = Prelude'.Just MONTAGE_GET_REFERENCE+toMaybe'Enum 3 = Prelude'.Just MONTAGE_GET_RESPONSE+toMaybe'Enum 4 = Prelude'.Just MONTAGE_COMMAND+toMaybe'Enum 5 = Prelude'.Just MONTAGE_COMMAND_RESPONSE+toMaybe'Enum 6 = Prelude'.Just MONTAGE_PUT+toMaybe'Enum 7 = Prelude'.Just MONTAGE_PUT_RESPONSE+toMaybe'Enum 8 = Prelude'.Just MONTAGE_GET_MANY+toMaybe'Enum 9 = Prelude'.Just DEPRICATED_MONTAGE_SET_REFERENCE+toMaybe'Enum 10 = Prelude'.Just MONTAGE_PUT_MANY+toMaybe'Enum 11 = Prelude'.Just MONTAGE_PUT_MANY_RESPONSE+toMaybe'Enum 12 = Prelude'.Just MONTAGE_ERROR+toMaybe'Enum 13 = Prelude'.Just MONTAGE_DELETE+toMaybe'Enum 14 = Prelude'.Just MONTAGE_DELETE_RESPONSE+toMaybe'Enum _ = Prelude'.Nothing+ +instance Prelude'.Enum MontageWireMessages where+  fromEnum MONTAGE_GET = 1+  fromEnum MONTAGE_GET_REFERENCE = 2+  fromEnum MONTAGE_GET_RESPONSE = 3+  fromEnum MONTAGE_COMMAND = 4+  fromEnum MONTAGE_COMMAND_RESPONSE = 5+  fromEnum MONTAGE_PUT = 6+  fromEnum MONTAGE_PUT_RESPONSE = 7+  fromEnum MONTAGE_GET_MANY = 8+  fromEnum DEPRICATED_MONTAGE_SET_REFERENCE = 9+  fromEnum MONTAGE_PUT_MANY = 10+  fromEnum MONTAGE_PUT_MANY_RESPONSE = 11+  fromEnum MONTAGE_ERROR = 12+  fromEnum MONTAGE_DELETE = 13+  fromEnum MONTAGE_DELETE_RESPONSE = 14+  toEnum+   = P'.fromMaybe+      (Prelude'.error "hprotoc generated code: toEnum failure for type Network.Riak.Montage.Proto.Montage.MontageWireMessages")+      . toMaybe'Enum+  succ MONTAGE_GET = MONTAGE_GET_REFERENCE+  succ MONTAGE_GET_REFERENCE = MONTAGE_GET_RESPONSE+  succ MONTAGE_GET_RESPONSE = MONTAGE_COMMAND+  succ MONTAGE_COMMAND = MONTAGE_COMMAND_RESPONSE+  succ MONTAGE_COMMAND_RESPONSE = MONTAGE_PUT+  succ MONTAGE_PUT = MONTAGE_PUT_RESPONSE+  succ MONTAGE_PUT_RESPONSE = MONTAGE_GET_MANY+  succ MONTAGE_GET_MANY = DEPRICATED_MONTAGE_SET_REFERENCE+  succ DEPRICATED_MONTAGE_SET_REFERENCE = MONTAGE_PUT_MANY+  succ MONTAGE_PUT_MANY = MONTAGE_PUT_MANY_RESPONSE+  succ MONTAGE_PUT_MANY_RESPONSE = MONTAGE_ERROR+  succ MONTAGE_ERROR = MONTAGE_DELETE+  succ MONTAGE_DELETE = MONTAGE_DELETE_RESPONSE+  succ _ = Prelude'.error "hprotoc generated code: succ failure for type Network.Riak.Montage.Proto.Montage.MontageWireMessages"+  pred MONTAGE_GET_REFERENCE = MONTAGE_GET+  pred MONTAGE_GET_RESPONSE = MONTAGE_GET_REFERENCE+  pred MONTAGE_COMMAND = MONTAGE_GET_RESPONSE+  pred MONTAGE_COMMAND_RESPONSE = MONTAGE_COMMAND+  pred MONTAGE_PUT = MONTAGE_COMMAND_RESPONSE+  pred MONTAGE_PUT_RESPONSE = MONTAGE_PUT+  pred MONTAGE_GET_MANY = MONTAGE_PUT_RESPONSE+  pred DEPRICATED_MONTAGE_SET_REFERENCE = MONTAGE_GET_MANY+  pred MONTAGE_PUT_MANY = DEPRICATED_MONTAGE_SET_REFERENCE+  pred MONTAGE_PUT_MANY_RESPONSE = MONTAGE_PUT_MANY+  pred MONTAGE_ERROR = MONTAGE_PUT_MANY_RESPONSE+  pred MONTAGE_DELETE = MONTAGE_ERROR+  pred MONTAGE_DELETE_RESPONSE = MONTAGE_DELETE+  pred _ = Prelude'.error "hprotoc generated code: pred failure for type Network.Riak.Montage.Proto.Montage.MontageWireMessages"+ +instance P'.Wire MontageWireMessages where+  wireSize ft' enum = P'.wireSize ft' (Prelude'.fromEnum enum)+  wirePut ft' enum = P'.wirePut ft' (Prelude'.fromEnum enum)+  wireGet 14 = P'.wireGetEnum toMaybe'Enum+  wireGet ft' = P'.wireGetErr ft'+  wireGetPacked 14 = P'.wireGetPackedEnum toMaybe'Enum+  wireGetPacked ft' = P'.wireGetErr ft'+ +instance P'.GPB MontageWireMessages+ +instance P'.MessageAPI msg' (msg' -> MontageWireMessages) MontageWireMessages where+  getVal m' f' = f' m'+ +instance P'.ReflectEnum MontageWireMessages where+  reflectEnum+   = [(1, "MONTAGE_GET", MONTAGE_GET), (2, "MONTAGE_GET_REFERENCE", MONTAGE_GET_REFERENCE),+      (3, "MONTAGE_GET_RESPONSE", MONTAGE_GET_RESPONSE), (4, "MONTAGE_COMMAND", MONTAGE_COMMAND),+      (5, "MONTAGE_COMMAND_RESPONSE", MONTAGE_COMMAND_RESPONSE), (6, "MONTAGE_PUT", MONTAGE_PUT),+      (7, "MONTAGE_PUT_RESPONSE", MONTAGE_PUT_RESPONSE), (8, "MONTAGE_GET_MANY", MONTAGE_GET_MANY),+      (9, "DEPRICATED_MONTAGE_SET_REFERENCE", DEPRICATED_MONTAGE_SET_REFERENCE), (10, "MONTAGE_PUT_MANY", MONTAGE_PUT_MANY),+      (11, "MONTAGE_PUT_MANY_RESPONSE", MONTAGE_PUT_MANY_RESPONSE), (12, "MONTAGE_ERROR", MONTAGE_ERROR),+      (13, "MONTAGE_DELETE", MONTAGE_DELETE), (14, "MONTAGE_DELETE_RESPONSE", MONTAGE_DELETE_RESPONSE)]+  reflectEnumInfo _+   = P'.EnumInfo+      (P'.makePNF (P'.pack ".Montage.MontageWireMessages") ["Network", "Riak", "Montage", "Proto"] ["Montage"]+        "MontageWireMessages")+      ["Network", "Riak", "Montage", "Proto", "Montage", "MontageWireMessages.hs"]+      [(1, "MONTAGE_GET"), (2, "MONTAGE_GET_REFERENCE"), (3, "MONTAGE_GET_RESPONSE"), (4, "MONTAGE_COMMAND"),+       (5, "MONTAGE_COMMAND_RESPONSE"), (6, "MONTAGE_PUT"), (7, "MONTAGE_PUT_RESPONSE"), (8, "MONTAGE_GET_MANY"),+       (9, "DEPRICATED_MONTAGE_SET_REFERENCE"), (10, "MONTAGE_PUT_MANY"), (11, "MONTAGE_PUT_MANY_RESPONSE"), (12, "MONTAGE_ERROR"),+       (13, "MONTAGE_DELETE"), (14, "MONTAGE_DELETE_RESPONSE")]
+ Network/Riak/Montage/Protocol.hs view
@@ -0,0 +1,98 @@+module Network.Riak.Montage.Protocol where++import System.ZMQ+import System.UUID.V4 (uuid)+import Control.Monad (forever)+import Control.Concurrent (forkIO)+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Lazy as BW+import qualified Data.ByteString.Char8 as S+import Control.Exception (try, SomeException)+import Text.ProtocolBuffers.WireMessage (messageGet, messagePut)+import Text.ProtocolBuffers.Basic (uFromString)++import Network.Riak.Montage.Util++import Network.StatsWeb (Stats)++import Network.Riak.Montage.Proto.Montage.MontageEnvelope as ME+import Network.Riak.Montage.Proto.Montage.MontageWireMessages+import Network.Riak.Montage.Proto.Montage.MontageError+import Network.Riak.Montage.Types+import Network.Riak.Montage.Process (processRequest,+                                    serializeResponse, ConcurrentState(..))+++type ZmqHandler = (S.ByteString -> (BW.ByteString -> IO ()) -> IO ())++runZmqRpc :: String+          -> ZmqHandler+          -> IO ()+runZmqRpc bindSpec call = do+    withContext 1 (\c ->+        runZmqRpcWithContext c bindSpec call)++runZmqRpcWithContext :: Context+                     -> String+                     -> ZmqHandler+                     -> IO ()+runZmqRpcWithContext ctx binda call = do+    withSocket ctx Router (\s -> do+        rand <- uuid+        let inproc = "inproc://" ++ (show rand)+        bind s binda+        bind s inproc+        forever $ do+            zid <- receive s []+            _ <- receive s []+            m <- receive s []+            more <- moreToReceive s+            if more+            then do  -- forward+                fwid <- receive s []+                send s fwid [SndMore]+                send s "" [SndMore]+                send s m []+            else do -- call+                _ <- forkIO $ call m (zmqRpcReply ctx inproc zid)+                return ()+        )++zmqRpcReply :: Context+            -> String        -- inproc+            -> S.ByteString  -- sent id+            -> BW.ByteString  -- out message+            -> IO ()+zmqRpcReply c inproc retid out = do+    withSocket c Req (\s -> do+        connect s inproc+        send' s out [SndMore]+        send s retid []+        )++serveMontageZmq :: (MontageRiakValue r) =>+                   (MontageEnvelope -> ChainCommand r) ->+                   String -> ConcurrentState -> LogCallback ->+                   PoolChooser -> Stats -> IO ()+serveMontageZmq generate runOn state logCB chooser' stats = do+    runZmqRpc runOn wrapMontage+  where+    wrapMontage m cb = do+        case messageGet $ sTl m of+            Right (env, x) | B.length x == 0 -> do+                res <- try $ do+                    let !cmd = generate env+                    fmap (serializeResponse env) $ processRequest state logCB chooser' cmd stats+                case res of+                    Left (e :: SomeException) -> returnError (show e) $ msgid env+                    Right outenv -> cb $  messagePut outenv++            _ -> returnError "Failed to decode MontageEnvelope" Nothing+      where+        returnError err msgid' = do+            logError err+            cb $ messagePut $ MontageEnvelope {+                  mtype = MONTAGE_ERROR+                , msg = messagePut $ MontageError (uFromString err)+                , msgid = msgid'+                }
+ Network/Riak/Montage/Types.hs view
@@ -0,0 +1,120 @@+module Network.Riak.Montage.Types where++import Network.Riak.Montage.Util (LogCallback)++import Network.Riak.Montage.Proto.Montage.MontageWireMessages+import Text.ProtocolBuffers.WireMessage (Wire)+import Text.ProtocolBuffers.Reflections (ReflectDescriptor)+import Network.Riak.Montage.Proto.Montage.MontageEnvelope+import Network.Riak.Montage.Proto.Montage.MontageObject+import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy.Char8 as L+import qualified Data.Text as T+import Network.Riak.Types+import Data.Conduit.Pool (Pool)++import Network.Riak (Resolvable(..))+import qualified Network.Riak.Value as V+import qualified Network.Riak.Content as C++class (Show a) => MontageRiakValue a where+    getPB :: L.ByteString -> BucketSpec a++    referenceKey :: a -> Maybe Key++    customCommandHandler :: T.Text -> Maybe L.ByteString -> ChainIteration a+    customCommandHandler cmd = error $ "No handler for custom command: " ++ T.unpack cmd++    riakSerialize :: RiakRecord a -> L.ByteString+    riakSerialize (RiakMontageLazyBs _ bs) = bs+    riakSerialize (RiakMontagePb b v) = (deconstruct $ getPB b) v++    ensureEval :: RiakRecord a -> RiakRecord a+    ensureEval (RiakMontageLazyBs b s) = RiakMontagePb b $ construct (getPB b) s+    ensureEval r@(RiakMontagePb _ _) = r++class Poolable p where+    chooser :: p -> Bucket -> Pool Connection++instance (MontageRiakValue a) => Resolvable (RiakRecord a) where+    -- force deserialization for resolution+    resolve r1@(RiakMontageLazyBs _ _) r2 = resolve (ensureEval r1) r2+    resolve r1 r2@(RiakMontageLazyBs _ _) = resolve r1 (ensureEval r2)++    resolve (RiakMontagePb b o1) (RiakMontagePb _ o2) = RiakMontagePb b $ (pbResolve $ getPB b) o1 o2++getReferenceKey :: (MontageRiakValue a) => RiakRecord a -> Maybe Key+getReferenceKey (RiakMontagePb _ v) = referenceKey v+getReferenceKey (RiakMontageLazyBs _ _) = error "should never request reference key from lazy bytestring"++instance (MontageRiakValue a) => V.IsContent (RiakRecord a) where+    parseContent buck c = return $ RiakMontageLazyBs buck $ C.value c+    toContent = C.binary . riakSerialize++showRiakRecord :: (Show a, Show b) => a -> b -> [Char]+showRiakRecord b v = "(buck=" ++ show b ++ ", val=" ++ show v ++ ")"++instance (MontageRiakValue a) => Show (RiakRecord a) where+    show (RiakMontageLazyBs b v) = showRiakRecord b v+    show (RiakMontagePb b v) = showRiakRecord b v++data (MontageRiakValue r) => BucketSpec r = BucketSpec {+          construct :: Constructor r+        , pbResolve :: Resolver r+        , deconstruct :: Deconstructor r+        }++type Constructor a = L.ByteString -> a+type Resolver a = a -> a -> a+type Deconstructor a = a -> L.ByteString++type VectorClock = Maybe L.ByteString++data (MontageRiakValue r) => RiakRecord r = RiakMontageLazyBs Bucket L.ByteString+                                          | RiakMontagePb Bucket r++data (MontageRiakValue r) => ChainIteration r =+      IterationRiakCommand [RiakRequest r] ([RiakResponse r] -> ChainCommand r)+    | IterationResponse CommandResponse+    | ChainIterationIO (IO (ChainCommand r))++data CommandResponse = forall a. (Wire a, ReflectDescriptor a, Show a) => ResponseProtobuf MontageWireMessages a+                     | ResponseCustom T.Text (Maybe L.ByteString)++instance Show CommandResponse where+    show (ResponseProtobuf t r) = "CommandResponsePB [" ++ show t ++ "] " ++ show r+    show (ResponseCustom t r) = "CommandResponseCustom [" ++ show t ++ "] " ++ show r++data (MontageRiakValue r) => ChainCommand r =+      ChainGet Bucket Key (Maybe ([RiakResponse r] -> ChainCommand r))+    | ChainGetMany [(Bucket, Key)] (Maybe MontageObject) (Maybe ([RiakResponse r] -> ChainCommand r))+    | ChainPut VectorClock Bucket Key (RiakRecord r) (Maybe ([RiakResponse r] -> ChainCommand r))+    | ChainPutMany [(VectorClock, Bucket, Key, RiakRecord r)] (Maybe ([RiakResponse r] -> ChainCommand r))+    | ChainDelete Bucket Key (Maybe ([RiakResponse r] -> ChainCommand r))+    | ChainReference Bucket Key [Bucket]+    | ChainCustom T.Text (Maybe L.ByteString)+    | ChainReturn CommandResponse+    | ChainCommandIO (IO (ChainCommand r))++instance (MontageRiakValue r) => Show (ChainCommand r) where+    show (ChainCommandIO _) = "Can't show things inside the IO monad"+    show v = show v++data (MontageRiakValue a) => RiakRequest a = RiakGet Bucket Key+                                           | RiakPut VectorClock Bucket Key (RiakRecord a)+                                           | RiakDelete Bucket Key++type RiakResponse a = Maybe (RiakRecord a, VClock, Maybe Int)++type PoolChooser = Bucket -> Pool Connection++type RawValue = S.ByteString+type Specifier = T.Text+type Argument = S.ByteString++data (MontageRiakValue a) => Config a = Config {+      proxyPort :: Int+    , logger :: LogCallback+    , statsPrefix :: T.Text+    , generator :: (MontageEnvelope -> ChainCommand a)+  }
+ Network/Riak/Montage/Util.hs view
@@ -0,0 +1,50 @@+module Network.Riak.Montage.Util where++import Control.Monad (forever)+import Control.Exception (try, SomeException)+import Control.Applicative+import Control.Concurrent (threadDelay)++import Data.Aeson (Value, (.=), object)++import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import System.Locale (defaultTimeLocale)+import System.IO (hPutStrLn, stderr)++import qualified Data.ByteString.Lazy.Char8 as B+import qualified Data.ByteString.Char8 as S+++type LogCallback = B.ByteString -> Maybe Double -> Value -> IO ()++logError :: String -> IO ()+logError s = do+    time <- formatTime defaultTimeLocale "%Y/%m/%d %H:%M:%S" <$> getCurrentTime+    hPutStrLn stderr $ "[" ++ time ++ "] " ++ s++sTl :: S.ByteString -> B.ByteString+sTl s = B.fromChunks [s]++lTs :: B.ByteString -> S.ByteString+lTs l = S.concat $ B.toChunks l++supervise :: String -> IO () -> IO ()+supervise label a = loggedSupervise noopLog label a+    where+        noopLog _ _ _ = threadDelay 200000++loggedSupervise :: LogCallback -> String -> IO () -> IO ()+loggedSupervise netlog label a = forever $ do+    logStart+    res <- try a+    case res of+        Left (e :: SomeException) -> logException e+        Right _               -> logTerminate -- unexpected!+  where+    logStart = logError ("{supervisor " ++ label ++ "} RESTARTED")+    logException e = do+        logError ("{supervisor " ++ label ++ "} EXCEPTION: "++ (show e))+        netlog "EXCEPTION" Nothing $ object ["label" .= label,+                                             "exception" .= show e]+    logTerminate = logError ("{supervisor " ++ label ++ "} EXITED!?")
+ README.rst view
@@ -0,0 +1,100 @@+========================+Montage: a riak resolution proxy+========================++Even Rocky had a montage...++Install+=======++Built and tested with ghc 7.4.1++Install the non-hackage dependencies::++    git clone git@github.com:wmoss/StatsWeb.git+    cd StatsWeb && cabal install++    git clone git@github.com:bumptech/riak-haskell-client.git+    cd riak-haskell-client && cabal install++From montage/ execute::++    cabal install++We recommend using a sandbox, hsenv is particularly good.++Configuration+=======++The montage proxy is port configurable (here given the Config handle set to 7078), with riak running on 8087::++    import Network.Riak (defaultClient, connect, disconnect, Client(port), Connection)+    import Data.Conduit.Pool (Pool, createPool)++    import Network.Riak.Montage++    main :: IO ()+    main = do+        mainPool <- createPool+	    (connect $ defaultClient {port = "8087"})+	    disconnect+	    1 -- stripes+	    10 -- timeout+	    300 -- max connections++	let cfg' = cfg { proxyPort = 7078 }++	runDaemon (cfg' :: Config ResObject) mainPool++ResObject is a concrete datatype you define.  For Montage to work with this datatype, you must define:+  (1) translations from bytestring -> datatype, datatype -> bytestring,+  (2) methods for resolving siblings,+  (3) and how to obtain a bytestring key from values in the datatype+See examples/ for a definition of ResObject and how to implement (1), (2), and (3).++You can also set the mainPool argument to be a datatype with more than one pool, in case particular buckets have such variable resolution times that you want to isolate your bucket fetches::++    data Pools = Pools {+        poolA :: Pool Connection+      , poolB :: Pool Connection+    }++    instance Poolable Pools where+        chooser pools "bucketA" = poolA pools+        chooser pools "bucketB" = poolB pools+        chooser pools "bucketC" = poolC pools++For a single pool, like mainPool, you're also required to define its datatype as an instance of Poolable, such that the bucket doesn't matter::++    instance Poolable (Pool Connection) where+        chooser pool _ = pool++You can also a set the cfg field 'logger' to a logging function that fits the type signature::++    logger :: B.Bytestring -> Maybe Double -> Value -> IO ()+    logger errorType duration val = -- your defintion++where errorType is filled in by the Montage exception handler with the type of exception (useful as a prefix), duration is a timestamp Montage may provide (depending on where the error occurs), and val is JSON that Montage constructs with details about the error.++Since Montage provides these values, your logger would simply format the arguments and broadcasts them to a location of your choice.  The default logger simply concatenates the arguments and broadcasts to stderr.++Examples+=======+To setup the examples, first download hprotoc::++    cabal install hprotoc++Then execute::++    cd examples && hprotoc user.proto++Then::++    cd examples && runhaskell basic_proxy.hs++For client examples to run against the basic_proxy, see github.com/bumptech/montage-haskell-client/examples++More+===========++See the haddock documentation for type-signatures, descriptions, and source of client functions.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/User.hs view
@@ -0,0 +1,20 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module User (protoInfo, fileDescriptorProto) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+import Text.DescriptorProtos.FileDescriptorProto (FileDescriptorProto)+import Text.ProtocolBuffers.Reflections (ProtoInfo)+import qualified Text.ProtocolBuffers.WireMessage as P' (wireGet,getFromBS)+ +protoInfo :: ProtoInfo+protoInfo+ = Prelude'.read+    "ProtoInfo {protoMod = ProtoName {protobufName = FIName \".User\", haskellPrefix = [], parentModule = [], baseName = MName \"User\"}, protoFilePath = [\"User.hs\"], protoSource = \"user.proto\", extensionKeys = fromList [], messages = [DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserInfo\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserInfo\"}, descFilePath = [\"User\",\"UserInfo.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserInfo.uid\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserInfo\"], baseName' = FName \"uid\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserInfo.name\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserInfo\"], baseName' = FName \"name\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}], enums = [], knownKeyMap = fromList []}"+ +fileDescriptorProto :: FileDescriptorProto+fileDescriptorProto+ = P'.getFromBS (P'.wireGet 11)+    (P'.pack "3\n\nuser.proto\"%\n\bUserInfo\DC2\v\n\ETXuid\CAN\SOH \STX(\r\DC2\f\n\EOTname\CAN\STX \SOH(\t")
+ examples/User/UserEvent.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module User.UserEvent (UserEvent(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data UserEvent = UserEvent{eid :: !P'.Word32}+               deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable UserEvent where+  mergeAppend (UserEvent x'1) (UserEvent y'1) = UserEvent (P'.mergeAppend x'1 y'1)+ +instance P'.Default UserEvent where+  defaultValue = UserEvent P'.defaultValue+ +instance P'.Wire UserEvent where+  wireSize ft' self'@(UserEvent x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 13 x'1)+  wirePut ft' self'@(UserEvent x'1)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 8 13 x'1+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             8 -> Prelude'.fmap (\ !new'Field -> old'Self{eid = new'Field}) (P'.wireGet 13)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> UserEvent) UserEvent where+  getVal m' f' = f' m'+ +instance P'.GPB UserEvent+ +instance P'.ReflectDescriptor UserEvent where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8]) (P'.fromDistinctAscList [8])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserEvent\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserEvent\"}, descFilePath = [\"User\",\"UserEvent.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserEvent.eid\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserEvent\"], baseName' = FName \"eid\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ examples/User/UserInfo.hs view
@@ -0,0 +1,59 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module User.UserInfo (UserInfo(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data UserInfo = UserInfo{uid :: !P'.Word32, name :: !(P'.Maybe P'.Utf8)}+              deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable UserInfo where+  mergeAppend (UserInfo x'1 x'2) (UserInfo y'1 y'2) = UserInfo (P'.mergeAppend x'1 y'1) (P'.mergeAppend x'2 y'2)+ +instance P'.Default UserInfo where+  defaultValue = UserInfo P'.defaultValue P'.defaultValue+ +instance P'.Wire UserInfo where+  wireSize ft' self'@(UserInfo x'1 x'2)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 13 x'1 + P'.wireSizeOpt 1 9 x'2)+  wirePut ft' self'@(UserInfo x'1 x'2)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 8 13 x'1+             P'.wirePutOpt 18 9 x'2+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             8 -> Prelude'.fmap (\ !new'Field -> old'Self{uid = new'Field}) (P'.wireGet 13)+             18 -> Prelude'.fmap (\ !new'Field -> old'Self{name = Prelude'.Just new'Field}) (P'.wireGet 9)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> UserInfo) UserInfo where+  getVal m' f' = f' m'+ +instance P'.GPB UserInfo+ +instance P'.ReflectDescriptor UserInfo where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [8]) (P'.fromDistinctAscList [8, 18])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserInfo\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserInfo\"}, descFilePath = [\"User\",\"UserInfo.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserInfo.uid\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserInfo\"], baseName' = FName \"uid\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 8}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 13}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing},FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserInfo.name\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserInfo\"], baseName' = FName \"name\"}, fieldNumber = FieldId {getFieldId = 2}, wireTag = WireTag {getWireTag = 18}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = False, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 9}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ examples/User/UserName.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE BangPatterns, DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}+module User.UserName (UserName(..)) where+import Prelude ((+), (/))+import qualified Prelude as Prelude'+import qualified Data.Typeable as Prelude'+import qualified Data.Data as Prelude'+import qualified Text.ProtocolBuffers.Header as P'+ +data UserName = UserName{name :: !P'.ByteString}+              deriving (Prelude'.Show, Prelude'.Eq, Prelude'.Ord, Prelude'.Typeable, Prelude'.Data)+ +instance P'.Mergeable UserName where+  mergeAppend (UserName x'1) (UserName y'1) = UserName (P'.mergeAppend x'1 y'1)+ +instance P'.Default UserName where+  defaultValue = UserName P'.defaultValue+ +instance P'.Wire UserName where+  wireSize ft' self'@(UserName x'1)+   = case ft' of+       10 -> calc'Size+       11 -> P'.prependMessageSize calc'Size+       _ -> P'.wireSizeErr ft' self'+    where+        calc'Size = (P'.wireSizeReq 1 12 x'1)+  wirePut ft' self'@(UserName x'1)+   = case ft' of+       10 -> put'Fields+       11 -> do+               P'.putSize (P'.wireSize 10 self')+               put'Fields+       _ -> P'.wirePutErr ft' self'+    where+        put'Fields+         = do+             P'.wirePutReq 10 12 x'1+  wireGet ft'+   = case ft' of+       10 -> P'.getBareMessageWith update'Self+       11 -> P'.getMessageWith update'Self+       _ -> P'.wireGetErr ft'+    where+        update'Self wire'Tag old'Self+         = case wire'Tag of+             10 -> Prelude'.fmap (\ !new'Field -> old'Self{name = new'Field}) (P'.wireGet 12)+             _ -> let (field'Number, wire'Type) = P'.splitWireTag wire'Tag in P'.unknown field'Number wire'Type old'Self+ +instance P'.MessageAPI msg' (msg' -> UserName) UserName where+  getVal m' f' = f' m'+ +instance P'.GPB UserName+ +instance P'.ReflectDescriptor UserName where+  getMessageInfo _ = P'.GetMessageInfo (P'.fromDistinctAscList [10]) (P'.fromDistinctAscList [10])+  reflectDescriptorInfo _+   = Prelude'.read+      "DescriptorInfo {descName = ProtoName {protobufName = FIName \".User.UserName\", haskellPrefix = [], parentModule = [MName \"User\"], baseName = MName \"UserName\"}, descFilePath = [\"User\",\"UserName.hs\"], isGroup = False, fields = fromList [FieldInfo {fieldName = ProtoFName {protobufName' = FIName \".User.UserName.name\", haskellPrefix' = [], parentModule' = [MName \"User\",MName \"UserName\"], baseName' = FName \"name\"}, fieldNumber = FieldId {getFieldId = 1}, wireTag = WireTag {getWireTag = 10}, packedTag = Nothing, wireTagLength = 1, isPacked = False, isRequired = True, canRepeat = False, mightPack = False, typeCode = FieldType {getFieldType = 12}, typeName = Nothing, hsRawDefault = Nothing, hsDefault = Nothing}], keys = fromList [], extRanges = [], knownKeys = fromList [], storeUnknown = False, lazyFields = False}"
+ examples/basic_proxy.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE OverloadedStrings, FlexibleInstances  #-}+import Data.Conduit.Pool (Pool, createPool)+import Network.Riak (defaultClient, connect, disconnect,+                    Client(port), Connection)++import qualified Data.ByteString.Lazy as BW+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Aeson (Value, (.=), object, encode)+import Data.Word (Word8)++import Text.ProtocolBuffers.WireMessage (messageGet, messagePut, Wire)+import Text.ProtocolBuffers.Reflections (ReflectDescriptor)+import Text.ProtocolBuffers.Basic (Utf8, toUtf8, uFromString)++import Network.Riak.Montage+import Network.Riak.Montage.Util++import User.UserInfo as UI+import User.UserEvent as UE+import User.UserName as UN++-- Pool setup++generatePool :: String -> Int -> IO (Pool Connection)+generatePool port count =+    createPool+        (connect $ defaultClient {port = port})+        disconnect+        1  -- stripes+        10 -- timeout+        count -- max connections++-- Resolution logic+{-+  Here your data can be one of two simple protocol buffers:+    message UserInfo {+      required uint32 uid = 1;+    }++    message UserEvent {+      required uint32 eid = 1;+    }+  .+  You always wrap it in a resolution data type so you can create a+  unique BucketSpec by bucket name.++  A simple last-write-wins resolution uses something like the+  lastWriteWins resolver (below). Don't forget to define a+    1. constructor (ByteString -> a) function+    2. deconstructor (a -> ByteString) function+  for each bucket+-}++data ResObject = ResObjectUserInfo UserInfo+               | ResObjectUserEvent UserEvent+               | ResObjectUserName UserName+  deriving (Show)++instance Poolable (Pool Connection) where+  chooser p _ = p++instance MontageRiakValue ResObject where+  getPB "u-info" = BucketSpec+                   (ResObjectUserInfo . messageGetError "UserInfo")+                   lastWriteWins+                   (\(ResObjectUserInfo o) -> messagePut o)+  getPB "u-event" = BucketSpec+                   (ResObjectUserEvent . messageGetError "UserEvent")+                   lastWriteWins+                   (\(ResObjectUserEvent o) -> messagePut o)+  getPB "u-name" = BucketSpec+                   (ResObjectUserName . messageGetError "UserName")+                   lastWriteWins+                   (\(ResObjectUserName o) -> messagePut o)+  getPB bucket = error $ B.unpack $ B.concat [ "No resolution function defined for bucket: ", bucket ]++  referenceKey (ResObjectUserInfo pb) = Just $ (putDecimal . fromIntegral . UI.uid) $ pb+  referenceKey (ResObjectUserEvent pb) = Just $ (putDecimal . fromIntegral . UE.eid) $ pb+  referenceKey (ResObjectUserName pb) = Nothing -- no reference key for this string value+  referenceKey _ = Nothing++putDecimal' :: Int -> [Word8]+putDecimal' 0 = []+putDecimal' i = ((fromIntegral f) + 48) : putDecimal' (fromIntegral r)+  where+    (r, f) = i `divMod` 10+{-# INLINE putDecimal' #-}++putDecimal :: Int -> B.ByteString+putDecimal i | i < 0     = BW.pack $ (45 :: Word8) : (reverse $ putDecimal' $ abs i)+             | otherwise = BW.pack $ reverse $ putDecimal' i+{-# INLINE putDecimal #-}++lastWriteWins a b = b++messageGetError :: (ReflectDescriptor a, Wire a) => B.ByteString -> B.ByteString -> a+messageGetError cls v =+    case messageGet v of+        Right (msg, x) | B.length x == 0 ->+            msg+        Right (_, x) | B.length x /= 0 ->+            error ("error decoding " ++ B.unpack cls ++ ": did not consume all of input")+        Left e ->+            error ("error decoding " ++ B.unpack cls ++ ": " ++ e)++-- Run it++main :: IO ()+main = do+  mainPool <- generatePool "8087" 300+  let cfg' = cfg { proxyPort = 7078 }+             -- how to set the port+             -- already default to 7078, so this does nothing+  runDaemon (cfg' :: Config ResObject) mainPool
+ examples/basic_proxy_pools.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE OverloadedStrings #-}+import Data.Conduit.Pool (Pool, createPool)+import Network.Riak (defaultClient, connect, disconnect,+                    Client(port), Connection)++import qualified Data.ByteString.Lazy as BW+import qualified Data.ByteString.Lazy.Char8 as B+import Data.Aeson (Value, (.=), object, encode)+import Data.Word (Word8)++import Text.ProtocolBuffers.WireMessage (messageGet, messagePut, Wire)+import Text.ProtocolBuffers.Reflections (ReflectDescriptor)+import Text.ProtocolBuffers.Basic (Utf8, toUtf8, uFromString)++import Network.Riak.Montage+import Network.Riak.Montage.Util++import User.UserInfo as UI+import User.UserEvent as UE+import User.UserName as UN++-- Pool setup++generatePool :: String -> Int -> IO (Pool Connection)+generatePool port count =+    createPool+        (connect $ defaultClient {port = port})+        disconnect+        1  -- stripes+        10 -- timeout+        count -- max connections++-- Resolution logic+{-+  Here your data can be one of two simple protocol buffers:+    message UserInfo {+      required uint32 uid = 1;+    }++    message UserEvent {+      required uint32 eid = 1;+    }+  .+  You always wrap it in a resolution data type so you can create a+  unique BucketSpec by bucket name.++  A simple last-write-wins resolution uses something like the+  lastWriteWins resolver (below). Don't forget to define a+    1. constructor (ByteString -> a) function+    2. deconstructor (a -> ByteString) function+  for each bucket+-}++data ResObject = ResObjectUserInfo UserInfo+               | ResObjectUserEvent UserEvent+               | ResObjectUserName UserName+  deriving (Show)++data Pools = Pools {+      poolA :: Pool Connection+    , poolB :: Pool Connection+  }++-- multiple pools+instance Poolable Pools where+  chooser ps "u-info" = poolA ps+  chooser ps "u-event" = poolA ps+  chooser ps "u-name" = poolB ps++instance MontageRiakValue ResObject where+  getPB "u-info" = BucketSpec+                   (ResObjectUserInfo . messageGetError "UserInfo")+                   lastWriteWins+                   (\(ResObjectUserInfo o) -> messagePut o)+  getPB "u-event" = BucketSpec+                   (ResObjectUserEvent . messageGetError "UserEvent")+                   lastWriteWins+                   (\(ResObjectUserEvent o) -> messagePut o)+  getPB "u-name" = BucketSpec+                   (ResObjectUserName . messageGetError "UserName")+                   lastWriteWins+                   (\(ResObjectUserName o) -> messagePut o)+  getPB bucket = error $ B.unpack $ B.concat [ "No resolution function defined for bucket: ", bucket ]++  referenceKey (ResObjectUserInfo pb) = Just $ (putDecimal . fromIntegral . UI.uid) $ pb+  referenceKey (ResObjectUserEvent pb) = Just $ (putDecimal . fromIntegral . UE.eid) $ pb+  referenceKey (ResObjectUserName pb) = Nothing -- no reference key for this string value+  referenceKey _ = Nothing++putDecimal' :: Int -> [Word8]+putDecimal' 0 = []+putDecimal' i = ((fromIntegral f) + 48) : putDecimal' (fromIntegral r)+  where+    (r, f) = i `divMod` 10+{-# INLINE putDecimal' #-}++putDecimal :: Int -> B.ByteString+putDecimal i | i < 0     = BW.pack $ (45 :: Word8) : (reverse $ putDecimal' $ abs i)+             | otherwise = BW.pack $ reverse $ putDecimal' i+{-# INLINE putDecimal #-}++lastWriteWins a b = b++messageGetError :: (ReflectDescriptor a, Wire a) => B.ByteString -> B.ByteString -> a+messageGetError cls v =+    case messageGet v of+        Right (msg, x) | B.length x == 0 ->+            msg+        Right (_, x) | B.length x /= 0 ->+            error ("error decoding " ++ B.unpack cls ++ ": did not consume all of input")+        Left e ->+            error ("error decoding " ++ B.unpack cls ++ ": " ++ e)++-- Run it++main :: IO ()+main = do+  a <- generatePool "8087" 300+  b <- generatePool "8187" 300+  let pools = Pools { poolA = a, poolB = b }++  runDaemon (cfg :: Config ResObject) pools
+ examples/user.proto view
@@ -0,0 +1,11 @@+message UserInfo {+  required uint32 uid = 1;+}++message UserEvent {+  required uint32 eid = 1;+}++message UserName {+  required bytes name = 1;+}
+ montage.cabal view
@@ -0,0 +1,67 @@+Name:                montage+Version:             0.1+Synopsis:            Riak Resolution Proxy+Homepage:            http://github.com/bumptech/montage+License:             BSD3+License-file:        LICENSE+Author:              Bump Technologies, Inc+Maintainer:          dev@bu.mp+Category:            Network+Build-type:          Simple+Cabal-version:       >=1.8++Library+  Exposed-modules:     Network.Riak.Montage,+                       Network.Riak.Montage.Backend,+                       Network.Riak.Montage.Commands,+                       Network.Riak.Montage.Main,+                       Network.Riak.Montage.Process,+                       Network.Riak.Montage.Protocol,+                       Network.Riak.Montage.Types,+                       Network.Riak.Montage.Util,+                       Network.Riak.Montage.Proto.Montage+                       Network.Riak.Montage.Proto.Montage.MontageCommand+                       Network.Riak.Montage.Proto.Montage.MontageCommandResponse+                       Network.Riak.Montage.Proto.Montage.MontageDelete+                       Network.Riak.Montage.Proto.Montage.MontageDeleteResponse+                       Network.Riak.Montage.Proto.Montage.MontageEnvelope+                       Network.Riak.Montage.Proto.Montage.MontageError+                       Network.Riak.Montage.Proto.Montage.MontageGet+                       Network.Riak.Montage.Proto.Montage.MontageGetMany+                       Network.Riak.Montage.Proto.Montage.MontageGetReference+                       Network.Riak.Montage.Proto.Montage.MontageGetResponse+                       Network.Riak.Montage.Proto.Montage.MontageGetStatus+                       Network.Riak.Montage.Proto.Montage.MontageObject+                       Network.Riak.Montage.Proto.Montage.MontagePut+                       Network.Riak.Montage.Proto.Montage.MontagePutMany+                       Network.Riak.Montage.Proto.Montage.MontagePutManyResponse+                       Network.Riak.Montage.Proto.Montage.MontagePutResponse+                       Network.Riak.Montage.Proto.Montage.MontageSubrequestSpec+                       Network.Riak.Montage.Proto.Montage.MontageWireMessages++  -- Packages needed in order to build this package.+  Build-depends:  base >= 4 && < 5,+                  bytestring>=0.9,+                  time>=1.2,+                  old-locale,+                  containers,+                  system-uuid>=2,+                  aeson>=0.3,+                  text>=0.11,+                  ListLike,+                  stm>=2.2,+                  riak-bump>=0.7.3.4,+                  pool-conduit>=0.1.0.2&&<0.2,+                  unordered-containers >= 0.2.1 && < 0.3,+                  zeromq-haskell>=0.8 && < 0.9,+                  protocol-buffers >= 2.0.11,+                  protocol-buffers-descriptor >= 2.0.11,+                  stats-web,+                  safe++  Extensions: OverloadedStrings,DeriveDataTypeable+  Extensions: FlexibleInstances,DoAndIfThenElse,ScopedTypeVariables+  Extensions: BangPatterns,GADTs,MultiParamTypeClasses,FunctionalDependencies+  Extensions: RankNTypes,FlexibleContexts,OverlappingInstances,TupleSections++  Ghc-Options: -Wall -O2 -threaded -rtsopts -funfolding-use-threshold=16 -fexcess-precision -feager-blackholing
+ montage.proto view
@@ -0,0 +1,104 @@+enum MontageWireMessages {+    MONTAGE_GET = 1;+    MONTAGE_GET_REFERENCE = 2;+    MONTAGE_GET_RESPONSE = 3;+    MONTAGE_COMMAND = 4;+    MONTAGE_COMMAND_RESPONSE = 5;+    MONTAGE_PUT = 6;+    MONTAGE_PUT_RESPONSE = 7;+    MONTAGE_GET_MANY = 8;+    DEPRICATED_MONTAGE_SET_REFERENCE = 9;+    MONTAGE_PUT_MANY = 10;+    MONTAGE_PUT_MANY_RESPONSE = 11;+    MONTAGE_ERROR = 12;+    MONTAGE_DELETE = 13;+    MONTAGE_DELETE_RESPONSE = 14;+}++message MontageSubrequestSpec {+    required bytes sub_spec = 1;+    optional bytes params = 2;+}++message MontageGet {+    required bytes bucket = 1;+    required bytes key = 2;+    optional MontageSubrequestSpec sub = 3;+}++message MontageGetMany {+    /* note: will not execute subrequests!+       master document will be None on+       MontageGetResponse */+    repeated MontageGet gets = 1;+}++message MontageGetReference {+    required bytes bucket = 1;+    required bytes key = 2;+    repeated bytes target_buckets = 3;+}++enum MontageGetStatus {+    EXISTS = 1;+    MISSING = 2;+    ERROR = 3;+}++message MontageObject {+    optional bytes vclock = 1;+    required bytes bucket = 2;+    required bytes key = 3;+    required bytes data = 4;+    optional uint32 fetch_resolutions = 5; // informative+}++message MontageGetResponse {+    repeated MontageGetStatus status = 1;+    optional MontageObject master = 2; // optional b/c missing+    repeated MontageObject subs = 3;+}++message MontageCommand {+    required string command = 1;+    optional bytes argument = 2;+}++message MontageCommandResponse {+    required string status = 1;+    optional bytes value = 2;+}++message MontagePut {+    required MontageObject object = 1;+}++message MontagePutResponse {+    required bool modified = 1;+    required MontageObject object = 2; /* with siblings set */+}++message MontagePutMany {+    repeated MontageObject objects = 1;+}++message MontagePutManyResponse {+    repeated MontagePutResponse objects = 1;+}++message MontageDelete {+    required bytes bucket = 1;+    required bytes key = 2;+}++message MontageDeleteResponse {}++message MontageError {+    required string error = 1;+}++message MontageEnvelope {+    required MontageWireMessages mtype = 1;+    required bytes msg = 2;+    optional bytes msgid = 3;+}