grpc-etcd-client (empty) → 0.1.0.0

raw patch · 6 files changed

+232/−0 lines, 6 filesdep +basedep +bytestringdep +data-default-classsetup-changed

Dependencies added: base, bytestring, data-default-class, grpc-api-etcd, http2-client, http2-client-grpc, lens, network, proto-lens, proto-lens-protoc

Files

ChangeLog.md +3/−0
LICENSE +30/−0
README.md +3/−0
Setup.hs +2/−0
grpc-etcd-client.cabal +48/−0
src/Network/EtcdV3.hs +146/−0

+ ChangeLog.md view

@@ -0,0 +1,3 @@+# Changelog for grpc-etcd-client++## Unreleased changes

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Author name here (c) 2018++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.++    * Neither the name of Author name here nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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+OWNER 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.

+ README.md view

@@ -0,0 +1,3 @@+# grpc-etcd-client++A gRPC client for the EtcdV3 api.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ grpc-etcd-client.cabal view

@@ -0,0 +1,48 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 9f72b3a871af877169da36a4b0357d2ca7a2294a6ea8d5fa2d7729847c6517f3++name:           grpc-etcd-client+version:        0.1.0.0+synopsis:       gRPC client for etcd+description:    Please see the README on GitHub at <https://github.com/lucasdicioccio/grpc-etcd-client#readme>+category:       Distributed Computing+homepage:       https://github.com/lucasdicioccio/grpc-etcd-client#readme+bug-reports:    https://github.com/lucasdicioccio/grpc-etcd-client/issues+author:         Lucas DiCioccio+maintainer:     lucas@dicioccio.fr+copyright:      2018 Lucas DiCioccio+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10+extra-source-files:+    ChangeLog.md+    README.md++source-repository head+  type: git+  location: https://github.com/lucasdicioccio/grpc-etcd-client++library+  exposed-modules:+      Network.EtcdV3+  other-modules:+      Paths_grpc_etcd_client+  hs-source-dirs:+      src+  default-extensions: DataKinds OverloadedStrings+  build-depends:+      base >=4.7 && <5+    , bytestring+    , data-default-class+    , grpc-api-etcd ==0.1.0.0+    , http2-client+    , http2-client-grpc >=0.5 && <0.6+    , lens+    , network+    , proto-lens+    , proto-lens-protoc+  default-language: Haskell2010

+ src/Network/EtcdV3.hs view

@@ -0,0 +1,146 @@+{-# LANGUAGE FlexibleContexts #-}++-- | Simple lib to access Etcd over gRPC.+module Network.EtcdV3+    (+    -- * Generalities.+      etcdClientConfigSimple+    , EtcdQuery+    -- * Reading.+    , KeyRange(..)+    , range+    , rangeResponsePairs+    -- * Granting leases.+    , grantLease+    , fromLeaseGrantResponse+    , keepAlive+    -- * Writing.+    , put+    -- * re-exports+    , def+    , module Control.Lens+    , module EtcdPB+    , module EtcdRPC+    ) where++import Control.Lens+import Data.Default.Class (def)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as C8+import Data.Semigroup (Endo)+import GHC.Int (Int64)+import Network.GRPC.Client+import Network.GRPC.Client.Helpers+import Network.Socket (HostName, PortNumber)+import Proto.Etcd.Etcdserver.Etcdserverpb.Rpc as EtcdRPC+import Proto.Etcd.Etcdserver.Etcdserverpb.Rpc_Fields as EtcdPB++-- | EtcdClient configuration.+etcdClientConfigSimple :: HostName -> PortNumber -> UseTlsOrNot -> GrpcClientConfig+etcdClientConfigSimple host port tls =+    (grpcClientConfigSimple host port tls) { _grpcClientConfigCompression = uncompressed }++-- | Helper to unpack an unary gRPC call output.+unaryOutput+  :: (Applicative f, Field3 a1 b1 (Either c1 a2) (Either c1 b2)) =>+     (a2 -> f b2)+     -> Either c2 (Either c3 a1) -> f (Either c2 (Either c3 b1))+unaryOutput = _Right . _Right . _3 . _Right++-- | Type alias to simplify type signatures.+type EtcdQuery a = IO (Maybe a)++-- | Data type to unify the three addressing schemes in etcd.+--+-- See 'range'.+data KeyRange+  = SingleKey !ByteString+  -- ^ Exactly one key.+  | FromKey !ByteString+  | Prefixed !ByteString+  deriving (Show, Eq, Ord)++-- | Lookup a range of values+range+  :: GrpcClient+  -- ^ Initialized gRPC client.+  -> KeyRange+  -- ^ Looked-up range.+  -> EtcdQuery RangeResponse+range grpc r = preview unaryOutput <$>+    rawUnary (RPC :: RPC KV "range") grpc (def & key .~ k0 & rangeEnd .~ kend)+  where+    (k0, kend) = rangePairForRangeQuery r++-- | Specific fold to get the key-values of a 'RangeResponse'+--+-- Typical usage is:+--+-- @ x <- range grpc (Prefixed "/some-dir/")+-- @ print $ x ^.. _Just . rangePairs+--+-- Note that Etcd RangeResponse is a rich object, please refer to Etcd+-- documentation to understand what you will miss out (e.g., whether the list+-- is complete or not).+rangeResponsePairs+  :: Getting (Endo [(ByteString, ByteString)]) RangeResponse (ByteString, ByteString)+rangeResponsePairs = kvs . traverse . to (\x -> (x ^. key, x ^. value))++-- | Internal helper for turning a 'KeyRange' into the start/end queries Etcd+-- 'range' RPC needs.+rangePairForRangeQuery :: KeyRange -> (ByteString, ByteString)+rangePairForRangeQuery (SingleKey k) = (k, "")+rangePairForRangeQuery (FromKey k) = (k, "\NUL")+rangePairForRangeQuery (Prefixed k) = (k, kPlus1)+  where+    rest = C8.dropWhile (== '\xff') $ C8.reverse k+    kPlus1 = if C8.null rest then "\NUL" else C8.reverse $ C8.cons (succ (C8.head rest)) (C8.drop 1 rest)++-- | Asks for a lease of a given duration.+grantLease+  :: GrpcClient+  -- ^ Initialized gRPC client.+  -> Int64+  -- ^ TTL for the lease.+  -> EtcdQuery LeaseGrantResponse+grantLease grpc seconds =+    preview unaryOutput <$> rawUnary (RPC :: RPC Lease "leaseGrant") grpc (def & ttl .~ seconds)++-- | Opaque lease result.+--+-- Show instance used for printing purposes only.+newtype GrantedLease = GrantedLease { _getGrantedLeaseId :: Int64 }++instance Show GrantedLease where+  show (GrantedLease n) = "(lease #" <> show n <> ")"++-- | Constructor for 'GrantedLease'.+fromLeaseGrantResponse :: LeaseGrantResponse -> GrantedLease+fromLeaseGrantResponse r = GrantedLease $ r ^. EtcdPB.id++-- | Keep a lease alive.+keepAlive+  :: GrpcClient+  -- ^ Initialized gRPC client.+  -> GrantedLease+  -- ^ A previously-granted lease.+  -> EtcdQuery LeaseKeepAliveResponse+keepAlive grpc (GrantedLease leaseID) =+    preview unaryOutput <$> rawUnary (RPC :: RPC Lease "leaseKeepAlive") grpc (def & EtcdPB.id .~ leaseID)++-- | Put one value.+put+  :: GrpcClient+  -- ^ initialized gRPC client+  -> ByteString+  -- ^ Key.+  -> ByteString++  -- ^ Value.+  -> Maybe GrantedLease+  -- ^ Lease on the key.+  -> EtcdQuery PutResponse+put grpc k v gl =+    preview unaryOutput <$> rawUnary (RPC :: RPC KV "put") grpc (def & key .~ k & value .~ v & lease .~ l)+  where+    l = maybe 0 _getGrantedLeaseId gl