opentracing-jaeger (empty) → 0.1.0.0
raw patch · 16 files changed
+1897/−0 lines, 16 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, exceptions, hashable, http-client, http-types, lens, mtl, network, opentracing, safe-exceptions, text, thrift, unordered-containers, vector
Files
- CHANGELOG.md +3/−0
- LICENSE +202/−0
- README.md +0/−0
- gen-src/Agent.hs +190/−0
- gen-src/Agent_Client.hs +61/−0
- gen-src/Agent_Iface.hs +48/−0
- gen-src/Agent_Types.hs +43/−0
- gen-src/Jaeger_Consts.hs +41/−0
- gen-src/Jaeger_Types.hs +434/−0
- gen-src/Zipkincore_Types.hs +325/−0
- opentracing-jaeger.cabal +64/−0
- src/OpenTracing/Jaeger.hs +10/−0
- src/OpenTracing/Jaeger/AgentReporter.hs +137/−0
- src/OpenTracing/Jaeger/CollectorReporter.hs +131/−0
- src/OpenTracing/Jaeger/Propagation.hs +70/−0
- src/OpenTracing/Jaeger/Thrift.hs +138/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+* 0.1.0.0 (2012-04-20)++After years of friendly reminders, a zero version gets finally released =]
+ LICENSE view
@@ -0,0 +1,202 @@++ 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
+ gen-src/Agent.hs view
@@ -0,0 +1,190 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.11.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Agent where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Jaeger_Types+import qualified Zipkincore_Types+++import Agent_Types+import qualified Agent_Iface as Iface+-- HELPER FUNCTIONS AND STRUCTURES --++data EmitZipkinBatch_args = EmitZipkinBatch_args { emitZipkinBatch_args_spans :: (Vector.Vector Zipkincore_Types.Span)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable EmitZipkinBatch_args where+ hashWithSalt salt record = salt `H.hashWithSalt` emitZipkinBatch_args_spans record +instance QC.Arbitrary EmitZipkinBatch_args where + arbitrary = M.liftM EmitZipkinBatch_args (QC.arbitrary)+ shrink obj | obj == default_EmitZipkinBatch_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_EmitZipkinBatch_args{emitZipkinBatch_args_spans = emitZipkinBatch_args_spans obj} then P.Nothing else P.Just $ default_EmitZipkinBatch_args{emitZipkinBatch_args_spans = emitZipkinBatch_args_spans obj}+ ]+from_EmitZipkinBatch_args :: EmitZipkinBatch_args -> T.ThriftVal+from_EmitZipkinBatch_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v2 -> P.Just (1, ("spans",T.TList (T.T_STRUCT Zipkincore_Types.typemap_Span) $ P.map (\_v4 -> Zipkincore_Types.from_Span _v4) $ Vector.toList _v2))) $ emitZipkinBatch_args_spans record+ ]+write_EmitZipkinBatch_args :: T.Protocol p => p -> EmitZipkinBatch_args -> P.IO ()+write_EmitZipkinBatch_args oprot record = T.writeVal oprot $ from_EmitZipkinBatch_args record+encode_EmitZipkinBatch_args :: T.StatelessProtocol p => p -> EmitZipkinBatch_args -> LBS.ByteString+encode_EmitZipkinBatch_args oprot record = T.serializeVal oprot $ from_EmitZipkinBatch_args record+to_EmitZipkinBatch_args :: T.ThriftVal -> EmitZipkinBatch_args+to_EmitZipkinBatch_args (T.TStruct fields) = EmitZipkinBatch_args{+ emitZipkinBatch_args_spans = P.maybe (emitZipkinBatch_args_spans default_EmitZipkinBatch_args) (\(_,_val6) -> (case _val6 of {T.TList _ _val7 -> (Vector.fromList $ P.map (\_v8 -> (case _v8 of {T.TStruct _val9 -> (Zipkincore_Types.to_Span (T.TStruct _val9)); _ -> P.error "wrong type"})) _val7); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_EmitZipkinBatch_args _ = P.error "not a struct"+read_EmitZipkinBatch_args :: T.Protocol p => p -> P.IO EmitZipkinBatch_args+read_EmitZipkinBatch_args iprot = to_EmitZipkinBatch_args <$> T.readVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_args)+decode_EmitZipkinBatch_args :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitZipkinBatch_args+decode_EmitZipkinBatch_args iprot bs = to_EmitZipkinBatch_args $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_args) bs+typemap_EmitZipkinBatch_args :: T.TypeMap+typemap_EmitZipkinBatch_args = Map.fromList [(1,("spans",(T.T_LIST (T.T_STRUCT Zipkincore_Types.typemap_Span))))]+default_EmitZipkinBatch_args :: EmitZipkinBatch_args+default_EmitZipkinBatch_args = EmitZipkinBatch_args{+ emitZipkinBatch_args_spans = Vector.empty}+data EmitZipkinBatch_result = EmitZipkinBatch_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable EmitZipkinBatch_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary EmitZipkinBatch_result where + arbitrary = QC.elements [EmitZipkinBatch_result]+from_EmitZipkinBatch_result :: EmitZipkinBatch_result -> T.ThriftVal+from_EmitZipkinBatch_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_EmitZipkinBatch_result :: T.Protocol p => p -> EmitZipkinBatch_result -> P.IO ()+write_EmitZipkinBatch_result oprot record = T.writeVal oprot $ from_EmitZipkinBatch_result record+encode_EmitZipkinBatch_result :: T.StatelessProtocol p => p -> EmitZipkinBatch_result -> LBS.ByteString+encode_EmitZipkinBatch_result oprot record = T.serializeVal oprot $ from_EmitZipkinBatch_result record+to_EmitZipkinBatch_result :: T.ThriftVal -> EmitZipkinBatch_result+to_EmitZipkinBatch_result (T.TStruct fields) = EmitZipkinBatch_result{++ }+to_EmitZipkinBatch_result _ = P.error "not a struct"+read_EmitZipkinBatch_result :: T.Protocol p => p -> P.IO EmitZipkinBatch_result+read_EmitZipkinBatch_result iprot = to_EmitZipkinBatch_result <$> T.readVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_result)+decode_EmitZipkinBatch_result :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitZipkinBatch_result+decode_EmitZipkinBatch_result iprot bs = to_EmitZipkinBatch_result $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitZipkinBatch_result) bs+typemap_EmitZipkinBatch_result :: T.TypeMap+typemap_EmitZipkinBatch_result = Map.fromList []+default_EmitZipkinBatch_result :: EmitZipkinBatch_result+default_EmitZipkinBatch_result = EmitZipkinBatch_result{+}+data EmitBatch_args = EmitBatch_args { emitBatch_args_batch :: Jaeger_Types.Batch+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable EmitBatch_args where+ hashWithSalt salt record = salt `H.hashWithSalt` emitBatch_args_batch record +instance QC.Arbitrary EmitBatch_args where + arbitrary = M.liftM EmitBatch_args (QC.arbitrary)+ shrink obj | obj == default_EmitBatch_args = []+ | P.otherwise = M.catMaybes+ [ if obj == default_EmitBatch_args{emitBatch_args_batch = emitBatch_args_batch obj} then P.Nothing else P.Just $ default_EmitBatch_args{emitBatch_args_batch = emitBatch_args_batch obj}+ ]+from_EmitBatch_args :: EmitBatch_args -> T.ThriftVal+from_EmitBatch_args record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v17 -> P.Just (1, ("batch",Jaeger_Types.from_Batch _v17))) $ emitBatch_args_batch record+ ]+write_EmitBatch_args :: T.Protocol p => p -> EmitBatch_args -> P.IO ()+write_EmitBatch_args oprot record = T.writeVal oprot $ from_EmitBatch_args record+encode_EmitBatch_args :: T.StatelessProtocol p => p -> EmitBatch_args -> LBS.ByteString+encode_EmitBatch_args oprot record = T.serializeVal oprot $ from_EmitBatch_args record+to_EmitBatch_args :: T.ThriftVal -> EmitBatch_args+to_EmitBatch_args (T.TStruct fields) = EmitBatch_args{+ emitBatch_args_batch = P.maybe (emitBatch_args_batch default_EmitBatch_args) (\(_,_val19) -> (case _val19 of {T.TStruct _val20 -> (Jaeger_Types.to_Batch (T.TStruct _val20)); _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_EmitBatch_args _ = P.error "not a struct"+read_EmitBatch_args :: T.Protocol p => p -> P.IO EmitBatch_args+read_EmitBatch_args iprot = to_EmitBatch_args <$> T.readVal iprot (T.T_STRUCT typemap_EmitBatch_args)+decode_EmitBatch_args :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitBatch_args+decode_EmitBatch_args iprot bs = to_EmitBatch_args $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitBatch_args) bs+typemap_EmitBatch_args :: T.TypeMap+typemap_EmitBatch_args = Map.fromList [(1,("batch",(T.T_STRUCT Jaeger_Types.typemap_Batch)))]+default_EmitBatch_args :: EmitBatch_args+default_EmitBatch_args = EmitBatch_args{+ emitBatch_args_batch = Jaeger_Types.default_Batch}+data EmitBatch_result = EmitBatch_result deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable EmitBatch_result where+ hashWithSalt salt record = salt +instance QC.Arbitrary EmitBatch_result where + arbitrary = QC.elements [EmitBatch_result]+from_EmitBatch_result :: EmitBatch_result -> T.ThriftVal+from_EmitBatch_result record = T.TStruct $ Map.fromList $ M.catMaybes+ []+write_EmitBatch_result :: T.Protocol p => p -> EmitBatch_result -> P.IO ()+write_EmitBatch_result oprot record = T.writeVal oprot $ from_EmitBatch_result record+encode_EmitBatch_result :: T.StatelessProtocol p => p -> EmitBatch_result -> LBS.ByteString+encode_EmitBatch_result oprot record = T.serializeVal oprot $ from_EmitBatch_result record+to_EmitBatch_result :: T.ThriftVal -> EmitBatch_result+to_EmitBatch_result (T.TStruct fields) = EmitBatch_result{++ }+to_EmitBatch_result _ = P.error "not a struct"+read_EmitBatch_result :: T.Protocol p => p -> P.IO EmitBatch_result+read_EmitBatch_result iprot = to_EmitBatch_result <$> T.readVal iprot (T.T_STRUCT typemap_EmitBatch_result)+decode_EmitBatch_result :: T.StatelessProtocol p => p -> LBS.ByteString -> EmitBatch_result+decode_EmitBatch_result iprot bs = to_EmitBatch_result $ T.deserializeVal iprot (T.T_STRUCT typemap_EmitBatch_result) bs+typemap_EmitBatch_result :: T.TypeMap+typemap_EmitBatch_result = Map.fromList []+default_EmitBatch_result :: EmitBatch_result+default_EmitBatch_result = EmitBatch_result{+}+process_emitZipkinBatch (seqid, iprot, oprot, handler) = do+ args <- read_EmitZipkinBatch_args iprot+ (X.catch+ (do+ Iface.emitZipkinBatch handler (emitZipkinBatch_args_spans args)+ P.return ())+ ((\_ -> do+ P.return ()) :: X.SomeException -> P.IO ()))+process_emitBatch (seqid, iprot, oprot, handler) = do+ args <- read_EmitBatch_args iprot+ (X.catch+ (do+ Iface.emitBatch handler (emitBatch_args_batch args)+ P.return ())+ ((\_ -> do+ P.return ()) :: X.SomeException -> P.IO ()))+proc_ handler (iprot,oprot) (name,typ,seqid) = case name of+ "emitZipkinBatch" -> process_emitZipkinBatch (seqid,iprot,oprot,handler)+ "emitBatch" -> process_emitBatch (seqid,iprot,oprot,handler)+ _ -> do+ _ <- T.readVal iprot (T.T_STRUCT Map.empty)+ T.writeMessage oprot (name,T.M_EXCEPTION,seqid) $+ T.writeAppExn oprot (T.AppExn T.AE_UNKNOWN_METHOD ("Unknown function " ++ LT.unpack name))+process handler (iprot, oprot) = do+ T.readMessage iprot (+ proc_ handler (iprot,oprot))+ P.return P.True
+ gen-src/Agent_Client.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.11.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Agent_Client(emitZipkinBatch,emitBatch) where+import qualified Data.IORef as R+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Jaeger_Types+import qualified Zipkincore_Types+++import Agent_Types+import Agent+seqid = R.newIORef 0+emitZipkinBatch (ip,op) arg_spans = do+ send_emitZipkinBatch op arg_spans+send_emitZipkinBatch op arg_spans = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessage op ("emitZipkinBatch", T.M_ONEWAY, seqn) $+ write_EmitZipkinBatch_args op (EmitZipkinBatch_args{emitZipkinBatch_args_spans=arg_spans})+emitBatch (ip,op) arg_batch = do+ send_emitBatch op arg_batch+send_emitBatch op arg_batch = do+ seq <- seqid+ seqn <- R.readIORef seq+ T.writeMessage op ("emitBatch", T.M_ONEWAY, seqn) $+ write_EmitBatch_args op (EmitBatch_args{emitBatch_args_batch=arg_batch})
+ gen-src/Agent_Iface.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.11.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Agent_Iface where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Jaeger_Types+import qualified Zipkincore_Types+++import Agent_Types++class Agent_Iface a where+ emitZipkinBatch :: a -> (Vector.Vector Zipkincore_Types.Span) -> P.IO ()+ emitBatch :: a -> Jaeger_Types.Batch -> P.IO ()
+ gen-src/Agent_Types.hs view
@@ -0,0 +1,43 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.11.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Agent_Types where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T++import qualified Jaeger_Types+import qualified Zipkincore_Types++
+ gen-src/Jaeger_Consts.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.11.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Jaeger_Consts where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++import Jaeger_Types
+ gen-src/Jaeger_Types.hs view
@@ -0,0 +1,434 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.11.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Jaeger_Types where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++data TagType = STRING|DOUBLE|BOOL|LONG|BINARY deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)+instance P.Enum TagType where+ fromEnum t = case t of+ STRING -> 0+ DOUBLE -> 1+ BOOL -> 2+ LONG -> 3+ BINARY -> 4+ toEnum t = case t of+ 0 -> STRING+ 1 -> DOUBLE+ 2 -> BOOL+ 3 -> LONG+ 4 -> BINARY+ _ -> X.throw T.ThriftException+instance H.Hashable TagType where+ hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum+instance QC.Arbitrary TagType where+ arbitrary = QC.elements (P.enumFromTo P.minBound P.maxBound)+data SpanRefType = CHILD_OF|FOLLOWS_FROM deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)+instance P.Enum SpanRefType where+ fromEnum t = case t of+ CHILD_OF -> 0+ FOLLOWS_FROM -> 1+ toEnum t = case t of+ 0 -> CHILD_OF+ 1 -> FOLLOWS_FROM+ _ -> X.throw T.ThriftException+instance H.Hashable SpanRefType where+ hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum+instance QC.Arbitrary SpanRefType where+ arbitrary = QC.elements (P.enumFromTo P.minBound P.maxBound)+data Tag = Tag { tag_key :: LT.Text+ , tag_vType :: TagType+ , tag_vStr :: P.Maybe LT.Text+ , tag_vDouble :: P.Maybe P.Double+ , tag_vBool :: P.Maybe P.Bool+ , tag_vLong :: P.Maybe I.Int64+ , tag_vBinary :: P.Maybe LBS.ByteString+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Tag where+ hashWithSalt salt record = salt `H.hashWithSalt` tag_key record `H.hashWithSalt` tag_vType record `H.hashWithSalt` tag_vStr record `H.hashWithSalt` tag_vDouble record `H.hashWithSalt` tag_vBool record `H.hashWithSalt` tag_vLong record `H.hashWithSalt` tag_vBinary record +instance QC.Arbitrary Tag where + arbitrary = M.liftM Tag (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Tag = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Tag{tag_key = tag_key obj} then P.Nothing else P.Just $ default_Tag{tag_key = tag_key obj}+ , if obj == default_Tag{tag_vType = tag_vType obj} then P.Nothing else P.Just $ default_Tag{tag_vType = tag_vType obj}+ , if obj == default_Tag{tag_vStr = tag_vStr obj} then P.Nothing else P.Just $ default_Tag{tag_vStr = tag_vStr obj}+ , if obj == default_Tag{tag_vDouble = tag_vDouble obj} then P.Nothing else P.Just $ default_Tag{tag_vDouble = tag_vDouble obj}+ , if obj == default_Tag{tag_vBool = tag_vBool obj} then P.Nothing else P.Just $ default_Tag{tag_vBool = tag_vBool obj}+ , if obj == default_Tag{tag_vLong = tag_vLong obj} then P.Nothing else P.Just $ default_Tag{tag_vLong = tag_vLong obj}+ , if obj == default_Tag{tag_vBinary = tag_vBinary obj} then P.Nothing else P.Just $ default_Tag{tag_vBinary = tag_vBinary obj}+ ]+from_Tag :: Tag -> T.ThriftVal+from_Tag record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v2 -> P.Just (1, ("key",T.TString $ E.encodeUtf8 _v2))) $ tag_key record+ , (\_v2 -> P.Just (2, ("vType",T.TI32 $ P.fromIntegral $ P.fromEnum _v2))) $ tag_vType record+ , (\_v2 -> (3, ("vStr",T.TString $ E.encodeUtf8 _v2))) <$> tag_vStr record+ , (\_v2 -> (4, ("vDouble",T.TDouble _v2))) <$> tag_vDouble record+ , (\_v2 -> (5, ("vBool",T.TBool _v2))) <$> tag_vBool record+ , (\_v2 -> (6, ("vLong",T.TI64 _v2))) <$> tag_vLong record+ , (\_v2 -> (7, ("vBinary",T.TBinary _v2))) <$> tag_vBinary record+ ]+write_Tag :: T.Protocol p => p -> Tag -> P.IO ()+write_Tag oprot record = T.writeVal oprot $ from_Tag record+encode_Tag :: T.StatelessProtocol p => p -> Tag -> LBS.ByteString+encode_Tag oprot record = T.serializeVal oprot $ from_Tag record+to_Tag :: T.ThriftVal -> Tag+to_Tag (T.TStruct fields) = Tag{+ tag_key = P.maybe (P.error "Missing required field: key") (\(_,_val4) -> (case _val4 of {T.TString _val5 -> E.decodeUtf8 _val5; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ tag_vType = P.maybe (P.error "Missing required field: vType") (\(_,_val4) -> (case _val4 of {T.TI32 _val6 -> P.toEnum $ P.fromIntegral _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ tag_vStr = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TString _val7 -> E.decodeUtf8 _val7; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ tag_vDouble = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TDouble _val8 -> _val8; _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ tag_vBool = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBool _val9 -> _val9; _ -> P.error "wrong type"})) (Map.lookup (5) fields),+ tag_vLong = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TI64 _val10 -> _val10; _ -> P.error "wrong type"})) (Map.lookup (6) fields),+ tag_vBinary = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val11 -> _val11; T.TString _val11 -> _val11; _ -> P.error "wrong type"})) (Map.lookup (7) fields)+ }+to_Tag _ = P.error "not a struct"+read_Tag :: T.Protocol p => p -> P.IO Tag+read_Tag iprot = to_Tag <$> T.readVal iprot (T.T_STRUCT typemap_Tag)+decode_Tag :: T.StatelessProtocol p => p -> LBS.ByteString -> Tag+decode_Tag iprot bs = to_Tag $ T.deserializeVal iprot (T.T_STRUCT typemap_Tag) bs+typemap_Tag :: T.TypeMap+typemap_Tag = Map.fromList [(1,("key",T.T_STRING)),(2,("vType",T.T_I32)),(3,("vStr",T.T_STRING)),(4,("vDouble",T.T_DOUBLE)),(5,("vBool",T.T_BOOL)),(6,("vLong",T.T_I64)),(7,("vBinary",T.T_BINARY))]+default_Tag :: Tag+default_Tag = Tag{+ tag_key = "",+ tag_vType = (P.toEnum 0),+ tag_vStr = P.Nothing,+ tag_vDouble = P.Nothing,+ tag_vBool = P.Nothing,+ tag_vLong = P.Nothing,+ tag_vBinary = P.Nothing}+data Log = Log { log_timestamp :: I.Int64+ , log_fields :: (Vector.Vector Tag)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Log where+ hashWithSalt salt record = salt `H.hashWithSalt` log_timestamp record `H.hashWithSalt` log_fields record +instance QC.Arbitrary Log where + arbitrary = M.liftM Log (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_Log = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Log{log_timestamp = log_timestamp obj} then P.Nothing else P.Just $ default_Log{log_timestamp = log_timestamp obj}+ , if obj == default_Log{log_fields = log_fields obj} then P.Nothing else P.Just $ default_Log{log_fields = log_fields obj}+ ]+from_Log :: Log -> T.ThriftVal+from_Log record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v14 -> P.Just (1, ("timestamp",T.TI64 _v14))) $ log_timestamp record+ , (\_v14 -> P.Just (2, ("fields",T.TList (T.T_STRUCT typemap_Tag) $ P.map (\_v16 -> from_Tag _v16) $ Vector.toList _v14))) $ log_fields record+ ]+write_Log :: T.Protocol p => p -> Log -> P.IO ()+write_Log oprot record = T.writeVal oprot $ from_Log record+encode_Log :: T.StatelessProtocol p => p -> Log -> LBS.ByteString+encode_Log oprot record = T.serializeVal oprot $ from_Log record+to_Log :: T.ThriftVal -> Log+to_Log (T.TStruct fields) = Log{+ log_timestamp = P.maybe (P.error "Missing required field: timestamp") (\(_,_val18) -> (case _val18 of {T.TI64 _val19 -> _val19; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ log_fields = P.maybe (P.error "Missing required field: fields") (\(_,_val18) -> (case _val18 of {T.TList _ _val20 -> (Vector.fromList $ P.map (\_v21 -> (case _v21 of {T.TStruct _val22 -> (to_Tag (T.TStruct _val22)); _ -> P.error "wrong type"})) _val20); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_Log _ = P.error "not a struct"+read_Log :: T.Protocol p => p -> P.IO Log+read_Log iprot = to_Log <$> T.readVal iprot (T.T_STRUCT typemap_Log)+decode_Log :: T.StatelessProtocol p => p -> LBS.ByteString -> Log+decode_Log iprot bs = to_Log $ T.deserializeVal iprot (T.T_STRUCT typemap_Log) bs+typemap_Log :: T.TypeMap+typemap_Log = Map.fromList [(1,("timestamp",T.T_I64)),(2,("fields",(T.T_LIST (T.T_STRUCT typemap_Tag))))]+default_Log :: Log+default_Log = Log{+ log_timestamp = 0,+ log_fields = Vector.empty}+data SpanRef = SpanRef { spanRef_refType :: SpanRefType+ , spanRef_traceIdLow :: I.Int64+ , spanRef_traceIdHigh :: I.Int64+ , spanRef_spanId :: I.Int64+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable SpanRef where+ hashWithSalt salt record = salt `H.hashWithSalt` spanRef_refType record `H.hashWithSalt` spanRef_traceIdLow record `H.hashWithSalt` spanRef_traceIdHigh record `H.hashWithSalt` spanRef_spanId record +instance QC.Arbitrary SpanRef where + arbitrary = M.liftM SpanRef (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_SpanRef = []+ | P.otherwise = M.catMaybes+ [ if obj == default_SpanRef{spanRef_refType = spanRef_refType obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_refType = spanRef_refType obj}+ , if obj == default_SpanRef{spanRef_traceIdLow = spanRef_traceIdLow obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_traceIdLow = spanRef_traceIdLow obj}+ , if obj == default_SpanRef{spanRef_traceIdHigh = spanRef_traceIdHigh obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_traceIdHigh = spanRef_traceIdHigh obj}+ , if obj == default_SpanRef{spanRef_spanId = spanRef_spanId obj} then P.Nothing else P.Just $ default_SpanRef{spanRef_spanId = spanRef_spanId obj}+ ]+from_SpanRef :: SpanRef -> T.ThriftVal+from_SpanRef record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v25 -> P.Just (1, ("refType",T.TI32 $ P.fromIntegral $ P.fromEnum _v25))) $ spanRef_refType record+ , (\_v25 -> P.Just (2, ("traceIdLow",T.TI64 _v25))) $ spanRef_traceIdLow record+ , (\_v25 -> P.Just (3, ("traceIdHigh",T.TI64 _v25))) $ spanRef_traceIdHigh record+ , (\_v25 -> P.Just (4, ("spanId",T.TI64 _v25))) $ spanRef_spanId record+ ]+write_SpanRef :: T.Protocol p => p -> SpanRef -> P.IO ()+write_SpanRef oprot record = T.writeVal oprot $ from_SpanRef record+encode_SpanRef :: T.StatelessProtocol p => p -> SpanRef -> LBS.ByteString+encode_SpanRef oprot record = T.serializeVal oprot $ from_SpanRef record+to_SpanRef :: T.ThriftVal -> SpanRef+to_SpanRef (T.TStruct fields) = SpanRef{+ spanRef_refType = P.maybe (P.error "Missing required field: refType") (\(_,_val27) -> (case _val27 of {T.TI32 _val28 -> P.toEnum $ P.fromIntegral _val28; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ spanRef_traceIdLow = P.maybe (P.error "Missing required field: traceIdLow") (\(_,_val27) -> (case _val27 of {T.TI64 _val29 -> _val29; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ spanRef_traceIdHigh = P.maybe (P.error "Missing required field: traceIdHigh") (\(_,_val27) -> (case _val27 of {T.TI64 _val30 -> _val30; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ spanRef_spanId = P.maybe (P.error "Missing required field: spanId") (\(_,_val27) -> (case _val27 of {T.TI64 _val31 -> _val31; _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ }+to_SpanRef _ = P.error "not a struct"+read_SpanRef :: T.Protocol p => p -> P.IO SpanRef+read_SpanRef iprot = to_SpanRef <$> T.readVal iprot (T.T_STRUCT typemap_SpanRef)+decode_SpanRef :: T.StatelessProtocol p => p -> LBS.ByteString -> SpanRef+decode_SpanRef iprot bs = to_SpanRef $ T.deserializeVal iprot (T.T_STRUCT typemap_SpanRef) bs+typemap_SpanRef :: T.TypeMap+typemap_SpanRef = Map.fromList [(1,("refType",T.T_I32)),(2,("traceIdLow",T.T_I64)),(3,("traceIdHigh",T.T_I64)),(4,("spanId",T.T_I64))]+default_SpanRef :: SpanRef+default_SpanRef = SpanRef{+ spanRef_refType = (P.toEnum 0),+ spanRef_traceIdLow = 0,+ spanRef_traceIdHigh = 0,+ spanRef_spanId = 0}+data Span = Span { span_traceIdLow :: I.Int64+ , span_traceIdHigh :: I.Int64+ , span_spanId :: I.Int64+ , span_parentSpanId :: I.Int64+ , span_operationName :: LT.Text+ , span_references :: P.Maybe (Vector.Vector SpanRef)+ , span_flags :: I.Int32+ , span_startTime :: I.Int64+ , span_duration :: I.Int64+ , span_tags :: P.Maybe (Vector.Vector Tag)+ , span_logs :: P.Maybe (Vector.Vector Log)+ , span_incomplete :: P.Maybe P.Bool+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Span where+ hashWithSalt salt record = salt `H.hashWithSalt` span_traceIdLow record `H.hashWithSalt` span_traceIdHigh record `H.hashWithSalt` span_spanId record `H.hashWithSalt` span_parentSpanId record `H.hashWithSalt` span_operationName record `H.hashWithSalt` span_references record `H.hashWithSalt` span_flags record `H.hashWithSalt` span_startTime record `H.hashWithSalt` span_duration record `H.hashWithSalt` span_tags record `H.hashWithSalt` span_logs record `H.hashWithSalt` span_incomplete record +instance QC.Arbitrary Span where + arbitrary = M.liftM Span (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Span = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Span{span_traceIdLow = span_traceIdLow obj} then P.Nothing else P.Just $ default_Span{span_traceIdLow = span_traceIdLow obj}+ , if obj == default_Span{span_traceIdHigh = span_traceIdHigh obj} then P.Nothing else P.Just $ default_Span{span_traceIdHigh = span_traceIdHigh obj}+ , if obj == default_Span{span_spanId = span_spanId obj} then P.Nothing else P.Just $ default_Span{span_spanId = span_spanId obj}+ , if obj == default_Span{span_parentSpanId = span_parentSpanId obj} then P.Nothing else P.Just $ default_Span{span_parentSpanId = span_parentSpanId obj}+ , if obj == default_Span{span_operationName = span_operationName obj} then P.Nothing else P.Just $ default_Span{span_operationName = span_operationName obj}+ , if obj == default_Span{span_references = span_references obj} then P.Nothing else P.Just $ default_Span{span_references = span_references obj}+ , if obj == default_Span{span_flags = span_flags obj} then P.Nothing else P.Just $ default_Span{span_flags = span_flags obj}+ , if obj == default_Span{span_startTime = span_startTime obj} then P.Nothing else P.Just $ default_Span{span_startTime = span_startTime obj}+ , if obj == default_Span{span_duration = span_duration obj} then P.Nothing else P.Just $ default_Span{span_duration = span_duration obj}+ , if obj == default_Span{span_tags = span_tags obj} then P.Nothing else P.Just $ default_Span{span_tags = span_tags obj}+ , if obj == default_Span{span_logs = span_logs obj} then P.Nothing else P.Just $ default_Span{span_logs = span_logs obj}+ , if obj == default_Span{span_incomplete = span_incomplete obj} then P.Nothing else P.Just $ default_Span{span_incomplete = span_incomplete obj}+ ]+from_Span :: Span -> T.ThriftVal+from_Span record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v34 -> P.Just (1, ("traceIdLow",T.TI64 _v34))) $ span_traceIdLow record+ , (\_v34 -> P.Just (2, ("traceIdHigh",T.TI64 _v34))) $ span_traceIdHigh record+ , (\_v34 -> P.Just (3, ("spanId",T.TI64 _v34))) $ span_spanId record+ , (\_v34 -> P.Just (4, ("parentSpanId",T.TI64 _v34))) $ span_parentSpanId record+ , (\_v34 -> P.Just (5, ("operationName",T.TString $ E.encodeUtf8 _v34))) $ span_operationName record+ , (\_v34 -> (6, ("references",T.TList (T.T_STRUCT typemap_SpanRef) $ P.map (\_v36 -> from_SpanRef _v36) $ Vector.toList _v34))) <$> span_references record+ , (\_v34 -> P.Just (7, ("flags",T.TI32 _v34))) $ span_flags record+ , (\_v34 -> P.Just (8, ("startTime",T.TI64 _v34))) $ span_startTime record+ , (\_v34 -> P.Just (9, ("duration",T.TI64 _v34))) $ span_duration record+ , (\_v34 -> (10, ("tags",T.TList (T.T_STRUCT typemap_Tag) $ P.map (\_v38 -> from_Tag _v38) $ Vector.toList _v34))) <$> span_tags record+ , (\_v34 -> (11, ("logs",T.TList (T.T_STRUCT typemap_Log) $ P.map (\_v40 -> from_Log _v40) $ Vector.toList _v34))) <$> span_logs record+ , (\_v34 -> (12, ("incomplete",T.TBool _v34))) <$> span_incomplete record+ ]+write_Span :: T.Protocol p => p -> Span -> P.IO ()+write_Span oprot record = T.writeVal oprot $ from_Span record+encode_Span :: T.StatelessProtocol p => p -> Span -> LBS.ByteString+encode_Span oprot record = T.serializeVal oprot $ from_Span record+to_Span :: T.ThriftVal -> Span+to_Span (T.TStruct fields) = Span{+ span_traceIdLow = P.maybe (P.error "Missing required field: traceIdLow") (\(_,_val42) -> (case _val42 of {T.TI64 _val43 -> _val43; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ span_traceIdHigh = P.maybe (P.error "Missing required field: traceIdHigh") (\(_,_val42) -> (case _val42 of {T.TI64 _val44 -> _val44; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ span_spanId = P.maybe (P.error "Missing required field: spanId") (\(_,_val42) -> (case _val42 of {T.TI64 _val45 -> _val45; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ span_parentSpanId = P.maybe (P.error "Missing required field: parentSpanId") (\(_,_val42) -> (case _val42 of {T.TI64 _val46 -> _val46; _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ span_operationName = P.maybe (P.error "Missing required field: operationName") (\(_,_val42) -> (case _val42 of {T.TString _val47 -> E.decodeUtf8 _val47; _ -> P.error "wrong type"})) (Map.lookup (5) fields),+ span_references = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TList _ _val48 -> (Vector.fromList $ P.map (\_v49 -> (case _v49 of {T.TStruct _val50 -> (to_SpanRef (T.TStruct _val50)); _ -> P.error "wrong type"})) _val48); _ -> P.error "wrong type"})) (Map.lookup (6) fields),+ span_flags = P.maybe (P.error "Missing required field: flags") (\(_,_val42) -> (case _val42 of {T.TI32 _val51 -> _val51; _ -> P.error "wrong type"})) (Map.lookup (7) fields),+ span_startTime = P.maybe (P.error "Missing required field: startTime") (\(_,_val42) -> (case _val42 of {T.TI64 _val52 -> _val52; _ -> P.error "wrong type"})) (Map.lookup (8) fields),+ span_duration = P.maybe (P.error "Missing required field: duration") (\(_,_val42) -> (case _val42 of {T.TI64 _val53 -> _val53; _ -> P.error "wrong type"})) (Map.lookup (9) fields),+ span_tags = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TList _ _val54 -> (Vector.fromList $ P.map (\_v55 -> (case _v55 of {T.TStruct _val56 -> (to_Tag (T.TStruct _val56)); _ -> P.error "wrong type"})) _val54); _ -> P.error "wrong type"})) (Map.lookup (10) fields),+ span_logs = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TList _ _val57 -> (Vector.fromList $ P.map (\_v58 -> (case _v58 of {T.TStruct _val59 -> (to_Log (T.TStruct _val59)); _ -> P.error "wrong type"})) _val57); _ -> P.error "wrong type"})) (Map.lookup (11) fields),+ span_incomplete = P.maybe (P.Nothing) (\(_,_val42) -> P.Just (case _val42 of {T.TBool _val60 -> _val60; _ -> P.error "wrong type"})) (Map.lookup (12) fields)+ }+to_Span _ = P.error "not a struct"+read_Span :: T.Protocol p => p -> P.IO Span+read_Span iprot = to_Span <$> T.readVal iprot (T.T_STRUCT typemap_Span)+decode_Span :: T.StatelessProtocol p => p -> LBS.ByteString -> Span+decode_Span iprot bs = to_Span $ T.deserializeVal iprot (T.T_STRUCT typemap_Span) bs+typemap_Span :: T.TypeMap+typemap_Span = Map.fromList [(1,("traceIdLow",T.T_I64)),(2,("traceIdHigh",T.T_I64)),(3,("spanId",T.T_I64)),(4,("parentSpanId",T.T_I64)),(5,("operationName",T.T_STRING)),(6,("references",(T.T_LIST (T.T_STRUCT typemap_SpanRef)))),(7,("flags",T.T_I32)),(8,("startTime",T.T_I64)),(9,("duration",T.T_I64)),(10,("tags",(T.T_LIST (T.T_STRUCT typemap_Tag)))),(11,("logs",(T.T_LIST (T.T_STRUCT typemap_Log)))),(12,("incomplete",T.T_BOOL))]+default_Span :: Span+default_Span = Span{+ span_traceIdLow = 0,+ span_traceIdHigh = 0,+ span_spanId = 0,+ span_parentSpanId = 0,+ span_operationName = "",+ span_references = P.Nothing,+ span_flags = 0,+ span_startTime = 0,+ span_duration = 0,+ span_tags = P.Nothing,+ span_logs = P.Nothing,+ span_incomplete = P.Nothing}+data Process = Process { process_serviceName :: LT.Text+ , process_tags :: P.Maybe (Vector.Vector Tag)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Process where+ hashWithSalt salt record = salt `H.hashWithSalt` process_serviceName record `H.hashWithSalt` process_tags record +instance QC.Arbitrary Process where + arbitrary = M.liftM Process (QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Process = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Process{process_serviceName = process_serviceName obj} then P.Nothing else P.Just $ default_Process{process_serviceName = process_serviceName obj}+ , if obj == default_Process{process_tags = process_tags obj} then P.Nothing else P.Just $ default_Process{process_tags = process_tags obj}+ ]+from_Process :: Process -> T.ThriftVal+from_Process record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v63 -> P.Just (1, ("serviceName",T.TString $ E.encodeUtf8 _v63))) $ process_serviceName record+ , (\_v63 -> (2, ("tags",T.TList (T.T_STRUCT typemap_Tag) $ P.map (\_v65 -> from_Tag _v65) $ Vector.toList _v63))) <$> process_tags record+ ]+write_Process :: T.Protocol p => p -> Process -> P.IO ()+write_Process oprot record = T.writeVal oprot $ from_Process record+encode_Process :: T.StatelessProtocol p => p -> Process -> LBS.ByteString+encode_Process oprot record = T.serializeVal oprot $ from_Process record+to_Process :: T.ThriftVal -> Process+to_Process (T.TStruct fields) = Process{+ process_serviceName = P.maybe (P.error "Missing required field: serviceName") (\(_,_val67) -> (case _val67 of {T.TString _val68 -> E.decodeUtf8 _val68; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ process_tags = P.maybe (P.Nothing) (\(_,_val67) -> P.Just (case _val67 of {T.TList _ _val69 -> (Vector.fromList $ P.map (\_v70 -> (case _v70 of {T.TStruct _val71 -> (to_Tag (T.TStruct _val71)); _ -> P.error "wrong type"})) _val69); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_Process _ = P.error "not a struct"+read_Process :: T.Protocol p => p -> P.IO Process+read_Process iprot = to_Process <$> T.readVal iprot (T.T_STRUCT typemap_Process)+decode_Process :: T.StatelessProtocol p => p -> LBS.ByteString -> Process+decode_Process iprot bs = to_Process $ T.deserializeVal iprot (T.T_STRUCT typemap_Process) bs+typemap_Process :: T.TypeMap+typemap_Process = Map.fromList [(1,("serviceName",T.T_STRING)),(2,("tags",(T.T_LIST (T.T_STRUCT typemap_Tag))))]+default_Process :: Process+default_Process = Process{+ process_serviceName = "",+ process_tags = P.Nothing}+data Batch = Batch { batch_process :: Process+ , batch_spans :: (Vector.Vector Span)+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Batch where+ hashWithSalt salt record = salt `H.hashWithSalt` batch_process record `H.hashWithSalt` batch_spans record +instance QC.Arbitrary Batch where + arbitrary = M.liftM Batch (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ shrink obj | obj == default_Batch = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Batch{batch_process = batch_process obj} then P.Nothing else P.Just $ default_Batch{batch_process = batch_process obj}+ , if obj == default_Batch{batch_spans = batch_spans obj} then P.Nothing else P.Just $ default_Batch{batch_spans = batch_spans obj}+ ]+from_Batch :: Batch -> T.ThriftVal+from_Batch record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v74 -> P.Just (1, ("process",from_Process _v74))) $ batch_process record+ , (\_v74 -> P.Just (2, ("spans",T.TList (T.T_STRUCT typemap_Span) $ P.map (\_v76 -> from_Span _v76) $ Vector.toList _v74))) $ batch_spans record+ ]+write_Batch :: T.Protocol p => p -> Batch -> P.IO ()+write_Batch oprot record = T.writeVal oprot $ from_Batch record+encode_Batch :: T.StatelessProtocol p => p -> Batch -> LBS.ByteString+encode_Batch oprot record = T.serializeVal oprot $ from_Batch record+to_Batch :: T.ThriftVal -> Batch+to_Batch (T.TStruct fields) = Batch{+ batch_process = P.maybe (P.error "Missing required field: process") (\(_,_val78) -> (case _val78 of {T.TStruct _val79 -> (to_Process (T.TStruct _val79)); _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ batch_spans = P.maybe (P.error "Missing required field: spans") (\(_,_val78) -> (case _val78 of {T.TList _ _val80 -> (Vector.fromList $ P.map (\_v81 -> (case _v81 of {T.TStruct _val82 -> (to_Span (T.TStruct _val82)); _ -> P.error "wrong type"})) _val80); _ -> P.error "wrong type"})) (Map.lookup (2) fields)+ }+to_Batch _ = P.error "not a struct"+read_Batch :: T.Protocol p => p -> P.IO Batch+read_Batch iprot = to_Batch <$> T.readVal iprot (T.T_STRUCT typemap_Batch)+decode_Batch :: T.StatelessProtocol p => p -> LBS.ByteString -> Batch+decode_Batch iprot bs = to_Batch $ T.deserializeVal iprot (T.T_STRUCT typemap_Batch) bs+typemap_Batch :: T.TypeMap+typemap_Batch = Map.fromList [(1,("process",(T.T_STRUCT typemap_Process))),(2,("spans",(T.T_LIST (T.T_STRUCT typemap_Span))))]+default_Batch :: Batch+default_Batch = Batch{+ batch_process = default_Process,+ batch_spans = Vector.empty}+data BatchSubmitResponse = BatchSubmitResponse { batchSubmitResponse_ok :: P.Bool+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable BatchSubmitResponse where+ hashWithSalt salt record = salt `H.hashWithSalt` batchSubmitResponse_ok record +instance QC.Arbitrary BatchSubmitResponse where + arbitrary = M.liftM BatchSubmitResponse (QC.arbitrary)+ shrink obj | obj == default_BatchSubmitResponse = []+ | P.otherwise = M.catMaybes+ [ if obj == default_BatchSubmitResponse{batchSubmitResponse_ok = batchSubmitResponse_ok obj} then P.Nothing else P.Just $ default_BatchSubmitResponse{batchSubmitResponse_ok = batchSubmitResponse_ok obj}+ ]+from_BatchSubmitResponse :: BatchSubmitResponse -> T.ThriftVal+from_BatchSubmitResponse record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v85 -> P.Just (1, ("ok",T.TBool _v85))) $ batchSubmitResponse_ok record+ ]+write_BatchSubmitResponse :: T.Protocol p => p -> BatchSubmitResponse -> P.IO ()+write_BatchSubmitResponse oprot record = T.writeVal oprot $ from_BatchSubmitResponse record+encode_BatchSubmitResponse :: T.StatelessProtocol p => p -> BatchSubmitResponse -> LBS.ByteString+encode_BatchSubmitResponse oprot record = T.serializeVal oprot $ from_BatchSubmitResponse record+to_BatchSubmitResponse :: T.ThriftVal -> BatchSubmitResponse+to_BatchSubmitResponse (T.TStruct fields) = BatchSubmitResponse{+ batchSubmitResponse_ok = P.maybe (P.error "Missing required field: ok") (\(_,_val87) -> (case _val87 of {T.TBool _val88 -> _val88; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_BatchSubmitResponse _ = P.error "not a struct"+read_BatchSubmitResponse :: T.Protocol p => p -> P.IO BatchSubmitResponse+read_BatchSubmitResponse iprot = to_BatchSubmitResponse <$> T.readVal iprot (T.T_STRUCT typemap_BatchSubmitResponse)+decode_BatchSubmitResponse :: T.StatelessProtocol p => p -> LBS.ByteString -> BatchSubmitResponse+decode_BatchSubmitResponse iprot bs = to_BatchSubmitResponse $ T.deserializeVal iprot (T.T_STRUCT typemap_BatchSubmitResponse) bs+typemap_BatchSubmitResponse :: T.TypeMap+typemap_BatchSubmitResponse = Map.fromList [(1,("ok",T.T_BOOL))]+default_BatchSubmitResponse :: BatchSubmitResponse+default_BatchSubmitResponse = BatchSubmitResponse{+ batchSubmitResponse_ok = P.False}
+ gen-src/Zipkincore_Types.hs view
@@ -0,0 +1,325 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-missing-fields #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+{-# OPTIONS_GHC -fno-warn-unused-matches #-}++-----------------------------------------------------------------+-- Autogenerated by Thrift Compiler (0.11.0) --+-- --+-- DO NOT EDIT UNLESS YOU ARE SURE YOU KNOW WHAT YOU ARE DOING --+-----------------------------------------------------------------++module Zipkincore_Types where+import Prelude (($), (.), (>>=), (==), (++))+import qualified Prelude as P+import qualified Control.Exception as X+import qualified Control.Monad as M ( liftM, ap, when )+import Data.Functor ( (<$>) )+import qualified Data.ByteString.Lazy as LBS+import qualified Data.Hashable as H+import qualified Data.Int as I+import qualified Data.Maybe as M (catMaybes)+import qualified Data.Text.Lazy.Encoding as E ( decodeUtf8, encodeUtf8 )+import qualified Data.Text.Lazy as LT+import qualified GHC.Generics as G (Generic)+import qualified Data.Typeable as TY ( Typeable )+import qualified Data.HashMap.Strict as Map+import qualified Data.HashSet as Set+import qualified Data.Vector as Vector+import qualified Test.QuickCheck.Arbitrary as QC ( Arbitrary(..) )+import qualified Test.QuickCheck as QC ( elements )++import qualified Thrift as T+import qualified Thrift.Types as T+import qualified Thrift.Arbitraries as T+++data AnnotationType = BOOL|BYTES|I16|I32|I64|DOUBLE|STRING deriving (P.Show, P.Eq, G.Generic, TY.Typeable, P.Ord, P.Bounded)+instance P.Enum AnnotationType where+ fromEnum t = case t of+ BOOL -> 0+ BYTES -> 1+ I16 -> 2+ I32 -> 3+ I64 -> 4+ DOUBLE -> 5+ STRING -> 6+ toEnum t = case t of+ 0 -> BOOL+ 1 -> BYTES+ 2 -> I16+ 3 -> I32+ 4 -> I64+ 5 -> DOUBLE+ 6 -> STRING+ _ -> X.throw T.ThriftException+instance H.Hashable AnnotationType where+ hashWithSalt salt = H.hashWithSalt salt P.. P.fromEnum+instance QC.Arbitrary AnnotationType where+ arbitrary = QC.elements (P.enumFromTo P.minBound P.maxBound)+data Endpoint = Endpoint { endpoint_ipv4 :: I.Int32+ , endpoint_port :: I.Int16+ , endpoint_service_name :: LT.Text+ , endpoint_ipv6 :: P.Maybe LBS.ByteString+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Endpoint where+ hashWithSalt salt record = salt `H.hashWithSalt` endpoint_ipv4 record `H.hashWithSalt` endpoint_port record `H.hashWithSalt` endpoint_service_name record `H.hashWithSalt` endpoint_ipv6 record +instance QC.Arbitrary Endpoint where + arbitrary = M.liftM Endpoint (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Endpoint = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Endpoint{endpoint_ipv4 = endpoint_ipv4 obj} then P.Nothing else P.Just $ default_Endpoint{endpoint_ipv4 = endpoint_ipv4 obj}+ , if obj == default_Endpoint{endpoint_port = endpoint_port obj} then P.Nothing else P.Just $ default_Endpoint{endpoint_port = endpoint_port obj}+ , if obj == default_Endpoint{endpoint_service_name = endpoint_service_name obj} then P.Nothing else P.Just $ default_Endpoint{endpoint_service_name = endpoint_service_name obj}+ , if obj == default_Endpoint{endpoint_ipv6 = endpoint_ipv6 obj} then P.Nothing else P.Just $ default_Endpoint{endpoint_ipv6 = endpoint_ipv6 obj}+ ]+from_Endpoint :: Endpoint -> T.ThriftVal+from_Endpoint record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v2 -> P.Just (1, ("ipv4",T.TI32 _v2))) $ endpoint_ipv4 record+ , (\_v2 -> P.Just (2, ("port",T.TI16 _v2))) $ endpoint_port record+ , (\_v2 -> P.Just (3, ("service_name",T.TString $ E.encodeUtf8 _v2))) $ endpoint_service_name record+ , (\_v2 -> (4, ("ipv6",T.TBinary _v2))) <$> endpoint_ipv6 record+ ]+write_Endpoint :: T.Protocol p => p -> Endpoint -> P.IO ()+write_Endpoint oprot record = T.writeVal oprot $ from_Endpoint record+encode_Endpoint :: T.StatelessProtocol p => p -> Endpoint -> LBS.ByteString+encode_Endpoint oprot record = T.serializeVal oprot $ from_Endpoint record+to_Endpoint :: T.ThriftVal -> Endpoint+to_Endpoint (T.TStruct fields) = Endpoint{+ endpoint_ipv4 = P.maybe (endpoint_ipv4 default_Endpoint) (\(_,_val4) -> (case _val4 of {T.TI32 _val5 -> _val5; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ endpoint_port = P.maybe (endpoint_port default_Endpoint) (\(_,_val4) -> (case _val4 of {T.TI16 _val6 -> _val6; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ endpoint_service_name = P.maybe (endpoint_service_name default_Endpoint) (\(_,_val4) -> (case _val4 of {T.TString _val7 -> E.decodeUtf8 _val7; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ endpoint_ipv6 = P.maybe (P.Nothing) (\(_,_val4) -> P.Just (case _val4 of {T.TBinary _val8 -> _val8; T.TString _val8 -> _val8; _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ }+to_Endpoint _ = P.error "not a struct"+read_Endpoint :: T.Protocol p => p -> P.IO Endpoint+read_Endpoint iprot = to_Endpoint <$> T.readVal iprot (T.T_STRUCT typemap_Endpoint)+decode_Endpoint :: T.StatelessProtocol p => p -> LBS.ByteString -> Endpoint+decode_Endpoint iprot bs = to_Endpoint $ T.deserializeVal iprot (T.T_STRUCT typemap_Endpoint) bs+typemap_Endpoint :: T.TypeMap+typemap_Endpoint = Map.fromList [(1,("ipv4",T.T_I32)),(2,("port",T.T_I16)),(3,("service_name",T.T_STRING)),(4,("ipv6",T.T_BINARY))]+default_Endpoint :: Endpoint+default_Endpoint = Endpoint{+ endpoint_ipv4 = 0,+ endpoint_port = 0,+ endpoint_service_name = "",+ endpoint_ipv6 = P.Nothing}+data Annotation = Annotation { annotation_timestamp :: I.Int64+ , annotation_value :: LT.Text+ , annotation_host :: P.Maybe Endpoint+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Annotation where+ hashWithSalt salt record = salt `H.hashWithSalt` annotation_timestamp record `H.hashWithSalt` annotation_value record `H.hashWithSalt` annotation_host record +instance QC.Arbitrary Annotation where + arbitrary = M.liftM Annotation (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Annotation = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Annotation{annotation_timestamp = annotation_timestamp obj} then P.Nothing else P.Just $ default_Annotation{annotation_timestamp = annotation_timestamp obj}+ , if obj == default_Annotation{annotation_value = annotation_value obj} then P.Nothing else P.Just $ default_Annotation{annotation_value = annotation_value obj}+ , if obj == default_Annotation{annotation_host = annotation_host obj} then P.Nothing else P.Just $ default_Annotation{annotation_host = annotation_host obj}+ ]+from_Annotation :: Annotation -> T.ThriftVal+from_Annotation record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v11 -> P.Just (1, ("timestamp",T.TI64 _v11))) $ annotation_timestamp record+ , (\_v11 -> P.Just (2, ("value",T.TString $ E.encodeUtf8 _v11))) $ annotation_value record+ , (\_v11 -> (3, ("host",from_Endpoint _v11))) <$> annotation_host record+ ]+write_Annotation :: T.Protocol p => p -> Annotation -> P.IO ()+write_Annotation oprot record = T.writeVal oprot $ from_Annotation record+encode_Annotation :: T.StatelessProtocol p => p -> Annotation -> LBS.ByteString+encode_Annotation oprot record = T.serializeVal oprot $ from_Annotation record+to_Annotation :: T.ThriftVal -> Annotation+to_Annotation (T.TStruct fields) = Annotation{+ annotation_timestamp = P.maybe (annotation_timestamp default_Annotation) (\(_,_val13) -> (case _val13 of {T.TI64 _val14 -> _val14; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ annotation_value = P.maybe (annotation_value default_Annotation) (\(_,_val13) -> (case _val13 of {T.TString _val15 -> E.decodeUtf8 _val15; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ annotation_host = P.maybe (P.Nothing) (\(_,_val13) -> P.Just (case _val13 of {T.TStruct _val16 -> (to_Endpoint (T.TStruct _val16)); _ -> P.error "wrong type"})) (Map.lookup (3) fields)+ }+to_Annotation _ = P.error "not a struct"+read_Annotation :: T.Protocol p => p -> P.IO Annotation+read_Annotation iprot = to_Annotation <$> T.readVal iprot (T.T_STRUCT typemap_Annotation)+decode_Annotation :: T.StatelessProtocol p => p -> LBS.ByteString -> Annotation+decode_Annotation iprot bs = to_Annotation $ T.deserializeVal iprot (T.T_STRUCT typemap_Annotation) bs+typemap_Annotation :: T.TypeMap+typemap_Annotation = Map.fromList [(1,("timestamp",T.T_I64)),(2,("value",T.T_STRING)),(3,("host",(T.T_STRUCT typemap_Endpoint)))]+default_Annotation :: Annotation+default_Annotation = Annotation{+ annotation_timestamp = 0,+ annotation_value = "",+ annotation_host = P.Nothing}+data BinaryAnnotation = BinaryAnnotation { binaryAnnotation_key :: LT.Text+ , binaryAnnotation_value :: LBS.ByteString+ , binaryAnnotation_annotation_type :: AnnotationType+ , binaryAnnotation_host :: P.Maybe Endpoint+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable BinaryAnnotation where+ hashWithSalt salt record = salt `H.hashWithSalt` binaryAnnotation_key record `H.hashWithSalt` binaryAnnotation_value record `H.hashWithSalt` binaryAnnotation_annotation_type record `H.hashWithSalt` binaryAnnotation_host record +instance QC.Arbitrary BinaryAnnotation where + arbitrary = M.liftM BinaryAnnotation (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_BinaryAnnotation = []+ | P.otherwise = M.catMaybes+ [ if obj == default_BinaryAnnotation{binaryAnnotation_key = binaryAnnotation_key obj} then P.Nothing else P.Just $ default_BinaryAnnotation{binaryAnnotation_key = binaryAnnotation_key obj}+ , if obj == default_BinaryAnnotation{binaryAnnotation_value = binaryAnnotation_value obj} then P.Nothing else P.Just $ default_BinaryAnnotation{binaryAnnotation_value = binaryAnnotation_value obj}+ , if obj == default_BinaryAnnotation{binaryAnnotation_annotation_type = binaryAnnotation_annotation_type obj} then P.Nothing else P.Just $ default_BinaryAnnotation{binaryAnnotation_annotation_type = binaryAnnotation_annotation_type obj}+ , if obj == default_BinaryAnnotation{binaryAnnotation_host = binaryAnnotation_host obj} then P.Nothing else P.Just $ default_BinaryAnnotation{binaryAnnotation_host = binaryAnnotation_host obj}+ ]+from_BinaryAnnotation :: BinaryAnnotation -> T.ThriftVal+from_BinaryAnnotation record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v19 -> P.Just (1, ("key",T.TString $ E.encodeUtf8 _v19))) $ binaryAnnotation_key record+ , (\_v19 -> P.Just (2, ("value",T.TBinary _v19))) $ binaryAnnotation_value record+ , (\_v19 -> P.Just (3, ("annotation_type",T.TI32 $ P.fromIntegral $ P.fromEnum _v19))) $ binaryAnnotation_annotation_type record+ , (\_v19 -> (4, ("host",from_Endpoint _v19))) <$> binaryAnnotation_host record+ ]+write_BinaryAnnotation :: T.Protocol p => p -> BinaryAnnotation -> P.IO ()+write_BinaryAnnotation oprot record = T.writeVal oprot $ from_BinaryAnnotation record+encode_BinaryAnnotation :: T.StatelessProtocol p => p -> BinaryAnnotation -> LBS.ByteString+encode_BinaryAnnotation oprot record = T.serializeVal oprot $ from_BinaryAnnotation record+to_BinaryAnnotation :: T.ThriftVal -> BinaryAnnotation+to_BinaryAnnotation (T.TStruct fields) = BinaryAnnotation{+ binaryAnnotation_key = P.maybe (binaryAnnotation_key default_BinaryAnnotation) (\(_,_val21) -> (case _val21 of {T.TString _val22 -> E.decodeUtf8 _val22; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ binaryAnnotation_value = P.maybe (binaryAnnotation_value default_BinaryAnnotation) (\(_,_val21) -> (case _val21 of {T.TBinary _val23 -> _val23; T.TString _val23 -> _val23; _ -> P.error "wrong type"})) (Map.lookup (2) fields),+ binaryAnnotation_annotation_type = P.maybe (binaryAnnotation_annotation_type default_BinaryAnnotation) (\(_,_val21) -> (case _val21 of {T.TI32 _val24 -> P.toEnum $ P.fromIntegral _val24; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ binaryAnnotation_host = P.maybe (P.Nothing) (\(_,_val21) -> P.Just (case _val21 of {T.TStruct _val25 -> (to_Endpoint (T.TStruct _val25)); _ -> P.error "wrong type"})) (Map.lookup (4) fields)+ }+to_BinaryAnnotation _ = P.error "not a struct"+read_BinaryAnnotation :: T.Protocol p => p -> P.IO BinaryAnnotation+read_BinaryAnnotation iprot = to_BinaryAnnotation <$> T.readVal iprot (T.T_STRUCT typemap_BinaryAnnotation)+decode_BinaryAnnotation :: T.StatelessProtocol p => p -> LBS.ByteString -> BinaryAnnotation+decode_BinaryAnnotation iprot bs = to_BinaryAnnotation $ T.deserializeVal iprot (T.T_STRUCT typemap_BinaryAnnotation) bs+typemap_BinaryAnnotation :: T.TypeMap+typemap_BinaryAnnotation = Map.fromList [(1,("key",T.T_STRING)),(2,("value",T.T_BINARY)),(3,("annotation_type",T.T_I32)),(4,("host",(T.T_STRUCT typemap_Endpoint)))]+default_BinaryAnnotation :: BinaryAnnotation+default_BinaryAnnotation = BinaryAnnotation{+ binaryAnnotation_key = "",+ binaryAnnotation_value = "",+ binaryAnnotation_annotation_type = (P.toEnum 0),+ binaryAnnotation_host = P.Nothing}+data Span = Span { span_trace_id :: I.Int64+ , span_name :: LT.Text+ , span_id :: I.Int64+ , span_parent_id :: P.Maybe I.Int64+ , span_annotations :: (Vector.Vector Annotation)+ , span_binary_annotations :: (Vector.Vector BinaryAnnotation)+ , span_debug :: P.Maybe P.Bool+ , span_timestamp :: P.Maybe I.Int64+ , span_duration :: P.Maybe I.Int64+ , span_trace_id_high :: P.Maybe I.Int64+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Span where+ hashWithSalt salt record = salt `H.hashWithSalt` span_trace_id record `H.hashWithSalt` span_name record `H.hashWithSalt` span_id record `H.hashWithSalt` span_parent_id record `H.hashWithSalt` span_annotations record `H.hashWithSalt` span_binary_annotations record `H.hashWithSalt` span_debug record `H.hashWithSalt` span_timestamp record `H.hashWithSalt` span_duration record `H.hashWithSalt` span_trace_id_high record +instance QC.Arbitrary Span where + arbitrary = M.liftM Span (QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ `M.ap`(M.liftM P.Just QC.arbitrary)+ shrink obj | obj == default_Span = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Span{span_trace_id = span_trace_id obj} then P.Nothing else P.Just $ default_Span{span_trace_id = span_trace_id obj}+ , if obj == default_Span{span_name = span_name obj} then P.Nothing else P.Just $ default_Span{span_name = span_name obj}+ , if obj == default_Span{span_id = span_id obj} then P.Nothing else P.Just $ default_Span{span_id = span_id obj}+ , if obj == default_Span{span_parent_id = span_parent_id obj} then P.Nothing else P.Just $ default_Span{span_parent_id = span_parent_id obj}+ , if obj == default_Span{span_annotations = span_annotations obj} then P.Nothing else P.Just $ default_Span{span_annotations = span_annotations obj}+ , if obj == default_Span{span_binary_annotations = span_binary_annotations obj} then P.Nothing else P.Just $ default_Span{span_binary_annotations = span_binary_annotations obj}+ , if obj == default_Span{span_debug = span_debug obj} then P.Nothing else P.Just $ default_Span{span_debug = span_debug obj}+ , if obj == default_Span{span_timestamp = span_timestamp obj} then P.Nothing else P.Just $ default_Span{span_timestamp = span_timestamp obj}+ , if obj == default_Span{span_duration = span_duration obj} then P.Nothing else P.Just $ default_Span{span_duration = span_duration obj}+ , if obj == default_Span{span_trace_id_high = span_trace_id_high obj} then P.Nothing else P.Just $ default_Span{span_trace_id_high = span_trace_id_high obj}+ ]+from_Span :: Span -> T.ThriftVal+from_Span record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v28 -> P.Just (1, ("trace_id",T.TI64 _v28))) $ span_trace_id record+ , (\_v28 -> P.Just (3, ("name",T.TString $ E.encodeUtf8 _v28))) $ span_name record+ , (\_v28 -> P.Just (4, ("id",T.TI64 _v28))) $ span_id record+ , (\_v28 -> (5, ("parent_id",T.TI64 _v28))) <$> span_parent_id record+ , (\_v28 -> P.Just (6, ("annotations",T.TList (T.T_STRUCT typemap_Annotation) $ P.map (\_v30 -> from_Annotation _v30) $ Vector.toList _v28))) $ span_annotations record+ , (\_v28 -> P.Just (8, ("binary_annotations",T.TList (T.T_STRUCT typemap_BinaryAnnotation) $ P.map (\_v32 -> from_BinaryAnnotation _v32) $ Vector.toList _v28))) $ span_binary_annotations record+ , (\_v28 -> (9, ("debug",T.TBool _v28))) <$> span_debug record+ , (\_v28 -> (10, ("timestamp",T.TI64 _v28))) <$> span_timestamp record+ , (\_v28 -> (11, ("duration",T.TI64 _v28))) <$> span_duration record+ , (\_v28 -> (12, ("trace_id_high",T.TI64 _v28))) <$> span_trace_id_high record+ ]+write_Span :: T.Protocol p => p -> Span -> P.IO ()+write_Span oprot record = T.writeVal oprot $ from_Span record+encode_Span :: T.StatelessProtocol p => p -> Span -> LBS.ByteString+encode_Span oprot record = T.serializeVal oprot $ from_Span record+to_Span :: T.ThriftVal -> Span+to_Span (T.TStruct fields) = Span{+ span_trace_id = P.maybe (span_trace_id default_Span) (\(_,_val34) -> (case _val34 of {T.TI64 _val35 -> _val35; _ -> P.error "wrong type"})) (Map.lookup (1) fields),+ span_name = P.maybe (span_name default_Span) (\(_,_val34) -> (case _val34 of {T.TString _val36 -> E.decodeUtf8 _val36; _ -> P.error "wrong type"})) (Map.lookup (3) fields),+ span_id = P.maybe (span_id default_Span) (\(_,_val34) -> (case _val34 of {T.TI64 _val37 -> _val37; _ -> P.error "wrong type"})) (Map.lookup (4) fields),+ span_parent_id = P.maybe (P.Nothing) (\(_,_val34) -> P.Just (case _val34 of {T.TI64 _val38 -> _val38; _ -> P.error "wrong type"})) (Map.lookup (5) fields),+ span_annotations = P.maybe (span_annotations default_Span) (\(_,_val34) -> (case _val34 of {T.TList _ _val39 -> (Vector.fromList $ P.map (\_v40 -> (case _v40 of {T.TStruct _val41 -> (to_Annotation (T.TStruct _val41)); _ -> P.error "wrong type"})) _val39); _ -> P.error "wrong type"})) (Map.lookup (6) fields),+ span_binary_annotations = P.maybe (span_binary_annotations default_Span) (\(_,_val34) -> (case _val34 of {T.TList _ _val42 -> (Vector.fromList $ P.map (\_v43 -> (case _v43 of {T.TStruct _val44 -> (to_BinaryAnnotation (T.TStruct _val44)); _ -> P.error "wrong type"})) _val42); _ -> P.error "wrong type"})) (Map.lookup (8) fields),+ span_debug = P.maybe (span_debug default_Span) (\(_,_val34) -> P.Just (case _val34 of {T.TBool _val45 -> _val45; _ -> P.error "wrong type"})) (Map.lookup (9) fields),+ span_timestamp = P.maybe (P.Nothing) (\(_,_val34) -> P.Just (case _val34 of {T.TI64 _val46 -> _val46; _ -> P.error "wrong type"})) (Map.lookup (10) fields),+ span_duration = P.maybe (P.Nothing) (\(_,_val34) -> P.Just (case _val34 of {T.TI64 _val47 -> _val47; _ -> P.error "wrong type"})) (Map.lookup (11) fields),+ span_trace_id_high = P.maybe (P.Nothing) (\(_,_val34) -> P.Just (case _val34 of {T.TI64 _val48 -> _val48; _ -> P.error "wrong type"})) (Map.lookup (12) fields)+ }+to_Span _ = P.error "not a struct"+read_Span :: T.Protocol p => p -> P.IO Span+read_Span iprot = to_Span <$> T.readVal iprot (T.T_STRUCT typemap_Span)+decode_Span :: T.StatelessProtocol p => p -> LBS.ByteString -> Span+decode_Span iprot bs = to_Span $ T.deserializeVal iprot (T.T_STRUCT typemap_Span) bs+typemap_Span :: T.TypeMap+typemap_Span = Map.fromList [(1,("trace_id",T.T_I64)),(3,("name",T.T_STRING)),(4,("id",T.T_I64)),(5,("parent_id",T.T_I64)),(6,("annotations",(T.T_LIST (T.T_STRUCT typemap_Annotation)))),(8,("binary_annotations",(T.T_LIST (T.T_STRUCT typemap_BinaryAnnotation)))),(9,("debug",T.T_BOOL)),(10,("timestamp",T.T_I64)),(11,("duration",T.T_I64)),(12,("trace_id_high",T.T_I64))]+default_Span :: Span+default_Span = Span{+ span_trace_id = 0,+ span_name = "",+ span_id = 0,+ span_parent_id = P.Nothing,+ span_annotations = Vector.empty,+ span_binary_annotations = Vector.empty,+ span_debug = P.Just P.False,+ span_timestamp = P.Nothing,+ span_duration = P.Nothing,+ span_trace_id_high = P.Nothing}+data Response = Response { response_ok :: P.Bool+ } deriving (P.Show,P.Eq,G.Generic,TY.Typeable)+instance H.Hashable Response where+ hashWithSalt salt record = salt `H.hashWithSalt` response_ok record +instance QC.Arbitrary Response where + arbitrary = M.liftM Response (QC.arbitrary)+ shrink obj | obj == default_Response = []+ | P.otherwise = M.catMaybes+ [ if obj == default_Response{response_ok = response_ok obj} then P.Nothing else P.Just $ default_Response{response_ok = response_ok obj}+ ]+from_Response :: Response -> T.ThriftVal+from_Response record = T.TStruct $ Map.fromList $ M.catMaybes+ [ (\_v51 -> P.Just (1, ("ok",T.TBool _v51))) $ response_ok record+ ]+write_Response :: T.Protocol p => p -> Response -> P.IO ()+write_Response oprot record = T.writeVal oprot $ from_Response record+encode_Response :: T.StatelessProtocol p => p -> Response -> LBS.ByteString+encode_Response oprot record = T.serializeVal oprot $ from_Response record+to_Response :: T.ThriftVal -> Response+to_Response (T.TStruct fields) = Response{+ response_ok = P.maybe (P.error "Missing required field: ok") (\(_,_val53) -> (case _val53 of {T.TBool _val54 -> _val54; _ -> P.error "wrong type"})) (Map.lookup (1) fields)+ }+to_Response _ = P.error "not a struct"+read_Response :: T.Protocol p => p -> P.IO Response+read_Response iprot = to_Response <$> T.readVal iprot (T.T_STRUCT typemap_Response)+decode_Response :: T.StatelessProtocol p => p -> LBS.ByteString -> Response+decode_Response iprot bs = to_Response $ T.deserializeVal iprot (T.T_STRUCT typemap_Response) bs+typemap_Response :: T.TypeMap+typemap_Response = Map.fromList [(1,("ok",T.T_BOOL))]+default_Response :: Response+default_Response = Response{+ response_ok = P.False}
+ opentracing-jaeger.cabal view
@@ -0,0 +1,64 @@+cabal-version: 2.2++name: opentracing-jaeger+version: 0.1.0.0+synopsis: Jaeger backend for OpenTracing+homepage: https://github.com/kim/opentracing+bug-reports: https://github.com/kim/opentracing/issues+author: Kim Altintop+maintainer: Kim Altintop <kim.altintop+opentracing@gmail.com>+copyright: Copyright (c) 2017-2018 Kim Altintop+license: Apache-2.0+license-file: LICENSE+build-type: Simple+extra-source-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: git@github.com:kim/opentracing.git++library+ exposed-modules:+ OpenTracing.Jaeger+ OpenTracing.Jaeger.AgentReporter+ OpenTracing.Jaeger.CollectorReporter+ OpenTracing.Jaeger.Propagation+ OpenTracing.Jaeger.Thrift+ other-modules:+ Jaeger_Consts+ Jaeger_Types+ Agent+ Agent_Client+ Agent_Types+ Agent_Iface+ Zipkincore_Types+ hs-source-dirs:+ src+ gen-src+ ghc-options:+ -Wall+ -funbox-small-strict-fields+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ -Wcompat+ -Wnoncanonical-monad-instances+ build-depends:+ QuickCheck+ , base >= 4.9 && < 4.16+ , bytestring >= 0.10+ , exceptions >= 0.8+ , hashable >= 1.2+ , http-client >= 0.5+ , http-types >= 0.9+ , lens >= 4.19+ , mtl >= 2.2+ , network >= 2.8+ , opentracing >= 0.1+ , safe-exceptions >= 0.1+ , text >= 1.2+ , thrift == 0.13.0+ , unordered-containers >= 0.2+ , vector >= 0.12+ default-language: Haskell2010
+ src/OpenTracing/Jaeger.hs view
@@ -0,0 +1,10 @@+module OpenTracing.Jaeger+ ( module OpenTracing.Jaeger.AgentReporter+ , module OpenTracing.Jaeger.CollectorReporter+ , module OpenTracing.Jaeger.Propagation+ )+where++import OpenTracing.Jaeger.AgentReporter+import OpenTracing.Jaeger.CollectorReporter+import OpenTracing.Jaeger.Propagation
+ src/OpenTracing/Jaeger/AgentReporter.hs view
@@ -0,0 +1,137 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TemplateHaskell #-}++module OpenTracing.Jaeger.AgentReporter+ ( JaegerAgentOptions+ , jaegerAgentOptions+ , jaoServiceName+ , jaoServiceTags+ , jaoAddr+ , jaoErrorLog++ , defaultJaegerAgentAddr++ , JaegerAgent+ , newJaegerAgent+ , closeJaegerAgent+ , withJaegerAgent++ , jaegerAgentReporter++ , jaegerPropagation+ )+where++import qualified Agent_Client as Thrift+import Control.Exception.Safe+import Control.Lens (makeLenses, view)+import Control.Monad.IO.Class+import Data.ByteString.Builder+import Data.Semigroup+import Data.Text (Text)+import qualified Data.Vector as Vector+import qualified Jaeger_Types as Thrift+import Network.Socket+import qualified Network.Socket.ByteString.Lazy as Net+import OpenTracing.Jaeger.Propagation (jaegerPropagation)+import OpenTracing.Jaeger.Thrift+import OpenTracing.Reporting (defaultErrorLog)+import OpenTracing.Span+import OpenTracing.Tags+import OpenTracing.Types+import qualified Thrift+import qualified Thrift.Protocol.Compact as Thrift+import qualified Thrift.Transport.IOBuffer as Thrift+++data JaegerAgent = JaegerAgent+ { envLocalProcess :: Thrift.Process+ , envErrorLog :: Builder -> IO ()+ , envTransport :: AgentTransport+ }++data AgentTransport = AgentTransport+ { transSock :: Socket+ , transBuf :: Thrift.WriteBuffer+ }++instance Thrift.Transport AgentTransport where+ tIsOpen = const (pure True)+ tWrite = Thrift.writeBuf . transBuf++ tFlush AgentTransport{..} =+ Thrift.flushBuf transBuf >>= Net.sendAll transSock++ tClose = error "tClose undefined"+ tRead = error "tRead undefined"+ tPeek = error "tPeek undefined"+ tReadAll = error "tReadAll undefined"++data JaegerAgentOptions = JaegerAgentOptions+ { _jaoServiceName :: Text+ , _jaoServiceTags :: Tags+ , _jaoAddr :: Addr 'UDP+ , _jaoErrorLog :: Builder -> IO ()+ }++jaegerAgentOptions :: Text -> JaegerAgentOptions+jaegerAgentOptions srv = JaegerAgentOptions+ { _jaoServiceName = srv+ , _jaoServiceTags = mempty+ , _jaoAddr = defaultJaegerAgentAddr+ , _jaoErrorLog = defaultErrorLog+ }++defaultJaegerAgentAddr :: Addr 'UDP+defaultJaegerAgentAddr = UDPAddr "127.0.0.1" 6831+++newJaegerAgent :: JaegerAgentOptions -> IO JaegerAgent+newJaegerAgent JaegerAgentOptions{..} =+ let tproc = toThriftProcess _jaoServiceName _jaoServiceTags+ in JaegerAgent tproc _jaoErrorLog <$> openAgentTransport _jaoAddr++closeJaegerAgent :: JaegerAgent -> IO ()+closeJaegerAgent JaegerAgent{envTransport} =+ handleAny (const (return ())) $+ Thrift.tFlush envTransport *> Thrift.tClose envTransport++withJaegerAgent+ :: ( MonadIO m+ , MonadMask m+ )+ => JaegerAgentOptions+ -> (JaegerAgent -> m a)+ -> m a+withJaegerAgent opts =+ bracket (liftIO $ newJaegerAgent opts) (liftIO . closeJaegerAgent)++openAgentTransport :: Addr 'UDP -> IO AgentTransport+openAgentTransport addr = do+ AddrInfo{..} : _ <- getAddrInfo (Just defaultHints { addrSocketType = Datagram })+ (Just . view addrHostName $ addr)+ (Just . show . view addrPort $ addr)+ sock <- socket addrFamily addrSocketType addrProtocol+ connect sock addrAddress+ buf <- Thrift.newWriteBuffer+ return AgentTransport+ { transSock = sock+ , transBuf = buf+ }++jaegerAgentReporter :: MonadIO m => JaegerAgent -> FinishedSpan -> m ()+jaegerAgentReporter JaegerAgent{..} s = liftIO $ emit `catchAny` err+ where+ proto = Thrift.CompactProtocol envTransport+ emit = Thrift.emitBatch (undefined, proto) batch+ batch = toThriftBatch envLocalProcess (Vector.singleton s)+ err e = envErrorLog $ shortByteString "Jaeger Agent Thrift error: "+ <> string8 (show e)+ <> char8 '\n'++makeLenses ''JaegerAgentOptions
+ src/OpenTracing/Jaeger/CollectorReporter.hs view
@@ -0,0 +1,131 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}++module OpenTracing.Jaeger.CollectorReporter+ ( JaegerCollectorOptions+ , jaegerCollectorOptions+ , jcoManager+ , jcoServiceName+ , jcoServiceTags+ , jcoAddr+ , jcoErrorLog++ , defaultJaegerCollectorAddr++ , JaegerCollector+ , newJaegerCollector+ , closeJaegerCollector+ , withJaegerCollector++ , jaegerCollectorReporter++ , jaegerPropagation++ , newManager+ , defaultManagerSettings+ )+where++import Control.Lens (makeLenses, set, view)+import Control.Monad (unless)+import Control.Monad.Catch+import Control.Monad.IO.Class+import Data.ByteString.Builder+import Data.Monoid+import Data.Text (Text)+import Data.Vector (fromList)+import qualified Jaeger_Types as Thrift+import Network.HTTP.Client+import Network.HTTP.Types.Status+import OpenTracing.Jaeger.Propagation (jaegerPropagation)+import OpenTracing.Jaeger.Thrift+import OpenTracing.Reporting+import OpenTracing.Span+import OpenTracing.Tags+import OpenTracing.Types+import Thrift.Protocol.Binary+import Thrift.Transport.Empty+++newtype JaegerCollector = JaegerCollector { fromJaegerCollector :: BatchEnv }++data JaegerCollectorOptions = JaegerCollectorOptions+ { _jcoManager :: Manager+ , _jcoServiceName :: Text+ , _jcoServiceTags :: Tags+ , _jcoAddr :: Addr 'HTTP+ , _jcoErrorLog :: Builder -> IO ()+ }++makeLenses ''JaegerCollectorOptions++jaegerCollectorOptions :: Manager -> Text -> JaegerCollectorOptions+jaegerCollectorOptions mgr srv = JaegerCollectorOptions+ { _jcoManager = mgr+ , _jcoServiceName = srv+ , _jcoServiceTags = mempty+ , _jcoAddr = defaultJaegerCollectorAddr+ , _jcoErrorLog = defaultErrorLog+ }++defaultJaegerCollectorAddr :: Addr 'HTTP+defaultJaegerCollectorAddr = HTTPAddr "127.0.0.1" 14268 False++newJaegerCollector :: JaegerCollectorOptions -> IO JaegerCollector+newJaegerCollector opt@JaegerCollectorOptions{..} = do+ rq <- mkReq+ fmap JaegerCollector+ . newBatchEnv+ . set boptErrorLog _jcoErrorLog . batchOptions+ $ reporter _jcoManager _jcoErrorLog rq tproc+ where+ mkReq = do+ rq <- parseRequest+ $ "http://" <> view (jcoAddr . addrHostName) opt+ <> ":"+ <> show (view (jcoAddr . addrPort) opt)+ <> "/api/traces?format=jaeger.thrift"+ pure rq { method = "POST", secure = view (jcoAddr . addrSecure) opt }++ tproc = toThriftProcess _jcoServiceName _jcoServiceTags+++closeJaegerCollector :: JaegerCollector -> IO ()+closeJaegerCollector = closeBatchEnv . fromJaegerCollector++withJaegerCollector+ :: ( MonadIO m+ , MonadMask m+ )+ => JaegerCollectorOptions+ -> (JaegerCollector -> m a)+ -> m a+withJaegerCollector opts =+ bracket (liftIO $ newJaegerCollector opts) (liftIO . closeJaegerCollector)+++jaegerCollectorReporter :: MonadIO m => JaegerCollector -> FinishedSpan -> m ()+jaegerCollectorReporter = batchReporter . fromJaegerCollector+++reporter+ :: Manager+ -> (Builder -> IO ())+ -> Request+ -> Thrift.Process+ -> [FinishedSpan]+ -> IO ()+reporter mgr errlog rq tproc (fromList -> spans) = do+ rs <- responseStatus <$> httpLbs rq { requestBody = body } mgr+ unless (statusIsSuccessful rs) $+ errlog $ shortByteString "Error from Jaeger Collector: "+ <> intDec (statusCode rs)+ <> char8 '\n'+ where+ body = RequestBodyLBS . serializeBatch $ toThriftBatch tproc spans++ -- nb. collector accepts 'BinaryProtocol', but agent 'CompactProtocol'+ serializeBatch = Thrift.encode_Batch (BinaryProtocol EmptyTransport)
+ src/OpenTracing/Jaeger/Propagation.hs view
@@ -0,0 +1,70 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module OpenTracing.Jaeger.Propagation+ ( jaegerPropagation++ , _JaegerTextMap+ , _JaegerHeaders++ , _UberTraceId+ )+where++import Control.Lens+import Data.Bits+import qualified Data.HashMap.Strict as HashMap+import Data.Monoid+import Data.Text (Text, isPrefixOf)+import qualified Data.Text as Text+import qualified Data.Text.Read as Text+import OpenTracing.Propagation+import OpenTracing.Span+import OpenTracing.Types+++jaegerPropagation :: Propagation '[TextMap, Headers]+jaegerPropagation = Carrier _JaegerTextMap :& Carrier _JaegerHeaders :& RNil+++_JaegerTextMap :: Prism' TextMap SpanContext+_JaegerTextMap = prism' fromCtx toCtx+ where+ fromCtx c = HashMap.fromList $+ ("uber-trace-id", review _UberTraceId c)+ : map (over _1 ("uberctx-" <>)) (view (ctxBaggage . to HashMap.toList) c)++ toCtx m =+ fmap (set ctxBaggage+ (HashMap.filterWithKey (\k _ -> "uberctx-" `isPrefixOf` k) m))+ $ HashMap.lookup "uber-trace-id" m >>= preview _UberTraceId++_JaegerHeaders :: Prism' Headers SpanContext+_JaegerHeaders = _HeadersTextMap . _JaegerTextMap++_UberTraceId :: Prism' Text SpanContext+_UberTraceId = prism' fromCtx toCtx+ where+ fromCtx c@SpanContext{..} =+ let traceid = view hexText ctxTraceID+ spanid = view hexText ctxSpanID+ parent = maybe mempty (view hexText) ctxParentSpanID+ flags = if view (ctxSampled . re _IsSampled) c then "1" else "0"+ in Text.intercalate ":" [traceid, spanid, parent, flags]++ toCtx t =+ let sampledFlag = 1 :: Word+ debugFlag = 2 :: Word+ shouldSample fs = fs .&. sampledFlag > 0 || fs .&. debugFlag > 0+ in case Text.split (==':') t of+ [traceid, spanid, _, flags] -> SpanContext+ <$> preview _Hex (knownHex traceid)+ <*> preview _Hex (knownHex spanid)+ <*> pure Nothing+ <*> either (const $ Just NotSampled)+ (Just . view _IsSampled . shouldSample . fst)+ (Text.decimal flags)+ <*> pure mempty++ _ -> Nothing
+ src/OpenTracing/Jaeger/Thrift.hs view
@@ -0,0 +1,138 @@+{-# LANGUAGE TupleSections #-}++module OpenTracing.Jaeger.Thrift+ ( toThriftSpan+ , toThriftTags+ , toThriftProcess+ , toThriftBatch+ )+where++import Control.Lens+import Data.Bool (bool)+import Data.Foldable+import Data.Int (Int64)+import Data.Text (Text)+import Data.Text.Lazy.Builder (toLazyText)+import Data.Text.Lazy.Builder.Int (decimal)+import Data.Text.Lens+import Data.Vector (Vector)+import qualified Data.Vector as Vector+import Data.Vector.Lens (vector)+import GHC.Stack (prettyCallStack)+import Jaeger_Types+ ( Batch (..)+ , Log (..)+ , Process (..)+ , Span (..)+ , SpanRef (..)+ , Tag (..)+ )+import qualified Jaeger_Types as Thrift+import OpenTracing.Log+import OpenTracing.Span+import OpenTracing.Tags+import OpenTracing.Time+import OpenTracing.Types (TraceID (..))+++toThriftSpan :: FinishedSpan -> Thrift.Span+toThriftSpan s = Thrift.Span+ { span_traceIdLow = view (spanContext . to traceIdLo') s+ , span_traceIdHigh = view (spanContext . to traceIdHi') s+ , span_spanId = view (spanContext . to ctxSpanID') s+ , span_parentSpanId = maybe 0 (ctxSpanID' . refCtx) . findParent+ $ view spanRefs s+ , span_operationName = view (spanOperation . lazy) s+ , span_references = view ( spanRefs+ . to (map toThriftSpanRef . toList)+ . vector+ . re _Just+ )+ s+ , span_flags = view ( spanContext+ . ctxSampled+ . re _IsSampled+ . to (bool 0 1)+ )+ s+ , span_startTime = view (spanStart . to micros) s+ , span_duration = view (spanDuration . to micros) s+ , span_tags = view (spanTags . to toThriftTags . re _Just) s+ , span_logs = Just+ . Vector.fromList+ . foldr' (\r acc -> toThriftLog r : acc) []+ $ view spanLogs s+ , span_incomplete = Just False+ }++toThriftSpanRef :: Reference -> Thrift.SpanRef+toThriftSpanRef ref = Thrift.SpanRef+ { spanRef_refType = toThriftRefType ref+ , spanRef_traceIdLow = traceIdLo' (refCtx ref)+ , spanRef_traceIdHigh = traceIdHi' (refCtx ref)+ , spanRef_spanId = ctxSpanID' (refCtx ref)+ }++toThriftRefType :: Reference -> Thrift.SpanRefType+toThriftRefType (ChildOf _) = Thrift.CHILD_OF+toThriftRefType (FollowsFrom _) = Thrift.FOLLOWS_FROM++toThriftTags :: Tags -> Vector Thrift.Tag+toThriftTags = ifoldMap (\k v -> Vector.singleton (toThriftTag k v)) . fromTags++toThriftTag :: Text -> TagVal -> Thrift.Tag+-- acc. to https://github.com/opentracing/specification/blob/8d634bc7e3e73050f6ac1006858cddac8d9e0abe/semantic_conventions.yaml+-- "http.status_code" is supposed to be integer-valued. Jaeger, however, drops+-- the value (nb. _not_ the tag key) unless it is a string.+toThriftTag HttpStatusCodeKey (IntT v) = Thrift.default_Tag+ { tag_key = view lazy HttpStatusCodeKey+ , tag_vStr = Just . toLazyText . decimal $ v+ }+toThriftTag k v =+ let t = Thrift.default_Tag { tag_key = view lazy k }+ in case v of+ BoolT x -> t { tag_vBool = Just x }+ StringT x -> t { tag_vStr = Just (view lazy x) }+ IntT x -> t { tag_vLong = Just x }+ DoubleT x -> t { tag_vDouble = Just x }+ BinaryT x -> t { tag_vBinary = Just x }++toThriftLog :: LogRecord -> Thrift.Log+toThriftLog r = Thrift.Log+ { log_timestamp = view (logTime . to micros) r+ , log_fields = foldMap ( Vector.singleton+ . uncurry toThriftTag+ . asTag+ )+ $ view logFields r+ }+ where+ asTag f = (logFieldLabel f,) . StringT $ case f of+ LogField _ v -> view packed (show v)+ Event v -> v+ Message v -> v+ Stack v -> view packed (prettyCallStack v)+ ErrKind v -> v+ ErrObj v -> view packed (show v)++toThriftProcess :: Text -> Tags -> Thrift.Process+toThriftProcess srv tags = Thrift.Process+ { process_serviceName = view lazy srv+ , process_tags = Just $ toThriftTags tags+ }++toThriftBatch :: Thrift.Process -> Vector FinishedSpan -> Thrift.Batch+toThriftBatch tproc spans = Thrift.Batch+ { batch_process = tproc+ , batch_spans = toThriftSpan <$> spans+ }++traceIdLo' :: SpanContext -> Int64+traceIdLo' = fromIntegral . traceIdLo . ctxTraceID++traceIdHi' :: SpanContext -> Int64+traceIdHi' = maybe 0 fromIntegral . traceIdHi . ctxTraceID++ctxSpanID' :: SpanContext -> Int64+ctxSpanID' = fromIntegral . ctxSpanID