persistent-zookeeper (empty) → 0.0.1
raw patch · 11 files changed
+662/−0 lines, 11 filesdep +aesondep +attoparsecdep +basesetup-changed
Dependencies added: aeson, attoparsec, base, base64-bytestring, binary, bytestring, hspec, hzk, monad-control, mtl, path-pieces, persistent, persistent-template, persistent-zookeeper, resource-pool, scientific, stm, template-haskell, text, time, transformers, utf8-string
Files
- Database/Persist/Zookeeper.hs +11/−0
- Database/Persist/Zookeeper/Config.hs +87/−0
- Database/Persist/Zookeeper/Internal.hs +71/−0
- Database/Persist/Zookeeper/PathPiece.hs +26/−0
- Database/Persist/Zookeeper/Store.hs +96/−0
- Database/Persist/Zookeeper/Unique.hs +47/−0
- Database/Persist/Zookeeper/ZooUtil.hs +159/−0
- LICENSE +25/−0
- Setup.hs +2/−0
- persistent-zookeeper.cabal +77/−0
- tests/basic-test.hs +61/−0
+ Database/Persist/Zookeeper.hs view
@@ -0,0 +1,11 @@+module Database.Persist.Zookeeper + ( module Database.Persist.Zookeeper.Config+ , module Database.Persist.Zookeeper.Store+ , module Database.Persist.Zookeeper.Unique+ , module Database.Persist.Zookeeper.PathPiece+ ) where++import Database.Persist.Zookeeper.Config+import Database.Persist.Zookeeper.Store+import Database.Persist.Zookeeper.Unique()+import Database.Persist.Zookeeper.PathPiece()
+ Database/Persist/Zookeeper/Config.hs view
@@ -0,0 +1,87 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE RankNTypes, TypeFamilies, GeneralizedNewtypeDeriving #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ImpredicativeTypes #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Database.Persist.Zookeeper.Config+ (+ ZookeeperConf (..)+ , Connection+ , ZookeeperT (..)+ , runZookeeperPool+ , withZookeeperConn+ , thisConnection+ , module Database.Persist+ ) where++import Database.Persist+import qualified Database.Persist.Zookeeper.ZooUtil as Z+import qualified Database.Zookeeper as Z+import Data.Pool+import Data.Aeson+import Control.Monad (mzero, MonadPlus(..))+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Class (MonadTrans (..))+import Control.Applicative (Applicative (..))+import Control.Monad.Reader(ReaderT(..))+import Control.Monad.Reader.Class+import Data.Scientific() -- we require only RealFrac instance of Scientific+import Data.Time++-- | Information required to connect to a Zookeeper server+data ZookeeperConf = ZookeeperConf {+ zCoord :: String+ , zTimeout :: Z.Timeout+ , zNumStripes :: Int+ , zIdleTime :: NominalDiffTime+ , zMaxResources :: Int+} deriving (Show)++type Connection = Pool Z.ZooStat++-- | Monad reader transformer keeping Zookeeper connection through out the work+newtype ZookeeperT m a = ZookeeperT { runZookeeperT :: ReaderT Connection m a }+ deriving (Monad, MonadIO, MonadTrans, Functor, Applicative, MonadPlus)++-- | Extracts connection from ZookeeperT monad transformer+thisConnection :: Monad m => ZookeeperT m Connection+thisConnection = ZookeeperT ask++-- | Run a connection reader function against a Zookeeper configuration+withZookeeperConn :: (Monad m, MonadIO m) => ZookeeperConf -> (Connection -> m a) -> m a+withZookeeperConn conf connectionReader = do+ conn <- liftIO $ createPoolConfig conf+ connectionReader conn++runZookeeperPool :: ZookeeperT m a -> Connection -> m a+runZookeeperPool (ZookeeperT r) = runReaderT r++instance PersistConfig ZookeeperConf where+ type PersistConfigBackend ZookeeperConf = ZookeeperT+ type PersistConfigPool ZookeeperConf = Connection++ loadConfig (Object o) = do+ coord <- o .:? "coord" .!= "localhost:2181/"+ timeout <- o .:? "timeout" .!= 10000+ numstripes <- o .:? "num-stripes" .!= 1+ (idletime :: Int) <- o .:? "idletime" .!= 30+ maxresources <- o .:? "max-resource" .!= 50++ return ZookeeperConf {+ zCoord = coord+ , zTimeout = timeout+ , zNumStripes = numstripes+ , zIdleTime = fromIntegral idletime+ , zMaxResources = maxresources+ }++ loadConfig _ = mzero++ createPoolConfig (ZookeeperConf h t s idle maxres ) = + Z.connect h t Nothing Nothing s idle maxres++ runPool _ = runZookeeperPool
+ Database/Persist/Zookeeper/Internal.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE OverloadedStrings #-}+module Database.Persist.Zookeeper.Internal+ where+ +import Control.Monad.IO.Class (MonadIO (..))+import Data.Monoid+import Data.Maybe+import qualified Data.Aeson as A+import qualified Data.Text as T+import Database.Persist.Types+import Database.Persist.Class+import qualified Data.ByteString.Char8 as B+import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.ByteString.Base64.URL as B64+++txtToKey :: (PersistEntity val) => T.Text -> Key val+txtToKey = Key . PersistText++keyToTxt :: (PersistEntity val) => Key val -> T.Text+keyToTxt (Key (PersistText key)) = key+keyToTxt v = error $ "do not support "++show v++dummyFromKey :: Key v -> Maybe v+dummyFromKey _ = Nothing++dummyFromUnique :: Unique v -> Maybe v+dummyFromUnique _ = Nothing++val2table :: (PersistEntity val) => val -> T.Text+val2table = unDBName . entityDB . entityDef . Just++val2uniqkey :: (MonadIO m, PersistEntity val) => val -> m (Maybe (Unique val))+val2uniqkey val = do+ case persistUniqueKeys val of+ (uniqkey:_) -> return $ Just uniqkey+ [] -> return Nothing++uniqkey2key :: (PersistEntity val) => Unique val -> Key val+uniqkey2key uniqkey =+ let dir = entity2path $ fromJust $ dummyFromUnique uniqkey+ in txtToKey $ T.pack $ dir <> "/" <> (B.unpack $ B64.encode $ BL.toStrict $ A.encode $ persistUniqueToValues uniqkey)++entity2bin :: (PersistEntity val) => val -> B.ByteString+entity2bin val = BL.toStrict (A.encode (map toPersistValue (toPersistFields val)))+++kv2v :: [PersistValue] -> [PersistValue]+kv2v [] = []+kv2v ((PersistList [_k,v] ):xs) = v:kv2v xs+kv2v (x:xs) = x:kv2v xs++bin2entity :: (PersistEntity val) => B.ByteString -> Maybe val+bin2entity bin =+ case A.decode (BL.fromStrict bin) :: Maybe [PersistValue]of+ Nothing -> Nothing+ Just v ->+ case fromPersistValues (kv2v v) of+ Right body -> Just $ body+ Left s -> error $ T.unpack s+ ++entity2path :: (PersistEntity val) => val -> String+entity2path val = "/" <> (T.unpack $ val2table val)++-- entityAndKey2path :: (PersistEntity val) => val -> Key val -> String+-- entityAndKey2path val (Key (PersistText txt)) = entity2path val <> "/" <> ( B.unpack $ B64.encode $ B.pack $ T.unpack txt)+-- entityAndKey2path _ _ = error "key is not persist text"++-- key2path :: (PersistEntity val) => Key val -> String+-- key2path key = entityAndKey2path (fromJust (dummyFromKey key)) key
+ Database/Persist/Zookeeper/PathPiece.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Database.Persist.Zookeeper.PathPiece+ where++import Database.Persist+import Database.Persist.Zookeeper.Store+import Web.PathPieces (PathPiece (..))+import qualified Data.ByteString.Char8 as B+import qualified Data.Text as T+import qualified Data.ByteString.Base64.URL as B64+++-- | ToPathPiece is used to convert a key to/from text+instance PathPiece (KeyBackend ZookeeperBackend entity) where+ fromPathPiece txt =+ case B64.decode $ B.pack $ T.unpack txt of+ Right v -> Just (Key (PersistText (T.pack $ B.unpack v)))+ Left _ -> Nothing+ toPathPiece (Key (PersistText txt)) = T.pack $ B.unpack $ B64.encode $ B.pack $ T.unpack txt+ toPathPiece (Key _) = error "Wrong key for pathpiece "+
+ Database/Persist/Zookeeper/Store.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Database.Persist.Zookeeper.Store + ( ZookeeperBackend+ , execZookeeperT+ )where++import Database.Persist+-- import Database.Persist.Class+-- import Database.Persist.Types+import Control.Exception+import Control.Applicative+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Control (MonadBaseControl)+import qualified Database.Zookeeper as Z+import Data.Monoid+import qualified Data.Text as T+-- import qualified Data.ByteString.Char8 as B+import Database.Persist.Zookeeper.Config (ZookeeperT(..), thisConnection)+import Database.Persist.Zookeeper.Internal+import Database.Persist.Zookeeper.ZooUtil+import Data.Pool+++data ZookeeperBackend++ +-- -- | Execute Zookeeper transaction inside ZookeeperT monad transformer+execZookeeperT :: (Read a,Show a,Monad m, MonadIO m) => (Z.Zookeeper -> IO (Either Z.ZKError a)) -> ZookeeperT m a+execZookeeperT action = do+ conn <- thisConnection+ r <- liftIO $ withResource conn $ \s ->+ zExec s action+ case r of+ (Right x) -> return x+ (Left x) -> liftIO $ throwIO $ userError $ "Zookeeper error: code" ++ show x --fail $ show x++instance (Applicative m, Functor m, MonadIO m, MonadBaseControl IO m) => PersistStore (ZookeeperT m) where+ type PersistMonadBackend (ZookeeperT m) = ZookeeperBackend++ insert val = do+ let dir = entity2path val+ let path = dir <> "/"+ str <- execZookeeperT $ \zk -> do+ zCreate zk dir path (Just (entity2bin val)) [Z.Sequence]+ return $ txtToKey $ T.pack $ str++ insertKey (Key (PersistText key)) val = do+ _ <- execZookeeperT $ \zk -> do+ let dir = entity2path val+ zCreate zk dir (T.unpack key) (Just (entity2bin val)) []+ return ()++ insertKey _ _ = fail "Wrong key type in insertKey"++ repsert (Key (PersistText key)) val = do+ _ <- execZookeeperT $ \zk -> do+ let dir = entity2path val+ zRepSert zk dir (T.unpack key) (Just (entity2bin val))+ return ()+ repsert _ _ = fail "Wrong key type in repsert"++ replace (Key (PersistText key)) val = do+ execZookeeperT $ \zk -> do+ _ <- zReplace zk (T.unpack key) (Just (entity2bin val))+ return $ Right ()+ return ()++ replace _ _ = fail "Wrong key type in replace"++ delete (Key (PersistText key)) = do+ execZookeeperT $ \zk -> do+ _ <- Z.delete zk (T.unpack key) Nothing+ return $ Right ()+ return ()+ delete _ = fail "Wrong key type in delete"++ get (Key (PersistText key)) = do+ r <- execZookeeperT $ \zk -> do+ val <- Z.get zk (T.unpack key) Nothing+ return $ Right val+ case r of+ (Left Z.NoNodeError) ->+ return Nothing+ (Left v) ->+ fail $ show v+ (Right (Just str,_sta)) -> do+ return (bin2entity str)+ (Right (Nothing,_stat)) -> do+ fail $ "data is nothing"+ + get _ = fail "Wrong key type in get"
+ Database/Persist/Zookeeper/Unique.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Database.Persist.Zookeeper.Unique+ where++import Database.Persist+import Control.Applicative (Applicative)+import Control.Monad.IO.Class (MonadIO (..))+import Control.Monad.Trans.Control (MonadBaseControl)+import qualified Data.Text as T+import qualified Database.Zookeeper as Z+import Database.Persist.Zookeeper.Config+import Database.Persist.Zookeeper.Internal+import Database.Persist.Zookeeper.Store+import Database.Persist.Zookeeper.ZooUtil++instance (Applicative m, Functor m, MonadIO m, MonadBaseControl IO m) => PersistUnique (ZookeeperT m) where+ getBy uniqVal = do+ let key = uniqkey2key uniqVal+ val <- get key+ case val of+ Nothing -> return Nothing+ Just v -> return $ Just $ Entity key v++ deleteBy uniqVal = do+ let key = uniqkey2key uniqVal+ delete key+ + insertUnique val = do+ mUniqVal <- val2uniqkey val+ case mUniqVal of+ Just uniqVal -> do+ let key@(Key (PersistText txt)) = uniqkey2key uniqVal+ execZookeeperT $ \zk -> do+ let dir = entity2path val+ r <- zCreate zk dir (T.unpack txt) (Just (entity2bin val)) []+ case r of+ Right _ -> return $ Right $ Just key+ Left Z.NodeExistsError -> return $ Right $ Nothing+ Left v -> return $ Left v+ Nothing -> do+ return $ Nothing+
+ Database/Persist/Zookeeper/ZooUtil.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE FlexibleContexts, UndecidableInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Database.Persist.Zookeeper.ZooUtil+ where++import qualified Database.Zookeeper as Z+import qualified Data.ByteString.Char8 as B+-- import qualified Data.ByteString.Lazy as BL+import qualified Data.Pool as P+import Control.Concurrent+import Control.Concurrent.STM+import Data.Time+import Data.Maybe++deriving instance Read (Z.ZKError)+deriving instance Read (Z.Stat)++zModify :: Z.Zookeeper+ -> String+ -> (Maybe B.ByteString -> IO (Maybe B.ByteString))+ -> IO (Either Z.ZKError Z.Stat)+zModify zk key f = do+ v <- Z.get zk key Nothing+ case v of+ Right (con,ver) -> do+ v'' <- f con+ v' <- Z.set zk key v'' (Just (Z.statVersion ver))+ case v' of+ Right _ -> return v'+ Left _ -> zModify zk key f+ Left e -> return $ Left e++zReplace :: Z.Zookeeper+ -> String+ -> (Maybe B.ByteString)+ -> IO (Either Z.ZKError Z.Stat)+zReplace zk key v'' = do+ v <- Z.get zk key Nothing+ case v of+ Right (_con,ver) -> do+ v' <- Z.set zk key v'' (Just (Z.statVersion ver))+ case v' of+ Right _ -> return v'+ Left _ -> zReplace zk key v''+ Left e -> return $ Left e++zRepSert :: Z.Zookeeper+ -> String+ -> String+ -> (Maybe B.ByteString)+ -> IO (Either Z.ZKError ())+zRepSert zk dir key v'' = do+ v <- zCreate zk dir key v'' []+ case v of+ Right _ -> return $ Right ()+ Left Z.NodeExistsError -> do+ v' <- zReplace zk key v''+ case v' of+ Right _ -> return $ Right ()+ Left Z.NoNodeError -> do+ zRepSert zk dir key v''+ Left s -> do+ return $ Left s+ Left v' -> return $ Left v'++zCreate :: Z.Zookeeper+ -> String+ -> String+ -> Maybe B.ByteString+ -> [Z.CreateFlag]+ -> IO (Either Z.ZKError String)+zCreate zk dir path value flag = do+ v <- Z.create zk path value Z.OpenAclUnsafe flag+ case v of+ Left Z.NoNodeError -> do+ v' <- Z.create zk dir Nothing Z.OpenAclUnsafe []+ case v' of+ Left v'' -> return $ Left v''+ Right _ -> zCreate zk dir path value flag+ v' -> return v'++data ZooStat = ZooStat {+ zVar :: TMVar (ZAction String)+ , rVar :: TMVar String+ }++data ZAction t = + Action (Z.Zookeeper -> IO String)+ | Close++zOpen :: String+ -> Z.Timeout+ -> Maybe Z.Watcher+ -> Maybe Z.ClientID+ -> IO ZooStat+zOpen endpoint timeout watcher clientId = do+ Z.setDebugLevel Z.ZLogError+ zvar <- atomically $ newEmptyTMVar+ rvar <- atomically $ newEmptyTMVar+ stateVar <- newTVarIO Z.ConnectingState+ let watcher' = if isJust watcher then watcher else (Just (watcherd stateVar))+ _ <- forkIO $ Z.withZookeeper endpoint timeout watcher' clientId $ \z -> do+ atomically $ do+ state <- readTVar stateVar+ case state of+ Z.ConnectingState -> retry+ _ -> return ()+ loop zvar rvar z+ return $ ZooStat zvar rvar+ where+ loop zvar rvar z = do+ var <- atomically $ takeTMVar zvar+ case var of+ Close -> return ()+ Action io -> do+ v <- io z+ atomically $ putTMVar rvar v+ loop zvar rvar z+ watcherd :: TVar Z.State -> Z.Watcher+ watcherd stateVar _z event state _mZnode = do+ case event of+ Z.SessionEvent -> atomically $ writeTVar stateVar state+ _ -> return ()++zExec :: (Read a, Show a) => ZooStat -> (Z.Zookeeper -> IO a) -> IO a+zExec (ZooStat zvar rvar) action = do+ atomically $ do+ putTMVar zvar $ Action $ \zk -> do+ v <- action zk+ return $ show v+ var <- atomically $ do+ takeTMVar rvar+ return $ read var++zClose :: ZooStat -> IO ()+zClose (ZooStat zvar _rvar) = do+ atomically $ do+ putTMVar zvar Close++connect :: String+ -> Z.Timeout+ -> Maybe Z.Watcher+ -> Maybe Z.ClientID+ -> Int+ -> NominalDiffTime+ -> Int+ -> IO (P.Pool ZooStat)+connect endpoint timeout watcher clientId numStripes idleTime maxResources =+ P.createPool+ (zOpen endpoint timeout watcher clientId) + zClose+ numStripes idleTime maxResources
+ LICENSE view
@@ -0,0 +1,25 @@+The following license covers this documentation, and the source code, except+where otherwise indicated.++Copyright 2014, Junji Hashimoto. All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++* Redistributions of source code must retain the above copyright notice, this+ list of conditions and the following disclaimer.++* 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 COPYRIGHT HOLDERS "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 COPYRIGHT HOLDERS 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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ persistent-zookeeper.cabal view
@@ -0,0 +1,77 @@+name: persistent-zookeeper+version: 0.0.1+license: BSD3+license-file: LICENSE+author: Junji Hashimoto <junji.hashimoto@gree.net>+synopsis: Backend for persistent library using Zookeeper.+description: Based on the Zookeeper package.+category: Database+stability: Experimental+cabal-version: >= 1.8+maintainer: Junji Hashimoto <junji.hashimoto@gree.net>+build-type: Simple++-- source-repository head+-- type: git+-- location: https://github.com/yesodweb/persistent.git++library+ build-depends: base >= 4 && < 5+ , bytestring >= 0.10.0.0 && < 0.11.0.0+ , persistent >= 1.3 && < 1.4+ , text >= 0.8+ , aeson >= 0.5+ , time >= 1.4 && < 1.5+ , attoparsec+ , mtl+ , transformers+ , monad-control+ , utf8-string >= 0.3.7 && < 0.4.0+ , binary >= 0.7 && < 0.8+ , scientific+ , hzk+ , resource-pool+ , path-pieces+ , template-haskell+ , base64-bytestring+ , stm++ exposed-modules: Database.Persist.Zookeeper++ other-modules: Database.Persist.Zookeeper.Config+ Database.Persist.Zookeeper.Internal+ Database.Persist.Zookeeper.Store+ Database.Persist.Zookeeper.Unique+ Database.Persist.Zookeeper.PathPiece+ Database.Persist.Zookeeper.ZooUtil++ ghc-options: -Wall++test-suite basic+ type: exitcode-stdio-1.0+ main-is: tests/basic-test.hs+ build-depends: base >= 4 && < 5+ , persistent >= 1.3 && < 1.4+ , persistent-template >= 1.3 && < 1.4+ , mtl+ , transformers+ , utf8-string >= 0.3.7 && < 0.4.0+ , bytestring >= 0.10.0.0 && < 0.11.0.0+ , text >= 0.8+ , aeson >= 0.5+ , binary >= 0.7 && < 0.8+ , time >= 1.4 && < 1.5+ , attoparsec+ , template-haskell+ , monad-control+ , utf8-string >= 0.3.7 && < 0.4.0+ , persistent-zookeeper+ , scientific+ , hzk+ , resource-pool+ , path-pieces+ , base64-bytestring+ , hspec+ , stm++ ghc-options: -Wall
+ tests/basic-test.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}+{-# LANGUAGE TypeFamilies, EmptyDataDecls, GADTs #-}+module Main where++import Database.Persist+import Database.Persist.Zookeeper+import Database.Persist.TH+import Language.Haskell.TH.Syntax+import Data.Maybe+import Test.Hspec++let zookeeperSettings = mkPersistSettings (ConT ''ZookeeperBackend)+ in share [mkPersist zookeeperSettings] [persistLowerCase|+Person+ name String+ age Int+ PersonU name+ deriving Show+ deriving Eq+|]++zookeeperConf :: ZookeeperConf+zookeeperConf = ZookeeperConf "localhost:2181" 10000 1 50 30++main :: IO ()+main = + withZookeeperConn zookeeperConf $ \conn -> do+ hspec $ do+ let key = (Key (PersistText "/person/WyJzVGVzdC9ob2dlIl0="))+ let val = Person "Test/hoge" 12+ describe "PersistUnique test" $ do+ it "insertUnique" $ do+ v <- flip runZookeeperPool conn $ do+ deleteBy $ PersonU "Test/hoge"+ insertUnique val+ v `shouldBe` (Just key)+ it "getBy" $ do+ v <- flip runZookeeperPool conn $ do+ getBy $ PersonU "Test/hoge" + (entityKey (fromJust v)) `shouldBe` key+ (entityVal (fromJust v)) `shouldBe` val+ v `shouldBe` (Just (Entity key val))+ it "deleteBy" $ do+ v <- flip runZookeeperPool conn $ do+ deleteBy $ PersonU "Test/hoge"+ getBy $ PersonU "Test/hoge"+ v `shouldBe` Nothing+ describe "PersistStore test" $ do+ it "StoreTest" $ do+ key' <- flip runZookeeperPool conn $ do+ insert val+ v <- flip runZookeeperPool conn $ do+ get key' :: ZookeeperT IO (Maybe Person)+ print $ show key'+ v `shouldBe` (Just val)+ v' <- flip runZookeeperPool conn $ do+ delete key'+ get key'+ v' `shouldBe` Nothing+ +