utxorpc-client (empty) → 0.0.1.0
raw patch · 11 files changed
+1454/−0 lines, 11 filesdep +aesondep +basedep +bytestring
Dependencies added: aeson, base, bytestring, case-insensitive, hspec, http2, http2-client, http2-client-grpc, http2-grpc-proto-lens, http2-grpc-types, katip, lens, proto-lens, safe, time, transformers, unliftio, utxorpc, utxorpc-client, uuid
Files
- LICENSE +201/−0
- README.md +32/−0
- example/KatipLogger.hs +73/−0
- example/Main.hs +154/−0
- example/SimpleLogger.hs +111/−0
- quick-start/Main.hs +35/−0
- src/Utxorpc/Client.hs +204/−0
- src/Utxorpc/Logged.hs +225/−0
- src/Utxorpc/Types.hs +112/−0
- test/logged_test.hs +157/−0
- utxorpc-client.cabal +150/−0
+ LICENSE view
@@ -0,0 +1,201 @@+ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,32 @@+# UTxO RPC Client SDK++An SDK for clients of the [UTxO RPC](https://utxorpc.org/) specification.++The goal of this SDK is to reduce boilerplate and increase ease of use of the UTxO RPC spec. This SDK provides convenience methods for creating a connection to a UTxO RPC service and for calling each each method in the UTxO RPC specification. Automated logging of each event in a gRPC call is also supported.++## How to Use++Use the SDK through one of the client-creating functions in `Utxorpc.Client`.+1. `simpleUtxorpcClient` -- connect to a service using the bare minimum required information.+ 1. See `/quick-start/Main.hs`.+1. `utxorpcClient` -- connect to a service using the provided `UtxorpcInfo`.+ 1. See `/example/Main.hs`+1. `UtxorpcClientWith` -- for fine grained control, provide a `GrpcClientConfig` (from `http2-client-grpc`)++Each of these functions provides a record type hosting functions for each method in UTxO RPC, as well as a method to close the connection.++## Logging++This SDK supports automated logging through the `UtxorpcClientLogger` type. It is a record hosting user-defined logging functions for each of the following events:+1. Request sent.+1. Reply received.+1. Server stream data received.+1. Server stream ended.++For more information, see `Utxorpc.Logged` and `/example`.++## Examples++There are two provided examples:+1. `/quick-start` shows the bare minimum required to make a single unary request.+1. `/example` shows a more involved example. `/example/SimpleLogger.hs` is a simple logger implementation that prints human-readable output, and `/example/KatipLogger.hs` is a more involved logger that demonstrates how to use logging functions that run in a transformer stack.
+ example/KatipLogger.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module KatipLogger (katipLogger) where++import Control.Monad.Trans.Reader (ReaderT (..))+import Data.Aeson as A+import qualified Data.ByteString.Char8 as BS+import Data.UUID (UUID)+import Katip+import Katip.Monadic (KatipContextTState (..), unKatipContextT)+import Utxorpc.Client++katipLogger :: KatipContextTState -> UtxorpcClientLogger (KatipContextT IO)+katipLogger st =+ UtxorpcClientLogger+ katipRequestLogger+ katipReplyLogger+ katipServerStreamLogger+ katipServerStreamEndLogger+ (\action -> runReaderT (unKatipContextT action) st)++katipRequestLogger :: RequestLogger (KatipContextT IO)+katipRequestLogger path _client uuid msg =+ addContext path uuid Nothing $+ $(logTM) InfoS (showLS msg)++katipReplyLogger :: ReplyLogger (KatipContextT IO)+katipReplyLogger path _client uuid reply =+ addContext path uuid Nothing $+ $(logTM) InfoS (showLS reply)++katipServerStreamLogger :: ServerStreamLogger (KatipContextT IO)+katipServerStreamLogger path _client (uuid, index) msg =+ addContext path uuid (Just index) $+ $(logTM) InfoS (showLS msg)++katipServerStreamEndLogger :: ServerStreamEndLogger (KatipContextT IO)+katipServerStreamEndLogger path _client (uuid, index) (_headers, _trailers) =+ addContext path uuid (Just index) $+ $(logTM) InfoS "End of stream"++addContext :: (KatipContext m) => BS.ByteString -> UUID -> Maybe Int -> m a -> m a+addContext path uuid index = katipAddContext $ MsgContext path uuid index++data MsgContext = MsgContext+ { _path :: BS.ByteString,+ _uuid :: UUID,+ _index :: Maybe Int+ }++instance ToJSON MsgContext where+ toJSON :: MsgContext -> Value+ toJSON MsgContext {_path, _uuid, _index} =+ A.object+ ( "path"+ A..= BS.unpack _path+ : "UUID"+ A..= show _uuid+ : indexContext+ )+ where+ indexContext = case _index of+ Just idx -> ["Message #" A..= show idx]+ Nothing -> []++instance ToObject MsgContext++instance LogItem MsgContext where+ payloadKeys :: Verbosity -> MsgContext -> PayloadSelection+ payloadKeys _ _ = AllKeys
+ example/Main.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}++module Main (main) where++import qualified Data.ByteString.Char8 as BS+import Data.ProtoLens (Message (..))+import Katip+import Katip.Monadic+import KatipLogger (katipLogger)+import Network.GRPC.Client (CIHeaderList)+import Network.HTTP2.Frame (ErrorCode)+import Safe (readMay)+import SimpleLogger (simpleLogger)+import System.Environment (getArgs)+import UnliftIO (MonadIO, bracket, stdout, throwString)+import Utxorpc.Client (UtxorpcClientLogger, UtxorpcInfo (..), utxorpcClient)+import Utxorpc.Types+ ( BuildClientImpl (getChainTip),+ ServerStreamReply,+ SubmitClientImpl (watchMempool),+ SyncClientImpl (fetchBlock),+ UnaryReply,+ UtxorpcClient (buildClient, submitClient, syncClient),+ )+import "http2-client" Network.HTTP2.Client (ClientError, TooMuchConcurrency)++-- Get server info from args pass to `runUtxo`+main :: IO ()+main =+ do+ args <- getArgs+ case parseInfo args of+ Left err -> putStrLn err >> putStrLn usageStr+ Right serviceInfo ->+ if "--katip" `elem` args+ then runKatipExample serviceInfo+ else runSimpleExample serviceInfo+ where+ -- Parse command line args for server info+ parseInfo :: [String] -> Either String (UtxorpcInfo m)+ parseInfo args =+ case filter (not . (==) '-' . head) args of+ (hostName : portStr : tlsStr : gzipStr : hdrs) ->+ UtxorpcInfo hostName+ <$> parse ("Invalid port number: " ++ portStr) portStr+ <*> parse ("Invalid tlsEnabled arg: " ++ tlsStr) tlsStr+ <*> parse ("Invalid useGzip arg: " ++ gzipStr) gzipStr+ <*> parsedHeaders hdrs+ <*> pure Nothing+ invalidArgs -> Left $ "Not enough args (" ++ show (length invalidArgs) ++ " received)."+ where+ parse msg str = case readMay str of+ Nothing -> Left msg+ Just val -> Right val++ parsedHeaders :: [String] -> Either String [(BS.ByteString, BS.ByteString)]+ parsedHeaders = mapM (mkPair . BS.split ':' . BS.pack)+ where+ mkPair :: [BS.ByteString] -> Either String (BS.ByteString, BS.ByteString)+ mkPair [k, v] = Right (k, v)+ mkPair headerStr =+ Left $+ "Invalid header key:value pair: " ++ show (BS.unpack <$> headerStr)++ usageStr = "Usage: [--katip] <hostName> <port> <tlsEnabled> <useGzip> [<headerKey>:<headerValue> [...]]"++runKatipExample :: UtxorpcInfo m -> IO ()+runKatipExample serviceInfo = do+ bracket mkLogEnv closeScribes $ \le -> do+ eService <- utxorpcClient $ serviceInfo {_logger = Just $ mkKatipLogger le}+ case eService of+ Left clientErr -> handleClientErr clientErr+ Right service -> runUtxo service+ where+ -- Make KatipLogger. LogEnv required for the `unlift` function+ mkKatipLogger :: LogEnv -> UtxorpcClientLogger (KatipContextT IO)+ mkKatipLogger le = katipLogger $ KatipContextTState le mempty "example"++ -- Make log environment for KatipLogger+ mkLogEnv :: IO LogEnv+ mkLogEnv = do+ handleScribe <- mkHandleScribe ColorIfTerminal stdout (permitItem InfoS) V2+ le <- initLogEnv "Utxorpc" "development"+ registerScribe "stdout" handleScribe defaultScribeSettings le++runSimpleExample :: UtxorpcInfo m -> IO ()+runSimpleExample serviceInfo = do+ eService <- utxorpcClient $ serviceInfo {_logger = Just simpleLogger}+ case eService of+ Left clientErr -> handleClientErr clientErr+ Right service -> runUtxo service++-- Make UTxO RPC calls with empty messages+-- Errors are handled by throwing IO exceptions and exiting+-- `handleStream` is the stream handler function expected by a `ServerStreamCall`.+-- Note that the type of `handleStream` has nothing to do with the type of the+-- logger.+runUtxo :: UtxorpcClient -> IO ()+runUtxo client = do+ _maybeFetchBlockResponse <- handleUnaryReply $ fetchBlock (syncClient client) defMessage+ _maybeChainTipResponse <- handleUnaryReply $ getChainTip (buildClient client) defMessage+ _maybeStreamState <-+ handleStreamReply $+ watchMempool (submitClient client) (0 :: Int) defMessage handleStream+ return ()+ where+ handleStream n _headerList _reply = do+ putStrLn ("The stream handler is processing message #" ++ show n)+ return (n + 1)++-- Composite handlers for each error type that can be returned by the++handleUnaryReply :: UnaryReply o -> IO (Maybe o)+handleUnaryReply reply = do+ res <- reply+ case res of+ Left clientErr ->+ handleClientErr clientErr+ Right (Left tmc) ->+ handleTMC tmc+ Right (Right (Left errCode)) ->+ handleHTTP2Err errCode+ Right (Right (Right (headers, trailers, Left errMsg))) ->+ handleServerError (headers, trailers, errMsg)+ Right (Right (Right (_, _, Right msg))) ->+ return $ Just msg++handleStreamReply :: ServerStreamReply a -> IO (Maybe a)+handleStreamReply runReply = do+ reply <- runReply+ case reply of+ Left clientErr ->+ handleClientErr clientErr+ Right (Left tmc) ->+ handleTMC tmc+ Right (Right (streamState, _headerList, _trailerList)) -> return $ Just streamState++-- Error handlers that throw IO exceptions+-- A production application should handle these more gracefully+-- E.g., TooMuchConcurrency errors indicate a need to wait and+-- try again.++handleClientErr :: (MonadIO m) => ClientError -> m a+handleClientErr _ = throwString "Early end of stream!"++handleTMC :: (MonadIO m) => TooMuchConcurrency -> m a+handleTMC _ = throwString "Too much concurrency!"++handleHTTP2Err :: (MonadIO m) => ErrorCode -> m a+handleHTTP2Err errCode = throwString $ "HTTP2 Error: " ++ show errCode++handleServerError :: (MonadIO m) => (CIHeaderList, Maybe CIHeaderList, String) -> m a+handleServerError (_headers, _trailers, msg) = throwString $ "Received error message: " ++ msg
+ example/SimpleLogger.hs view
@@ -0,0 +1,111 @@+module SimpleLogger (simpleLogger) where++import Control.Lens.Combinators (over, _1)+import Control.Monad (unless)+import qualified Data.ByteString.Char8 as BS+import Data.CaseInsensitive (CI (..))+import Data.ProtoLens.TextFormat (showMessage)+import Data.Time.LocalTime (getZonedTime)+import Data.UUID (UUID)+import Network.GRPC.Client.Helpers (GrpcClient (..))+import Network.GRPC.HTTP2.Encoding (Compression (..))+import Utxorpc.Client (ReplyLogger, RequestLogger, ServerStreamEndLogger, ServerStreamLogger, UtxorpcClientLogger (..))++-- Prints simple, human-readable messages+simpleLogger :: UtxorpcClientLogger IO+simpleLogger =+ UtxorpcClientLogger+ simpleRequestLogger+ simpleReplyLogger+ simpleServerStreamLogger+ simpleServerStreamEndLogger+ id++simpleRequestLogger :: RequestLogger IO+simpleRequestLogger rpcPath client uuid req = do+ footer <- printPreamble "REQUEST" rpcPath client uuid+ unless (null $ _grpcClientHeaders client) $+ putStrLn $+ showHdrs "Headers" (_grpcClientHeaders client)+ putStrLn $ "Compression: " ++ BS.unpack (_compressionName (_grpcClientCompression client))+ putStrLn $ "Message:\n" ++ indent 1 (showMessage req)+ putStrLn footer++simpleReplyLogger :: ReplyLogger IO+simpleReplyLogger rpcPath client uuid reply = do+ footer <- printPreamble "REPLY" rpcPath client uuid+ case reply of+ Left _clientErr -> putStrLn "Error: Early end of Stream!"+ Right (Left _tmc) -> putStrLn "Error: Too much concurrency!"+ Right (Right (Left errCode)) -> putStrLn $ "Error code: " ++ show errCode+ Right (Right (Right (hdrs, trailers, Left errMsg))) -> do+ putStr $ showHdrTrailers hdrs trailers+ putStrLn $ "Error: " ++ errMsg+ Right (Right (Right (hdrs, trailers, Right o))) -> do+ putStr $ showHdrTrailers hdrs trailers+ putStrLn $ "Message:\n" ++ indent 1 (showMessage o)+ putStrLn footer++simpleServerStreamLogger :: ServerStreamLogger IO+simpleServerStreamLogger rpcPath client (uuid, index) o = do+ footer <- printPreamble "STREAM DATA" rpcPath client uuid+ putStrLn $ "Message (#" ++ show index ++ "):"+ putStrLn $ indent 1 (showMessage o)+ putStrLn footer++simpleServerStreamEndLogger :: ServerStreamEndLogger IO+simpleServerStreamEndLogger rpcPath client (uuid, numMessages) (hdrs, trailers) = do+ footer <- printPreamble "STREAM DATA" rpcPath client uuid+ putStrLn $ showHdrTrailers' hdrs trailers+ putStrLn $ "Server stream ended after " ++ show numMessages ++ " messages."+ putStrLn footer++printPreamble :: String -> BS.ByteString -> GrpcClient -> UUID -> IO String+printPreamble eventName rpcPath client uuid = do+ (header, footer) <- headerFooter eventName+ putStrLn header+ putStrLn $ "UUID: " ++ show uuid+ putStrLn $ "Path: " ++ BS.unpack rpcPath+ putStrLn $ "Authority: " ++ show (_grpcClientAuthority client)+ return footer++headerFooter :: String -> IO (String, String)+headerFooter eventName = do+ zoned <- getZonedTime+ return (header zoned, footer)+ where+ header zoned = replicate lPadding c ++ " " ++ hdrText ++ " " ++ replicate rPadding c+ where+ hdrText = eventName ++ ": " ++ show zoned+ lPadding = diff `div` 2+ rPadding = diff `div` 2 + (diff `mod` 2)+ diff = w - 2 - length hdrText++ footer = replicate w c++ w = 75+ c = '-'++showHdrTrailers :: [(CI BS.ByteString, BS.ByteString)] -> Maybe [(CI BS.ByteString, BS.ByteString)] -> String+showHdrTrailers hdrs trailers =+ showCIHdrs "Headers" hdrs+ ++ maybe "" (showCIHdrs "Trailers") trailers++showHdrTrailers' :: [(BS.ByteString, BS.ByteString)] -> [(BS.ByteString, BS.ByteString)] -> String+showHdrTrailers' hdrs trailers =+ showHdrs "Headers" hdrs+ ++ showHdrs "Trailers" trailers++showHdrs :: String -> [(BS.ByteString, BS.ByteString)] -> String+showHdrs name hdrs =+ name+ ++ ":\n"+ ++ (if not (null hdrs) then indent 1 . unlines $ map showHdr hdrs else "")+ where+ showHdr (k, v) = BS.unpack k ++ ": " ++ BS.unpack v++showCIHdrs :: String -> [(CI BS.ByteString, BS.ByteString)] -> String+showCIHdrs name hdrs = showHdrs name $ map (over _1 original) hdrs++indent :: Int -> String -> String+indent n = unlines . map (replicate n '\t' ++) . lines
+ quick-start/Main.hs view
@@ -0,0 +1,35 @@+module Main (main) where++import Control.Exception (throwIO)+import Control.Lens.Operators ((&), (.~))+import qualified Data.ByteString.Char8 as BS+import Data.ProtoLens (Message (..))+import Proto.Utxorpc.V1alpha.Sync.Sync_Fields (hash, index, ref)+import UnliftIO.Exception (throwString)+import Utxorpc.Client (simpleUtxorpcClient)+import Utxorpc.Types (fetchBlock, syncClient)++main :: IO ()+main = do+ -- Connect to a UTxO RPC service+ eClient <- simpleUtxorpcClient "hostname" 443 True+ case eClient of+ Left clientErr -> throwIO clientErr+ Right client -> do+ -- Make a unary request+ result <- fetchBlock (syncClient client) fetchBlockRequest+ case result of+ -- Handle success+ Right (Right (Right (_headers, _trailers, fetchBlockResponse))) ->+ print fetchBlockResponse+ err -> throwString $ show err+ where+ fetchBlockRequest =+ defMessage+ & ref+ .~ [ defMessage+ & index .~ 40608434+ & hash+ .~ BS.pack+ "3e4947072df1ed22a0518cb717c2904ebf0952b0c33292b402fae25d9562022e"+ ]
+ src/Utxorpc/Client.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module : Utxorpc.Client+-- Description : Create a connected UTxO RPC client.+-- Create a UTxO RPC client connected to a UTxO RPC service. The @'UtxorpcClient'@ provides functions for each of the methods in the UTxO RPC specification.+-- Provide a UtxorpcClientLogger to perform automated logging.+module Utxorpc.Client+ ( UtxorpcInfo (..),+ utxorpcClient,+ simpleUtxorpcClient,+ utxorpcClientWith,+ UtxorpcClientLogger (..),+ RequestLogger,+ ReplyLogger,+ ServerStreamLogger,+ ServerStreamEndLogger,+ )+where++import qualified Data.ByteString.Char8 as BS+import Network.GRPC.Client (gzip, uncompressed)+import Network.GRPC.Client.Helpers+ ( GrpcClient (_grpcClientHeaders),+ GrpcClientConfig,+ UseTlsOrNot,+ close,+ grpcClientConfigSimple,+ setupGrpcClient,+ _grpcClientConfigCompression,+ )+import Network.GRPC.HTTP2.ProtoLens (RPC (RPC))+import Proto.Utxorpc.V1alpha.Build.Build+import Proto.Utxorpc.V1alpha.Submit.Submit+import Proto.Utxorpc.V1alpha.Sync.Sync+import Proto.Utxorpc.V1alpha.Watch.Watch+import Utxorpc.Logged (ReplyLogger, RequestLogger, ServerStreamEndLogger, ServerStreamLogger, UtxorpcClientLogger (..), loggedSStream, loggedUnary)+import Utxorpc.Types+import "http2-client" Network.HTTP2.Client (ClientError, HostName, PortNumber, runClientIO)++-- | Configuration info for a UTxO RPC Client.+-- For more fine-grained control, use @'GrpcClientConfig'@ and @'UtxorpcClientWith'@+data UtxorpcInfo m = UtxorpcInfo+ { -- | Host name of the service.+ _hostName :: HostName,+ -- | Port number of the service.+ _portNumber :: PortNumber,+ -- | Whether or not to use TLS.+ _tlsEnabled :: UseTlsOrNot,+ -- | Whether or not to use gzip compression.+ _useGzip :: Bool,+ -- | Headers to include in each request (e.g., API key/authorization).+ _clientHeaders :: [(BS.ByteString, BS.ByteString)],+ -- | Log all RPC events.+ _logger :: Maybe (UtxorpcClientLogger m)+ }++-- | Make a connection to a UTxO RPC service with the minimum required information.+-- No compression is used, no headers are added, and no logging is performed.+-- For more configurability, use @'utxorpcClient'@ or @'utxorpcClientWith'@.+simpleUtxorpcClient ::+ -- | Host name of the service.+ HostName ->+ -- | Port number of the service.+ PortNumber ->+ -- | Whether or not to use TLS.+ UseTlsOrNot ->+ IO (Either ClientError UtxorpcClient)+simpleUtxorpcClient host port tlsEnabled =+ utxorpcClient $+ UtxorpcInfo host port tlsEnabled False [] Nothing++-- | Connect to a UTxO RPC service from a @'UtxorpcInfo'@.+-- Provides more configurability than @'simpleUtxorpcClient'@ but less than @'utxorpcClientWith'@.+utxorpcClient :: UtxorpcInfo m -> IO (Either ClientError UtxorpcClient)+utxorpcClient+ UtxorpcInfo {_hostName, _portNumber, _tlsEnabled, _useGzip, _logger, _clientHeaders} = do+ eClient <- grpcClient _hostName _portNumber _tlsEnabled _useGzip+ return $ fromGrpc _logger . withHeaders _clientHeaders <$> eClient+ where+ withHeaders hdrs client =+ let oldHdrs = _grpcClientHeaders client+ in client {_grpcClientHeaders = oldHdrs ++ hdrs}++-- | Connect to a UTxO RPC from a @'GrpcClientConfig'@.+-- For a simpler interface with less configurability, use @'utxorpcClient'@ or @'simpleUtxorpcClient'@.+utxorpcClientWith ::+ GrpcClientConfig ->+ Maybe (UtxorpcClientLogger m) ->+ IO (Either ClientError UtxorpcClient)+utxorpcClientWith config logger = do+ eClient <- runClientIO $ setupGrpcClient config+ return $ fromGrpc logger <$> eClient++grpcClient ::+ HostName ->+ PortNumber ->+ UseTlsOrNot ->+ Bool ->+ IO (Either ClientError GrpcClient)+grpcClient host port tlsEnabled doCompress = runClientIO $ do+ setupGrpcClient+ ( (grpcClientConfigSimple host port tlsEnabled)+ { _grpcClientConfigCompression = compression+ }+ )+ where+ compression = if doCompress then gzip else uncompressed++fromGrpc :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> UtxorpcClient+fromGrpc logger client =+ UtxorpcClient+ (buildClientImpl logger client)+ (submitClientImpl logger client)+ (syncClientImpl logger client)+ (watchClientImpl logger client)+ (runClientIO $ Network.GRPC.Client.Helpers.close client)++{--------------------------------------+ BUILD+--------------------------------------}++buildClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> BuildClientImpl+buildClientImpl logger client =+ BuildClientImpl+ (loggedUnary logger getChainTipRPC client)+ (loggedUnary logger getChainParamRPC client)+ (loggedUnary logger getUtxoByAddressRPC client)+ (loggedUnary logger getUtxoByRefRPC client)+ (loggedSStream logger holdUtxoRPC client)++getChainTipRPC :: RPC LedgerStateService "getChainTip"+getChainTipRPC = RPC++getChainParamRPC :: RPC LedgerStateService "getChainParam"+getChainParamRPC = RPC++getUtxoByAddressRPC :: RPC LedgerStateService "getUtxoByAddress"+getUtxoByAddressRPC = RPC++getUtxoByRefRPC :: RPC LedgerStateService "getUtxoByRef"+getUtxoByRefRPC = RPC++holdUtxoRPC :: RPC LedgerStateService "holdUtxo"+holdUtxoRPC = RPC++{--------------------------------------+ SUBMIT+--------------------------------------}++submitClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> SubmitClientImpl+submitClientImpl logger client =+ SubmitClientImpl+ (loggedUnary logger submitTxRPC client)+ (loggedUnary logger readMempoolRPC client)+ (loggedSStream logger waitForTxRPC client)+ (loggedSStream logger watchMempoolRPC client)++submitTxRPC :: RPC SubmitService "submitTx"+submitTxRPC = RPC++readMempoolRPC :: RPC SubmitService "readMempool"+readMempoolRPC = RPC++waitForTxRPC :: RPC SubmitService "waitForTx"+waitForTxRPC = RPC++watchMempoolRPC :: RPC SubmitService "watchMempool"+watchMempoolRPC = RPC++{--------------------------------------+ SYNC+--------------------------------------}++syncClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> SyncClientImpl+syncClientImpl logger client =+ SyncClientImpl+ (loggedUnary logger fetchBlockRPC client)+ (loggedUnary logger dumpHistoryRPC client)+ (loggedSStream logger followTipRPC client)++fetchBlockRPC :: RPC ChainSyncService "fetchBlock"+fetchBlockRPC = RPC++dumpHistoryRPC :: RPC ChainSyncService "dumpHistory"+dumpHistoryRPC = RPC++followTipRPC :: RPC ChainSyncService "followTip"+followTipRPC = RPC++{--------------------------------------+ WATCH+--------------------------------------}++watchClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> WatchClientImpl+watchClientImpl logger client =+ WatchClientImpl $ loggedSStream logger watchTxRPC client++watchTxRPC :: RPC WatchService "watchTx"+watchTxRPC = RPC
+ src/Utxorpc/Logged.hs view
@@ -0,0 +1,225 @@+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}++module Utxorpc.Logged+ ( UtxorpcClientLogger (..),+ RequestLogger,+ ReplyLogger,+ ServerStreamLogger,+ ServerStreamEndLogger,+ loggedSStream,+ loggedSStream',+ loggedUnary,+ loggedUnary',+ UnaryExecutor,+ ServerStreamExecutor,+ )+where++import Control.Monad.IO.Class (liftIO)+import qualified Data.ByteString.Char8 as BS+import Data.ProtoLens (Message)+import Data.UUID (UUID)+import Data.UUID.V4 (nextRandom)+import Network.GRPC.Client (HeaderList, RawReply)+import Network.GRPC.Client.Helpers (GrpcClient (..), rawStreamServer, rawUnary)+import Network.GRPC.HTTP2.Encoding (GRPCInput, GRPCOutput)+import Network.GRPC.HTTP2.Types (IsRPC (..))+import Network.HTTP2.Client.Exceptions (ClientIO)+import Utxorpc.Types (ServerStreamReply, UnaryReply)+import "http2-client" Network.HTTP2.Client (ClientError, TooMuchConcurrency, runClientIO)++{--------------------------------------+ Types+--------------------------------------}++-- | Logging functions to log requests, replies, server stream messages, and server stream endings.+-- A UUID is generated for each request and passed downstream to the other logging functions.+data UtxorpcClientLogger m = UtxorpcClientLogger+ { -- | Log outgoing requests.+ requestLogger :: RequestLogger m,+ -- | Log incoming unary replies.+ replyLogger :: ReplyLogger m,+ -- | Log incoming server stream messages.+ serverStreamLogger :: ServerStreamLogger m,+ -- | Log the end of a server stream.+ serverStreamEndLogger :: ServerStreamEndLogger m,+ -- | Provided here as a convenience to allow logging functions to be written in any monadic stack+ -- without having to apply the unlift function to each logging function individually.+ unlift :: forall x. m x -> IO x+ }++-- | Log outgoing requests of all types (i.e., unary requests and server stream requests).+type RequestLogger m =+ forall i.+ (Show i, Message i) =>+ -- | The RPC path+ BS.ByteString ->+ -- | Included because it contains useful information such as the server address.+ GrpcClient ->+ -- | Generated for this request, and passed to other logging functions for other RPC events generated by this request.+ -- E.g., A unary request and its reply both have the same UUID.+ UUID ->+ -- | The request message being sent.+ i ->+ m ()++-- | Log unary replies.+type ReplyLogger m =+ forall o.+ (Show o, Message o) =>+ -- | The RPC path+ BS.ByteString ->+ -- | Included because it contains useful information such as the server address.+ GrpcClient ->+ -- | Generated for the request that this reply is associated with.+ UUID ->+ -- | Message received from the service (with headers) or an error.+ Either ClientError (Either TooMuchConcurrency (RawReply o)) ->+ m ()++-- | Log server stream messages.+type ServerStreamLogger m =+ forall o.+ (Show o, Message o) =>+ -- | The RPC path+ BS.ByteString ->+ -- | Included because it contains useful information such as the server address.+ GrpcClient ->+ -- | The UUID was generated for the request that caused this reply,+ -- the Int is the index of this message in the stream.+ (UUID, Int) ->+ -- | Message received from the service.+ o ->+ m ()++-- The GrcpClient is included because it contains useful information such as the server address.+-- The UUID was generated for the request that this reply is associated with.+type ServerStreamEndLogger m =+ -- | The RPC path+ BS.ByteString ->+ -- | Included because it contains useful information such as the server address.+ GrpcClient ->+ -- | The UUID was generated for the request that caused this reply,+ -- the Int is the total number of messages received in the stream.+ (UUID, Int) ->+ -- | Headers and Trailers.+ (HeaderList, HeaderList) ->+ m ()++-- | The type of http-client-grpc's `rawUnary`. Used internally and in tests.+type UnaryExecutor r i o =+ -- | The RPC to call.+ r ->+ -- | An initialized client.+ GrpcClient ->+ -- | The input.+ i ->+ ClientIO (Either TooMuchConcurrency (RawReply o))++-- | The type of http2-client-grpc's `rawStreamServer`. Used internally and in tests.+type ServerStreamExecutor r i o =+ forall a.+ -- | The RPC to call.+ r ->+ -- | An initialized client.+ GrpcClient ->+ -- | An initial state.+ a ->+ -- | The input of the stream request.+ i ->+ -- | A state-passing handler called for each server-sent output.+ -- Headers are repeated for convenience but are the same for every iteration.+ (a -> HeaderList -> o -> ClientIO a) ->+ ClientIO (Either TooMuchConcurrency (a, HeaderList, HeaderList))++{--------------------------------------+ Logged wrappers of gRPC library functions+--------------------------------------}++loggedUnary ::+ (GRPCInput r i, GRPCOutput r o, Show i, Message i, Show o, Message o) =>+ Maybe (UtxorpcClientLogger m) ->+ r ->+ GrpcClient ->+ i ->+ UnaryReply o+loggedUnary = loggedUnary' rawUnary++loggedUnary' ::+ (GRPCInput r i, Show i, Message i, Show o, Message o) =>+ UnaryExecutor r i o ->+ Maybe (UtxorpcClientLogger m) ->+ r ->+ GrpcClient ->+ i ->+ UnaryReply o+loggedUnary' sendUnary logger rpc client msg =+ maybe (runClientIO $ sendUnary rpc client msg) logged logger+ where+ logged UtxorpcClientLogger {requestLogger, replyLogger, unlift} = do+ uuid <- nextRandom+ unlift $ requestLogger (path rpc) client uuid msg+ o <- runClientIO $ sendUnary rpc client msg+ unlift $ replyLogger (path rpc) client uuid o+ return o++-- The gRPC library requires a handler that produces a `ClientIO`,+-- but this does not make sense since a user-provided handler is not+-- likely to generate a `ClientError` or `TooMuchConcurrency`.+-- Instead, we accept a handler of type `IO` and lift it.+loggedSStream ::+ (GRPCOutput r o, GRPCInput r i, Show i, Message i, Show o, Message o) =>+ Maybe (UtxorpcClientLogger m) ->+ r ->+ GrpcClient ->+ a ->+ i ->+ (a -> HeaderList -> o -> IO a) ->+ ServerStreamReply a+loggedSStream = loggedSStream' rawStreamServer++loggedSStream' ::+ (GRPCOutput r o, Show i, Message i, Show o, Message o) =>+ ServerStreamExecutor r i o ->+ Maybe (UtxorpcClientLogger m) ->+ r ->+ GrpcClient ->+ a ->+ i ->+ (a -> HeaderList -> o -> IO a) ->+ ServerStreamReply a+loggedSStream' sendStreamReq logger r client initStreamState req chunkHandler =+ maybe+ (runClientIO $ sendStreamReq r client initStreamState req liftedChunkHandler)+ logged+ logger+ where+ liftedChunkHandler streamState headerList reply = liftIO $ chunkHandler streamState headerList reply++ logged+ UtxorpcClientLogger {requestLogger, serverStreamLogger, serverStreamEndLogger, unlift} = do+ uuid <- nextRandom+ unlift $ requestLogger rpcPath client uuid req+ streamResult <- runLoggedStream uuid+ handleStreamResult streamResult+ where+ runLoggedStream uuid =+ runClientIO $+ sendStreamReq r client (initStreamState, uuid, 0) req loggedChunkHandler++ loggedChunkHandler (streamState, uuid, index) headerList msg = do+ liftIO . unlift $ serverStreamLogger rpcPath client (uuid, index) msg+ a <- liftIO $ chunkHandler streamState headerList msg+ return (a, uuid, index + 1)++ handleStreamResult streamResult =+ case streamResult of+ Right (Right ((finalStreamState, uuid, index), hl, hl')) -> do+ liftIO . unlift $ serverStreamEndLogger rpcPath client (uuid, index) (hl, hl')+ return $ Right $ Right (finalStreamState, hl, hl')+ Right (Left tmc) -> return $ Right $ Left tmc+ Left errCode -> return $ Left errCode++ rpcPath = path r
+ src/Utxorpc/Types.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}++-- |+-- Module : Utxorpc.Types+-- Description : Record types and type aliases.+-- The types in this module are required to call methods of a `UtxorpcClient`.+module Utxorpc.Types+ ( UtxorpcClient (..),+ BuildClientImpl (..),+ SubmitClientImpl (..),+ SyncClientImpl (..),+ WatchClientImpl (..),+ ServerStreamCall,+ ServerStreamReply,+ UnaryReply,+ )+where++import Network.GRPC.Client (HeaderList, RawReply)+import Proto.Utxorpc.V1alpha.Build.Build+import Proto.Utxorpc.V1alpha.Submit.Submit+import Proto.Utxorpc.V1alpha.Sync.Sync+import Proto.Utxorpc.V1alpha.Watch.Watch+import "http2-client" Network.HTTP2.Client (ClientError, TooMuchConcurrency)++-- | Type definition for functions that make calls to server stream methods.+-- Note that the stream state, a, can be different for each call.+type ServerStreamCall i o =+ forall a.+ -- | The initial state for the stream processing function.+ a ->+ -- | The request message to send to the service.+ i ->+ -- | The stream processing function. It is a fold over some state a with stream messages o.+ (a -> HeaderList -> o -> IO a) ->+ -- | The final state of the stream processing function, or an error.+ ServerStreamReply a++-- | The type returned by calls to unary service methods.+type UnaryReply o =+ IO+ (Either ClientError (Either TooMuchConcurrency (RawReply o)))++-- | The type returned by calls to server stream methods. a is the final state of the stream processing function.+type ServerStreamReply a =+ IO+ (Either ClientError (Either TooMuchConcurrency (a, HeaderList, HeaderList)))++{---------------------------------------+ UtxorpcClient+---------------------------------------}++-- | Methods for each module in UTxO RPC.+-- >>> fetchBlock (buildClient client) defMessage+data UtxorpcClient = UtxorpcClient+ { -- | Build module service methods.+ buildClient :: BuildClientImpl,+ -- | Submit module service methods.+ submitClient :: SubmitClientImpl,+ -- | Sync module service methods.+ syncClient :: SyncClientImpl,+ -- | Watch module service methods.+ watchClient :: WatchClientImpl,+ -- | Closes the gRPC connection.+ close :: IO (Either ClientError ())+ }++{---------------------------------------+ Build+---------------------------------------}++-- | Methods of the Build module+data BuildClientImpl = BuildClientImpl+ { getChainTip :: GetChainTipRequest -> UnaryReply GetChainTipResponse,+ getChainParam :: GetChainParamRequest -> UnaryReply GetChainParamResponse,+ getUtxoByAddress :: GetUtxoByAddressRequest -> UnaryReply GetUtxoByAddressResponse,+ getUtxoByRef :: GetUtxoByRefRequest -> UnaryReply GetUtxoByRefResponse,+ holdUtxo :: ServerStreamCall HoldUtxoRequest HoldUtxoResponse+ }++{---------------------------------------+ Submit+---------------------------------------}++-- | Methods of the Submit module+data SubmitClientImpl = SubmitClientImpl+ { submitTx :: SubmitTxRequest -> UnaryReply SubmitTxResponse,+ readMempool :: ReadMempoolRequest -> UnaryReply ReadMempoolResponse,+ waitForTx :: ServerStreamCall WaitForTxRequest WaitForTxResponse,+ watchMempool :: ServerStreamCall WatchMempoolRequest WatchMempoolResponse+ }++{---------------------------------------+ Sync+---------------------------------------}++-- | Methods of the Sync module+data SyncClientImpl = SyncClientImpl+ { fetchBlock :: FetchBlockRequest -> UnaryReply FetchBlockResponse,+ dumpHistory :: DumpHistoryRequest -> UnaryReply DumpHistoryResponse,+ followTip :: ServerStreamCall FollowTipRequest FollowTipResponse+ }++{---------------------------------------+ Watch+---------------------------------------}++-- | Methods of the watch module+newtype WatchClientImpl = WatchClientImpl+ { watchTx :: ServerStreamCall WatchTxRequest WatchTxResponse+ }
+ test/logged_test.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE RankNTypes #-}++module Main (main) where++import Control.Monad (foldM)+import Data.IORef (newIORef, readIORef, writeIORef)+import Data.List (foldl')+import Data.ProtoLens.Message (defMessage)+import Network.GRPC.Client (HeaderList, RawReply)+import Network.GRPC.HTTP2.ProtoLens (RPC (RPC))+import Proto.Utxorpc.V1alpha.Sync.Sync+import Test.Hspec+import Utxorpc.Logged+import "http2-client" Network.HTTP2.Client (ClientError, TooMuchConcurrency)++type UnaryReq = FetchBlockRequest++unaryReq :: UnaryReq+unaryReq = defMessage++type UnaryReply = FetchBlockResponse++type UnaryRpc = RPC ChainSyncService "fetchBlock"++unaryRpc :: UnaryRpc+unaryRpc = RPC++type StreamReq = FollowTipRequest++streamReq :: StreamReq+streamReq = defMessage++type StreamReply = FollowTipResponse++streamReplies :: Int -> [StreamReply]+streamReplies n = replicate n defMessage++type StreamRpc = RPC ChainSyncService "followTip"++streamRpc :: StreamRpc+streamRpc = RPC++mockLogger :: (String -> IO ()) -> UtxorpcClientLogger IO+mockLogger f =+ UtxorpcClientLogger+ (mockRequestLogger f)+ (mockReplyLogger f)+ (mockStreamLogger f)+ (mockStreamEndLogger f)+ id++showIndex :: Int -> String+showIndex i = " (" ++ show i ++ ")"++mockRequestLogger :: (String -> IO ()) -> RequestLogger IO+mockRequestLogger f _ _ _ msg = f $ requestLoggerOut msg++requestLoggerOut :: (Show a) => a -> String+requestLoggerOut msg = "REQUEST_LOGGER" ++ show msg++mockReplyLogger :: (String -> IO ()) -> ReplyLogger IO+mockReplyLogger f _ _ _ msg = f $ replyLoggerOut msg++replyLoggerOut ::+ (Show a) =>+ Either ClientError (Either TooMuchConcurrency (RawReply a)) ->+ String+replyLoggerOut (Right (Right (Right (_, _, Right msg)))) = "REPLY_LOGGER" ++ show msg+replyLoggerOut _ = "REPLY_LOGGER: error"++mockStreamLogger :: (String -> IO ()) -> ServerStreamLogger IO+mockStreamLogger f _ _ (_, index) msg = f $ streamLoggerOut index msg++streamLoggerOut :: (Show a) => Int -> a -> String+streamLoggerOut index msg = "STREAM_LOGGER" ++ showIndex index ++ show msg++mockStreamEndLogger :: (String -> IO ()) -> ServerStreamEndLogger IO+mockStreamEndLogger f _ _ (_, index) _ = f $ streamEndLoggerOut index++streamEndLoggerOut :: Int -> String+streamEndLoggerOut index = "STREAM_END_LOGGER" ++ showIndex index++mockUnaryExecutor :: UnaryExecutor r i UnaryReply+mockUnaryExecutor _ _ _ = return $ Right $ Right ([], Nothing, Right defMessage)++mockServerStreamExecutor :: Int -> ServerStreamExecutor r i StreamReply+mockServerStreamExecutor n _ _ initStreamState _ inStream = do+ finalStreamState <- foldM run initStreamState $ streamReplies n+ return $ Right (finalStreamState, [], [])+ where+ run state = inStream state []++mockInStream :: (String -> IO ()) -> Int -> HeaderList -> StreamReply -> IO Int+mockInStream logF index _ msg = do+ logF $ inStreamOut index msg+ return $ index + 1++inStreamOut :: (Show o) => Int -> o -> String+inStreamOut index msg = "IN_STREAM_OUT" ++ showIndex index ++ show msg++testUnary :: IO ()+testUnary = do+ out <- newIORef ""+ let logF str = writeIORef out . (++ str ++ "\n") =<< readIORef out+ _reply <-+ loggedUnary'+ mockUnaryExecutor+ (Just $ mockLogger logF)+ unaryRpc+ undefined+ unaryReq+ out' <- readIORef out++ hspec $ describe "Unary Logging" $ do+ it "should log the request" $ do+ head (lines out') `shouldBe` requestLoggerOut unaryReq+ it "should log the reply" $ do+ tail (lines out')+ `shouldBe` [ replyLoggerOut $+ Right (Right (Right ([], Nothing, Right (defMessage :: UnaryReply))))+ ]++testStream :: IO ()+testStream = do+ out <- newIORef ""+ let logF str = writeIORef out . (++ str ++ "\n") =<< readIORef out+ let numStreamMsgs = 3++ _finalStreamState <-+ loggedSStream'+ (mockServerStreamExecutor numStreamMsgs)+ (Just $ mockLogger logF)+ streamRpc+ undefined+ 0+ streamReq+ (mockInStream logF)+ out' <- readIORef out++ hspec $ describe "Stream logging" $ do+ it "should log the request" $ do+ head (lines out') `shouldBe` requestLoggerOut streamReq+ it "should log the stream" $ do+ let msgsWithIndex = zip [0 .. numStreamMsgs] (streamReplies numStreamMsgs)+ let targetStreamLogs (index, msg) = [streamLoggerOut index msg, inStreamOut index msg]+ let f logs (index, msg) = logs ++ targetStreamLogs (index, msg)+ init (tail (lines out'))+ `shouldBe` foldl' f [] msgsWithIndex+ it "should log the end of the stream" $ do+ last (lines out') `shouldBe` streamEndLoggerOut numStreamMsgs++main :: IO ()+main = do+ testUnary+ testStream
+ utxorpc-client.cabal view
@@ -0,0 +1,150 @@+cabal-version: 3.0++name: utxorpc-client+version: 0.0.1.0+synopsis: An SDK for clients of the UTxO RPC specification.+description: This SDK includes helper functions for creating a UTxO gRPC client, calling UTxO RPC methods, and logging every interaction.+category: Network, Blockchain, Cardano+homepage: https://github.com/utxorpc/utxorpc-client#readme+bug-reports: https://github.com/utxorpc/utxorpc-client/issues+author: Dominic Mayhew+maintainer: dominic.j.mayhew@gmail.com+license: Apache-2.0+license-file: LICENSE+build-type: Simple+extra-source-files: README.md++source-repository head+ type: git+ location: https://github.com/utxorpc/haskell-sdk++library+ exposed-modules:+ Utxorpc.Client+ Utxorpc.Types+ other-modules:+ Utxorpc.Logged+ hs-source-dirs:+ src+ ghc-options:+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-export-lists+ -Wmissing-home-modules+ -Wpartial-fields+ -Wredundant-constraints+ -Wunused-packages+ build-depends:+ base >=4.7 && <5+ , bytestring < 0.13+ , http2-client >= 0.10.0.1 && < 0.11+ , http2-client-grpc < 0.9+ , http2-grpc-proto-lens < 0.2+ , http2-grpc-types < 0.6+ , proto-lens < 0.8+ , utxorpc >= 0.0.3 && < 0.1+ , uuid < 1.4+ default-language: Haskell2010++executable client-example+ main-is:+ Main.hs+ other-modules:+ SimpleLogger+ KatipLogger+ hs-source-dirs:+ example+ ghc-options:+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-export-lists+ -Wmissing-home-modules+ -Wpartial-fields+ -Wredundant-constraints+ -Wunused-packages+ build-depends:+ aeson < 2.3+ , base >=4.7 && <5+ , bytestring < 0.13+ , case-insensitive < 1.3+ , katip < 0.9+ , http2 < 5.2+ , http2-client >= 0.10.0.1 && < 11+ , http2-client-grpc < 0.9+ , http2-grpc-types < 0.6+ , lens < 5.3+ , proto-lens < 0.8+ , safe < 0.4+ , time < 1.13+ , transformers < 0.7+ , unliftio < 0.3+ , utxorpc-client+ , uuid < 1.4+ default-language: Haskell2010++executable client-quick-start+ main-is:+ Main.hs+ hs-source-dirs:+ quick-start+ ghc-options:+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-export-lists+ -Wmissing-home-modules+ -Wpartial-fields+ -Wredundant-constraints+ -Wunused-packages+ build-depends:+ , base >=4.7 && <5+ , bytestring < 0.13+ , lens < 5.3+ , proto-lens < 0.8+ , unliftio < 0.3+ , utxorpc >= 0.0.3.0 && < 0.1+ , utxorpc-client+ default-language: Haskell2010++test-suite logged_test_client+ type:+ exitcode-stdio-1.0+ main-is:+ logged_test.hs+ other-modules:+ Utxorpc.Logged+ Utxorpc.Types+ hs-source-dirs:+ test+ src+ ghc-options:+ -Wall+ -Wcompat+ -Widentities+ -Wincomplete-record-updates+ -Wincomplete-uni-patterns+ -Wmissing-export-lists+ -Wmissing-home-modules+ -Wpartial-fields+ -Wredundant-constraints+ -Wunused-packages+ build-depends:+ base >=4.7 && <5+ , bytestring < 0.13+ , http2-client >= 0.10.0.1 && < 11+ , http2-client-grpc < 0.9+ , http2-grpc-proto-lens < 0.2+ , http2-grpc-types >= 0.5.0.0 && < 0.6+ , hspec >= 2.11.7 && < 2.12+ , proto-lens < 0.8+ , utxorpc >= 0.0.3.0 && < 0.1+ , uuid < 1.4+ default-language: Haskell2010