etcd 0.1.0.2 → 1.0.3
raw patch · 3 files changed
+50/−39 lines, 3 filesdep +textdep ~base
Dependencies added: text
Dependency ranges changed: base
Files
- etcd.cabal +6/−3
- src/Network/Etcd.hs +34/−31
- test/Test.hs +10/−5
etcd.cabal view
@@ -1,5 +1,5 @@ name: etcd-version: 0.1.0.2+version: 1.0.3 license: OtherLicense license-file: UNLICENSE synopsis: Client for etcd, a highly-available key value store@@ -12,6 +12,7 @@ library+ default-language: Haskell2010 hs-source-dirs: src exposed-modules: Network.Etcd@@ -21,8 +22,8 @@ build-depends: bytestring >= 0 build-depends: http-conduit >= 0 build-depends: time >= 0+ build-depends: text - default-language: Haskell2010 ghc-options: -Wall @@ -30,7 +31,9 @@ test-suite test type: exitcode-stdio-1.0 + default-language: Haskell2010 hs-source-dirs: test+ main-is: Test.hs build-depends: MonadRandom@@ -38,6 +41,6 @@ build-depends: etcd build-depends: hspec build-depends: mtl+ build-depends: text - default-language: Haskell2010 ghc-options: -threaded -with-rtsopts=-N
src/Network/Etcd.hs view
@@ -31,10 +31,13 @@ import Data.Aeson hiding (Value, Error)-import Data.ByteString.Char8 (pack) import Data.Time.Clock import Data.Time.LocalTime import Data.List+import Data.Text (Text)+import qualified Data.Text as T+import Data.Text.Encoding+import Data.Monoid import Control.Applicative import Control.Exception@@ -46,20 +49,20 @@ -- | The 'Client' holds all data required to make requests to the etcd -- cluster. You should use 'createClient' to initialize a new client. data Client = Client- { leaderUrl :: String+ { leaderUrl :: !Text -- ^ The URL to the leader. HTTP requests are sent to this server. } -- | The version prefix used in URLs. The current client supports v2.-versionPrefix :: String+versionPrefix :: Text versionPrefix = "v2" -- | The URL to the given key.-keyUrl :: Client -> Key -> String-keyUrl client key = leaderUrl client ++ "/" ++ versionPrefix ++ "/keys/" ++ key+keyUrl :: Client -> Key -> Text+keyUrl client key = leaderUrl client <> "/" <> versionPrefix <> "/keys/" <> key ------------------------------------------------------------------------------@@ -116,12 +119,12 @@ -- | Keys are strings, formatted like filesystem paths (ie. slash-delimited -- list of path components).-type Key = String+type Key = Text -- | Values attached to leaf nodes are strings. If you want to store -- structured data in the values, you'll need to encode it into a string.-type Value = String+type Value = Text -- | TTL is specified in seconds. The server accepts negative values, but they@@ -142,33 +145,33 @@ -- the two fields 'ttl' and 'expiration'. data Node = Node- { _nodeKey :: Key+ { _nodeKey :: !Key -- ^ The key of the node. It always starts with a slash character (0x47). - , _nodeCreatedIndex :: Index+ , _nodeCreatedIndex :: !Index -- ^ A unique index, reflects the point in the etcd state machine at -- which the given key was created. - , _nodeModifiedIndex :: Index+ , _nodeModifiedIndex :: !Index -- ^ Like '_nodeCreatedIndex', but reflects when the node was laste -- changed. - , _nodeDir :: Bool+ , _nodeDir :: !Bool -- ^ 'True' if this node is a directory. - , _nodeValue :: Maybe Value+ , _nodeValue :: !(Maybe Value) -- ^ The value is only present on leaf nodes. If the node is -- a directory, then this field is 'Nothing'. - , _nodeNodes :: Maybe [Node]+ , _nodeNodes :: !(Maybe [Node]) -- ^ If this node is a directory, then these are its children. The list -- may be empty. - , _nodeTTL :: Maybe TTL+ , _nodeTTL :: !(Maybe TTL) -- ^ If the node has TTL set, this is the number of seconds how long the -- node will exist. - , _nodeExpiration :: Maybe UTCTime+ , _nodeExpiration :: !(Maybe UTCTime) -- ^ If TTL is set, then this is the time when it expires. } deriving (Show, Eq, Ord)@@ -204,9 +207,9 @@ type HR = Either Error Response -httpGET :: String -> IO HR+httpGET :: Text -> IO HR httpGET url = do- req <- acceptJSON <$> parseUrl url+ req <- acceptJSON <$> parseUrl (T.unpack url) body <- responseBody <$> (withManager $ httpLbs req) return $ maybe (Left Error) Right $ decode body @@ -215,18 +218,18 @@ acceptJSON req = req { requestHeaders = acceptHeader : requestHeaders req } -httpPUT :: String -> [(String, String)] -> IO HR+httpPUT :: Text -> [(Text, Text)] -> IO HR httpPUT url params = do- req' <- parseUrl url- let req = urlEncodedBody (map (\(k,v) -> (pack k, pack v)) params) $ req'+ req' <- parseUrl (T.unpack url)+ let req = urlEncodedBody (map (\(k,v) -> (encodeUtf8 k, encodeUtf8 v)) params) $ req' body <- responseBody <$> (withManager $ httpLbs $ req { method = "PUT" }) return $ maybe (Left Error) Right $ decode body -httpPOST :: String -> [(String, String)] -> IO HR+httpPOST :: Text -> [(Text, Text)] -> IO HR httpPOST url params = do- req' <- parseUrl url- let req = urlEncodedBody (map (\(k,v) -> (pack k, pack v)) params) $ req'+ req' <- parseUrl (T.unpack url)+ let req = urlEncodedBody (map (\(k,v) -> (encodeUtf8 k, encodeUtf8 v)) params) $ req' body <- responseBody <$> (withManager $ httpLbs $ req { method = "POST" }) return $ maybe (Left Error) Right $ decode body@@ -234,15 +237,15 @@ -- | Issue a DELETE request to the given url. Since DELETE requests don't have -- a body, the params are appended to the URL as a query string.-httpDELETE :: String -> [(String, String)] -> IO HR+httpDELETE :: Text -> [(Text, Text)] -> IO HR httpDELETE url params = do- req <- parseUrl $ url ++ (asQueryParams params)+ req <- parseUrl $ T.unpack $ url <> (asQueryParams params) body <- responseBody <$> (withManager $ httpLbs $ req { method = "DELETE" }) return $ maybe (Left Error) Right $ decode body where asQueryParams [] = ""- asQueryParams xs = "?" ++ intercalate "&" (map (\(k,v) -> k ++ "=" ++ v) xs)+ asQueryParams xs = "?" <> mconcat (intersperse "&" (map (\(k,v) -> k <> "=" <> v) xs)) ------------------------------------------------------------------------------@@ -256,9 +259,9 @@ -- | Encode an optional TTL into a param pair.-ttlParam :: Maybe TTL -> [(String,String)]+ttlParam :: Maybe TTL -> [(Text, Text)] ttlParam Nothing = []-ttlParam (Just ttl) = [("ttl",show ttl)]+ttlParam (Just ttl) = [("ttl", T.pack $ show ttl)] @@ -271,7 +274,7 @@ -- | Create a new client and initialize it with a list of seed machines. The -- list must be non-empty.-createClient :: [ String ] -> IO Client+createClient :: [ Text ] -> IO Client createClient seed = return $ Client (head seed) @@ -324,10 +327,10 @@ -} -dirParam :: [(String,String)]+dirParam :: [(Text, Text)] dirParam = [("dir","true")] -recursiveParam :: [(String,String)]+recursiveParam :: [(Text, Text)] recursiveParam = [("recursive","true")]
test/Test.hs view
@@ -1,9 +1,14 @@+{-# LANGUAGE OverloadedStrings #-}+ module Main where import Test.Hspec import Data.Char import Data.Maybe+import Data.Text (Text)+import qualified Data.Text as T+import Data.Monoid import Control.Applicative import Control.Concurrent@@ -18,10 +23,10 @@ main = hspec spec -randomKey :: IO String+randomKey :: IO Text randomKey = do rnd <- evalRandIO (sequence $ repeat $ getRandomR (0, 61))- return $ take 13 $ map alnum rnd+ return $ T.pack $ take 13 $ map alnum rnd where alnum :: Int -> Char alnum x@@ -31,7 +36,7 @@ | otherwise = error $ "Out of range: " ++ show x -setup :: IO (Client, String)+setup :: IO (Client, Text) setup = do client <- createClient [ "http://127.0.0.1:4001" ] key <- randomKey@@ -92,7 +97,7 @@ it "Listing a directory" $ do (client, key) <- setup createDirectory client key Nothing- set client (key ++ "/one") "value" Nothing+ set client (key <> "/one") "value" Nothing nodes <- listDirectoryContents client key length nodes `shouldBe` 1 _nodeValue (head nodes) `shouldBe` (Just "value")@@ -100,7 +105,7 @@ it "Deleting a directory recursively" $ do (client, key) <- setup createDirectory client key Nothing- set client (key ++ "/one") "value" Nothing+ set client (key <> "/one") "value" Nothing removeDirectoryRecursive client key it "Atomically Creating In-Order Keys" $ do