opentracing-zipkin-v1 (empty) → 0.1.0.0
raw patch · 9 files changed
+969/−0 lines, 9 filesdep +QuickCheckdep +basedep +bytestring
Dependencies added: QuickCheck, base, bytestring, exceptions, hashable, http-client, http-types, iproute, lens, opentracing, opentracing-zipkin-common, text, thrift, unordered-containers, vector
Files
- CHANGELOG.md +3/−0
- LICENSE +202/−0
- README.md +0/−0
- gen-src/ZipkinCore_Consts.hs +116/−0
- gen-src/ZipkinCore_Types.hs +293/−0
- opentracing-zipkin-v1.cabal +56/−0
- src/OpenTracing/Zipkin/V1.hs +6/−0
- src/OpenTracing/Zipkin/V1/HttpReporter.hs +120/−0
- src/OpenTracing/Zipkin/V1/Thrift.hs +173/−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/ZipkinCore_Consts.hs view
@@ -0,0 +1,116 @@+{-# 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_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 ZipkinCore_Types+cLIENT_SEND :: LT.Text+cLIENT_SEND = "cs"++cLIENT_RECV :: LT.Text+cLIENT_RECV = "cr"++sERVER_SEND :: LT.Text+sERVER_SEND = "ss"++sERVER_RECV :: LT.Text+sERVER_RECV = "sr"++mESSAGE_SEND :: LT.Text+mESSAGE_SEND = "ms"++mESSAGE_RECV :: LT.Text+mESSAGE_RECV = "mr"++wIRE_SEND :: LT.Text+wIRE_SEND = "ws"++wIRE_RECV :: LT.Text+wIRE_RECV = "wr"++cLIENT_SEND_FRAGMENT :: LT.Text+cLIENT_SEND_FRAGMENT = "csf"++cLIENT_RECV_FRAGMENT :: LT.Text+cLIENT_RECV_FRAGMENT = "crf"++sERVER_SEND_FRAGMENT :: LT.Text+sERVER_SEND_FRAGMENT = "ssf"++sERVER_RECV_FRAGMENT :: LT.Text+sERVER_RECV_FRAGMENT = "srf"++hTTP_HOST :: LT.Text+hTTP_HOST = "http.host"++hTTP_METHOD :: LT.Text+hTTP_METHOD = "http.method"++hTTP_PATH :: LT.Text+hTTP_PATH = "http.path"++hTTP_ROUTE :: LT.Text+hTTP_ROUTE = "http.route"++hTTP_URL :: LT.Text+hTTP_URL = "http.url"++hTTP_STATUS_CODE :: LT.Text+hTTP_STATUS_CODE = "http.status_code"++hTTP_REQUEST_SIZE :: LT.Text+hTTP_REQUEST_SIZE = "http.request.size"++hTTP_RESPONSE_SIZE :: LT.Text+hTTP_RESPONSE_SIZE = "http.response.size"++lOCAL_COMPONENT :: LT.Text+lOCAL_COMPONENT = "lc"++eRROR :: LT.Text+eRROR = "error"++cLIENT_ADDR :: LT.Text+cLIENT_ADDR = "ca"++sERVER_ADDR :: LT.Text+sERVER_ADDR = "sa"++mESSAGE_ADDR :: LT.Text+mESSAGE_ADDR = "ma"+
+ gen-src/ZipkinCore_Types.hs view
@@ -0,0 +1,293 @@+{-# 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}
+ opentracing-zipkin-v1.cabal view
@@ -0,0 +1,56 @@+cabal-version: 2.2++name: opentracing-zipkin-v1+version: 0.1.0.0+synopsis: Zipkin V1 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.Zipkin.V1+ OpenTracing.Zipkin.V1.HttpReporter+ OpenTracing.Zipkin.V1.Thrift+ other-modules:+ ZipkinCore_Consts+ 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 >= 2.14+ , base >= 4.9 && < 4.16+ , bytestring >= 0.10+ , exceptions >= 0.8+ , hashable >= 1.2+ , http-client >= 0.5+ , http-types >= 0.9+ , iproute >= 1.7+ , lens >= 4.19+ , opentracing >= 0.1+ , opentracing-zipkin-common >= 0.1+ , text >= 1.2+ , thrift == 0.13.0+ , unordered-containers >= 0.2+ , vector >= 0.12+ default-language: Haskell2010
+ src/OpenTracing/Zipkin/V1.hs view
@@ -0,0 +1,6 @@+module OpenTracing.Zipkin.V1+ ( module OpenTracing.Zipkin.V1.HttpReporter+ )+where++import OpenTracing.Zipkin.V1.HttpReporter
+ src/OpenTracing/Zipkin/V1/HttpReporter.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TemplateHaskell #-}++module OpenTracing.Zipkin.V1.HttpReporter+ ( ZipkinOptions+ , zipkinOptions+ , zoManager+ , zoLocalEndpoint+ , zoEndpoint+ , zoLogfmt+ , zoErrorLog++ , defaultZipkinEndpoint+ , defaultZipkinAddr++ , Zipkin+ , newZipkin+ , closeZipkin+ , withZipkin++ , zipkinHttpReporter++ , Endpoint(..)++ , newManager+ , defaultManagerSettings+ )+where++import Control.Lens hiding (Context)+import Control.Monad (unless)+import Control.Monad.Catch+import Control.Monad.IO.Class+import Data.ByteString.Builder+import Data.Monoid+import Network.HTTP.Client hiding (port)+import Network.HTTP.Types+import OpenTracing.Log+import OpenTracing.Reporting+import OpenTracing.Span+import OpenTracing.Types+import OpenTracing.Zipkin.Types+import OpenTracing.Zipkin.V1.Thrift+++newtype Zipkin = Zipkin { fromZipkin :: BatchEnv }++data ZipkinOptions = ZipkinOptions+ { _zoManager :: Manager+ , _zoLocalEndpoint :: Endpoint+ , _zoEndpoint :: String+ , _zoLogfmt :: forall t. Foldable t => t LogField -> Builder -- == LogFieldsFormatter+ , _zoErrorLog :: Builder -> IO ()+ }++makeLenses ''ZipkinOptions++zipkinOptions :: Manager -> Endpoint -> ZipkinOptions+zipkinOptions mgr loc = ZipkinOptions+ { _zoManager = mgr+ , _zoLocalEndpoint = loc+ , _zoEndpoint = defaultZipkinEndpoint+ , _zoLogfmt = jsonMap+ , _zoErrorLog = defaultErrorLog+ }++defaultZipkinEndpoint :: String+defaultZipkinEndpoint = "http://"+ <> view addrHostName addr+ <> ":"+ <> show (view addrPort addr)+ <> "/api/v1/spans"+ where+ addr = defaultZipkinAddr++newZipkin :: ZipkinOptions -> IO Zipkin+newZipkin opts@ZipkinOptions{_zoEndpoint=endpoint, _zoErrorLog=errlog} = do+ rq <- mkReq+ fmap Zipkin+ . newBatchEnv+ . set boptErrorLog errlog . batchOptions+ $ reporter opts rq+ where+ mkReq = do+ rq <- parseRequest endpoint+ return rq { requestHeaders = [(hContentType, "application/x-thrift")] }++closeZipkin :: Zipkin -> IO ()+closeZipkin = closeBatchEnv . fromZipkin++withZipkin+ :: ( MonadIO m+ , MonadMask m+ )+ => ZipkinOptions+ -> (Zipkin -> m a)+ -> m a+withZipkin opts = bracket (liftIO $ newZipkin opts) (liftIO . closeZipkin)+++zipkinHttpReporter :: MonadIO m => Zipkin -> FinishedSpan -> m ()+zipkinHttpReporter = batchReporter . fromZipkin++reporter :: ZipkinOptions -> Request -> [FinishedSpan] -> IO ()+reporter ZipkinOptions{..} rq spans = do+ rs <- responseStatus <$> httpLbs rq { requestBody = body } _zoManager+ unless (statusIsSuccessful rs) $+ _zoErrorLog $ shortByteString "Error from Zipkin server: "+ <> intDec (statusCode rs)+ <> char8 '\n'+ where+ body = RequestBodyLBS+ . thriftEncodeSpans+ . map (toThriftSpan _zoLocalEndpoint _zoLogfmt)+ $ spans
+ src/OpenTracing/Zipkin/V1/Thrift.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-}++{-# OPTIONS_GHC -fno-warn-incomplete-uni-patterns #-}++module OpenTracing.Zipkin.V1.Thrift+ ( toThriftSpan++ , thriftEncodeSpan+ , thriftEncodeSpans+ )+where++import Control.Lens+import Data.Bifunctor+import Data.Bits+import Data.ByteString.Builder+import qualified Data.ByteString.Lazy as Lazy+import Data.ByteString.Lens+import Data.Foldable (foldl', toList)+import qualified Data.HashMap.Strict as HashMap+import Data.Int+import qualified Data.IP as IP+import Data.List.NonEmpty (NonEmpty (..))+import Data.Semigroup ((<>))+import Data.Text.Lazy.Encoding (decodeUtf8, encodeUtf8)+import qualified Data.Vector as Vector+import OpenTracing.Log+import OpenTracing.Span+import OpenTracing.Tags+import OpenTracing.Time+import OpenTracing.Types+import OpenTracing.Zipkin.Types (Endpoint (..))+import qualified Thrift+import Thrift.Protocol.Binary+import Thrift.Transport.Empty+import Thrift.Types+import qualified ZipkinCore_Consts as Thrift+import ZipkinCore_Types+ ( Annotation (..)+ , BinaryAnnotation (..)+ , Span (..)+ , endpoint_ipv4+ , endpoint_ipv6+ , endpoint_port+ , endpoint_service_name+ )+import qualified ZipkinCore_Types as Thrift+++toThriftSpan+ :: Endpoint+ -> LogFieldsFormatter+ -> FinishedSpan+ -> Thrift.Span+toThriftSpan (toThriftEndpoint -> loc) logfmt s = Thrift.Span+ { span_trace_id = view (spanContext . to traceIdLo') s+ , span_trace_id_high = view (spanContext . to traceIdHi') s+ , span_name = view (spanOperation . lazy) s+ , span_id = view (spanContext . to ctxSpanID') s+ , span_parent_id = view (spanContext . to ctxParentSpanID') s+ , span_annotations = annotations+ , span_binary_annotations = binaryAnnotations+ , span_debug = Nothing+ , span_timestamp = Just tstart+ , span_duration = view (spanDuration . to micros . re _Just) s+ }+ where+ tstart = view (spanStart . to micros) s++ (annotations, binaryAnnotations)+ = bimap Vector.fromList Vector.fromList+ . first (<> annFromLogs (view spanLogs s))+ $ annFromTags (view spanTags s)++ annFromTags :: Tags -> ([Thrift.Annotation], [Thrift.BinaryAnnotation])+ annFromTags = perhapsLocal . foldl' go ([],[]) . HashMap.toList . fromTags+ where+ go acc (SpanKind sk) =+ let ann = Thrift.Annotation+ { annotation_timestamp = tstart+ , annotation_host = Just loc+ , annotation_value = case sk of+ RPCClient -> Thrift.cLIENT_SEND+ RPCServer -> Thrift.sERVER_RECV+ Producer -> Thrift.mESSAGE_SEND+ Consumer -> Thrift.mESSAGE_RECV+ }+ in first (ann:) acc++ go acc (k,v) =+ let (anntyp, annval) = toThriftTag v+ ann = Thrift.BinaryAnnotation+ { binaryAnnotation_key = view lazy k+ , binaryAnnotation_value = annval+ , binaryAnnotation_annotation_type = anntyp+ , binaryAnnotation_host = Just loc+ }+ in second (ann:) acc++ -- if we don't have a 'SpanKind', we're supposed to tell Zipkin about us+ -- via a 'BinaryAnnotation'+ perhapsLocal ([],bs) = ([],) . (:bs) $ Thrift.BinaryAnnotation+ { binaryAnnotation_key = Thrift.lOCAL_COMPONENT+ , binaryAnnotation_value = encodeUtf8 $ endpoint_service_name loc+ , binaryAnnotation_annotation_type = Thrift.STRING+ , binaryAnnotation_host = Just loc+ }+ perhapsLocal xs = xs++ annFromLogs :: [LogRecord] -> [Thrift.Annotation]+ annFromLogs = foldl' go []+ where+ go acc (LogRecord t fs) = Thrift.Annotation+ { annotation_timestamp = micros t+ , annotation_host = Just loc+ , annotation_value = case fs of+ (Event x :| []) -> view lazy x -- proper zipkin annotation+ fields -> decodeUtf8 . toLazyByteString $ logfmt fields+ }+ : acc++thriftEncodeSpan :: Thrift.Span -> Lazy.ByteString+thriftEncodeSpan = Thrift.encode_Span (BinaryProtocol EmptyTransport)++thriftEncodeSpans :: Traversable t => t Thrift.Span -> Lazy.ByteString+thriftEncodeSpans+ = thriftEncodeVal+ . TList (T_STRUCT Thrift.typemap_Span)+ . toList+ . fmap Thrift.from_Span++thriftEncodeVal :: ThriftVal -> Lazy.ByteString+thriftEncodeVal = Thrift.serializeVal (BinaryProtocol EmptyTransport)++toThriftTag :: TagVal -> (Thrift.AnnotationType, Lazy.ByteString)+toThriftTag (BoolT v) = (Thrift.BOOL, if v then "1" else "0")+toThriftTag (StringT v) = (Thrift.STRING, view (lazy . to encodeUtf8) v)+toThriftTag (IntT v) = (Thrift.I64, toLazyByteString . int64BE $ v)+toThriftTag (DoubleT v) = (Thrift.DOUBLE, toLazyByteString . doubleBE $ v)+toThriftTag (BinaryT v) = (Thrift.BYTES, v)++toThriftEndpoint :: Endpoint -> Thrift.Endpoint+toThriftEndpoint Endpoint{..} = Thrift.Endpoint+ { endpoint_ipv4 = packIPv4 $ fromIPv4 ipv4+ , endpoint_port = maybe 0 (fromIntegral . fromPort) port+ , endpoint_service_name = view lazy serviceName+ , endpoint_ipv6 = packIPv6 . fromIPv6 <$> ipv6+ }+ where+ packIPv4 :: IP.IPv4 -> Int32+ packIPv4 ip =+ let [a,b,c,d] = IP.fromIPv4 ip+ in fromIntegral $ a `shiftL` 24 .|. b `shiftL` 16 .|. c `shiftL` 8 .|. d++ packIPv6 :: IP.IPv6 -> Lazy.ByteString+ packIPv6 = view packedBytes . map fromIntegral . IP.fromIPv6b+++traceIdLo' :: SpanContext -> Int64+traceIdLo' = fromIntegral . traceIdLo . ctxTraceID++traceIdHi' :: SpanContext -> Maybe Int64+traceIdHi' = fmap fromIntegral . traceIdHi . ctxTraceID++ctxSpanID' :: SpanContext -> Int64+ctxSpanID' = fromIntegral . ctxSpanID++ctxParentSpanID' :: SpanContext -> Maybe Int64+ctxParentSpanID' = fmap fromIntegral . ctxParentSpanID