{-# 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 :: Endpoint -> LogFieldsFormatter -> FinishedSpan -> Span
toThriftSpan (Endpoint -> Endpoint
toThriftEndpoint -> Endpoint
loc) LogFieldsFormatter
logfmt FinishedSpan
s = Span :: Int64
-> Text
-> Int64
-> Maybe Int64
-> Vector Annotation
-> Vector BinaryAnnotation
-> Maybe Bool
-> Maybe Int64
-> Maybe Int64
-> Maybe Int64
-> Span
Thrift.Span
    { span_trace_id :: Int64
span_trace_id           = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SpanContext -> Const Int64 SpanContext)
-> FinishedSpan -> Const Int64 FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext ((SpanContext -> Const Int64 SpanContext)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64)
    -> SpanContext -> Const Int64 SpanContext)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpanContext -> Int64)
-> (Int64 -> Const Int64 Int64)
-> SpanContext
-> Const Int64 SpanContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SpanContext -> Int64
traceIdLo') FinishedSpan
s
    , span_trace_id_high :: Maybe Int64
span_trace_id_high      = Getting (Maybe Int64) FinishedSpan (Maybe Int64)
-> FinishedSpan -> Maybe Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SpanContext -> Const (Maybe Int64) SpanContext)
-> FinishedSpan -> Const (Maybe Int64) FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext ((SpanContext -> Const (Maybe Int64) SpanContext)
 -> FinishedSpan -> Const (Maybe Int64) FinishedSpan)
-> ((Maybe Int64 -> Const (Maybe Int64) (Maybe Int64))
    -> SpanContext -> Const (Maybe Int64) SpanContext)
-> Getting (Maybe Int64) FinishedSpan (Maybe Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpanContext -> Maybe Int64)
-> (Maybe Int64 -> Const (Maybe Int64) (Maybe Int64))
-> SpanContext
-> Const (Maybe Int64) SpanContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SpanContext -> Maybe Int64
traceIdHi') FinishedSpan
s
    , span_name :: Text
span_name               = Getting Text FinishedSpan Text -> FinishedSpan -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Text -> Const Text Text)
-> FinishedSpan -> Const Text FinishedSpan
forall a. HasSpanFields a => Lens' a Text
spanOperation ((Text -> Const Text Text)
 -> FinishedSpan -> Const Text FinishedSpan)
-> ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Getting Text FinishedSpan Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy) FinishedSpan
s
    , span_id :: Int64
span_id                 = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SpanContext -> Const Int64 SpanContext)
-> FinishedSpan -> Const Int64 FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext ((SpanContext -> Const Int64 SpanContext)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64)
    -> SpanContext -> Const Int64 SpanContext)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpanContext -> Int64)
-> (Int64 -> Const Int64 Int64)
-> SpanContext
-> Const Int64 SpanContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SpanContext -> Int64
ctxSpanID') FinishedSpan
s
    , span_parent_id :: Maybe Int64
span_parent_id          = Getting (Maybe Int64) FinishedSpan (Maybe Int64)
-> FinishedSpan -> Maybe Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((SpanContext -> Const (Maybe Int64) SpanContext)
-> FinishedSpan -> Const (Maybe Int64) FinishedSpan
forall a. HasSpanFields a => Lens' a SpanContext
spanContext ((SpanContext -> Const (Maybe Int64) SpanContext)
 -> FinishedSpan -> Const (Maybe Int64) FinishedSpan)
-> ((Maybe Int64 -> Const (Maybe Int64) (Maybe Int64))
    -> SpanContext -> Const (Maybe Int64) SpanContext)
-> Getting (Maybe Int64) FinishedSpan (Maybe Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpanContext -> Maybe Int64)
-> (Maybe Int64 -> Const (Maybe Int64) (Maybe Int64))
-> SpanContext
-> Const (Maybe Int64) SpanContext
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SpanContext -> Maybe Int64
ctxParentSpanID') FinishedSpan
s
    , span_annotations :: Vector Annotation
span_annotations        = Vector Annotation
annotations
    , span_binary_annotations :: Vector BinaryAnnotation
span_binary_annotations = Vector BinaryAnnotation
binaryAnnotations
    , span_debug :: Maybe Bool
span_debug              = Maybe Bool
forall a. Maybe a
Nothing
    , span_timestamp :: Maybe Int64
span_timestamp          = Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
tstart
    , span_duration :: Maybe Int64
span_duration           = Getting (Maybe Int64) FinishedSpan (Maybe Int64)
-> FinishedSpan -> Maybe Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((NominalDiffTime -> Const (Maybe Int64) NominalDiffTime)
-> FinishedSpan -> Const (Maybe Int64) FinishedSpan
Lens' FinishedSpan NominalDiffTime
spanDuration ((NominalDiffTime -> Const (Maybe Int64) NominalDiffTime)
 -> FinishedSpan -> Const (Maybe Int64) FinishedSpan)
-> ((Maybe Int64 -> Const (Maybe Int64) (Maybe Int64))
    -> NominalDiffTime -> Const (Maybe Int64) NominalDiffTime)
-> Getting (Maybe Int64) FinishedSpan (Maybe Int64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime -> Int64)
-> Optic' (->) (Const (Maybe Int64)) NominalDiffTime Int64
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to NominalDiffTime -> Int64
forall a b. (AsMicros a, Integral b) => a -> b
micros Optic' (->) (Const (Maybe Int64)) NominalDiffTime Int64
-> ((Maybe Int64 -> Const (Maybe Int64) (Maybe Int64))
    -> Int64 -> Const (Maybe Int64) Int64)
-> (Maybe Int64 -> Const (Maybe Int64) (Maybe Int64))
-> NominalDiffTime
-> Const (Maybe Int64) NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview (Maybe Int64) Int64 -> Getter Int64 (Maybe Int64)
forall t b. AReview t b -> Getter b t
re AReview (Maybe Int64) Int64
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) FinishedSpan
s
    }
  where
    tstart :: Int64
tstart = Getting Int64 FinishedSpan Int64 -> FinishedSpan -> Int64
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((UTCTime -> Const Int64 UTCTime)
-> FinishedSpan -> Const Int64 FinishedSpan
forall a. HasSpanFields a => Lens' a UTCTime
spanStart ((UTCTime -> Const Int64 UTCTime)
 -> FinishedSpan -> Const Int64 FinishedSpan)
-> ((Int64 -> Const Int64 Int64) -> UTCTime -> Const Int64 UTCTime)
-> Getting Int64 FinishedSpan Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime -> Int64)
-> (Int64 -> Const Int64 Int64) -> UTCTime -> Const Int64 UTCTime
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to UTCTime -> Int64
forall a b. (AsMicros a, Integral b) => a -> b
micros) FinishedSpan
s

    (Vector Annotation
annotations, Vector BinaryAnnotation
binaryAnnotations)
        = ([Annotation] -> Vector Annotation)
-> ([BinaryAnnotation] -> Vector BinaryAnnotation)
-> ([Annotation], [BinaryAnnotation])
-> (Vector Annotation, Vector BinaryAnnotation)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap [Annotation] -> Vector Annotation
forall a. [a] -> Vector a
Vector.fromList [BinaryAnnotation] -> Vector BinaryAnnotation
forall a. [a] -> Vector a
Vector.fromList
        (([Annotation], [BinaryAnnotation])
 -> (Vector Annotation, Vector BinaryAnnotation))
-> (([Annotation], [BinaryAnnotation])
    -> ([Annotation], [BinaryAnnotation]))
-> ([Annotation], [BinaryAnnotation])
-> (Vector Annotation, Vector BinaryAnnotation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Annotation] -> [Annotation])
-> ([Annotation], [BinaryAnnotation])
-> ([Annotation], [BinaryAnnotation])
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([Annotation] -> [Annotation] -> [Annotation]
forall a. Semigroup a => a -> a -> a
<> [LogRecord] -> [Annotation]
annFromLogs (Getting [LogRecord] FinishedSpan [LogRecord]
-> FinishedSpan -> [LogRecord]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting [LogRecord] FinishedSpan [LogRecord]
forall a. HasSpanFields a => Lens' a [LogRecord]
spanLogs FinishedSpan
s))
        (([Annotation], [BinaryAnnotation])
 -> (Vector Annotation, Vector BinaryAnnotation))
-> ([Annotation], [BinaryAnnotation])
-> (Vector Annotation, Vector BinaryAnnotation)
forall a b. (a -> b) -> a -> b
$ Tags -> ([Annotation], [BinaryAnnotation])
annFromTags (Getting Tags FinishedSpan Tags -> FinishedSpan -> Tags
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Tags FinishedSpan Tags
forall a. HasSpanFields a => Lens' a Tags
spanTags FinishedSpan
s)

    annFromTags :: Tags -> ([Thrift.Annotation], [Thrift.BinaryAnnotation])
    annFromTags :: Tags -> ([Annotation], [BinaryAnnotation])
annFromTags = ([Annotation], [BinaryAnnotation])
-> ([Annotation], [BinaryAnnotation])
forall a. ([a], [BinaryAnnotation]) -> ([a], [BinaryAnnotation])
perhapsLocal (([Annotation], [BinaryAnnotation])
 -> ([Annotation], [BinaryAnnotation]))
-> (Tags -> ([Annotation], [BinaryAnnotation]))
-> Tags
-> ([Annotation], [BinaryAnnotation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Annotation], [BinaryAnnotation])
 -> Tag -> ([Annotation], [BinaryAnnotation]))
-> ([Annotation], [BinaryAnnotation])
-> [Tag]
-> ([Annotation], [BinaryAnnotation])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ([Annotation], [BinaryAnnotation])
-> Tag -> ([Annotation], [BinaryAnnotation])
forall (p :: * -> * -> *).
Bifunctor p =>
p [Annotation] [BinaryAnnotation]
-> Tag -> p [Annotation] [BinaryAnnotation]
go ([],[]) ([Tag] -> ([Annotation], [BinaryAnnotation]))
-> (Tags -> [Tag]) -> Tags -> ([Annotation], [BinaryAnnotation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text TagVal -> [Tag]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap Text TagVal -> [Tag])
-> (Tags -> HashMap Text TagVal) -> Tags -> [Tag]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tags -> HashMap Text TagVal
fromTags
      where
        go :: p [Annotation] [BinaryAnnotation]
-> Tag -> p [Annotation] [BinaryAnnotation]
go p [Annotation] [BinaryAnnotation]
acc (SpanKind SpanKinds
sk) =
            let ann :: Annotation
ann = Annotation :: Int64 -> Text -> Maybe Endpoint -> Annotation
Thrift.Annotation
                    { annotation_timestamp :: Int64
annotation_timestamp = Int64
tstart
                    , annotation_host :: Maybe Endpoint
annotation_host      = Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just Endpoint
loc
                    , annotation_value :: Text
annotation_value     = case SpanKinds
sk of
                          SpanKinds
RPCClient -> Text
Thrift.cLIENT_SEND
                          SpanKinds
RPCServer -> Text
Thrift.sERVER_RECV
                          SpanKinds
Producer  -> Text
Thrift.mESSAGE_SEND
                          SpanKinds
Consumer  -> Text
Thrift.mESSAGE_RECV
                    }
             in ([Annotation] -> [Annotation])
-> p [Annotation] [BinaryAnnotation]
-> p [Annotation] [BinaryAnnotation]
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Annotation
annAnnotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
:) p [Annotation] [BinaryAnnotation]
acc

        go p [Annotation] [BinaryAnnotation]
acc (Text
k,TagVal
v) =
            let (AnnotationType
anntyp, ByteString
annval) = TagVal -> (AnnotationType, ByteString)
toThriftTag TagVal
v
                ann :: BinaryAnnotation
ann              = BinaryAnnotation :: Text
-> ByteString
-> AnnotationType
-> Maybe Endpoint
-> BinaryAnnotation
Thrift.BinaryAnnotation
                    { binaryAnnotation_key :: Text
binaryAnnotation_key             = ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy Text
k
                    , binaryAnnotation_value :: ByteString
binaryAnnotation_value           = ByteString
annval
                    , binaryAnnotation_annotation_type :: AnnotationType
binaryAnnotation_annotation_type = AnnotationType
anntyp
                    , binaryAnnotation_host :: Maybe Endpoint
binaryAnnotation_host            = Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just Endpoint
loc
                    }
             in ([BinaryAnnotation] -> [BinaryAnnotation])
-> p [Annotation] [BinaryAnnotation]
-> p [Annotation] [BinaryAnnotation]
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (BinaryAnnotation
annBinaryAnnotation -> [BinaryAnnotation] -> [BinaryAnnotation]
forall a. a -> [a] -> [a]
:) p [Annotation] [BinaryAnnotation]
acc

        -- if we don't have a 'SpanKind', we're supposed to tell Zipkin about us
        -- via a 'BinaryAnnotation'
        perhapsLocal :: ([a], [BinaryAnnotation]) -> ([a], [BinaryAnnotation])
perhapsLocal ([],[BinaryAnnotation]
bs) = ([],) ([BinaryAnnotation] -> ([a], [BinaryAnnotation]))
-> (BinaryAnnotation -> [BinaryAnnotation])
-> BinaryAnnotation
-> ([a], [BinaryAnnotation])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinaryAnnotation -> [BinaryAnnotation] -> [BinaryAnnotation]
forall a. a -> [a] -> [a]
:[BinaryAnnotation]
bs) (BinaryAnnotation -> ([a], [BinaryAnnotation]))
-> BinaryAnnotation -> ([a], [BinaryAnnotation])
forall a b. (a -> b) -> a -> b
$ BinaryAnnotation :: Text
-> ByteString
-> AnnotationType
-> Maybe Endpoint
-> BinaryAnnotation
Thrift.BinaryAnnotation
            { binaryAnnotation_key :: Text
binaryAnnotation_key             = Text
Thrift.lOCAL_COMPONENT
            , binaryAnnotation_value :: ByteString
binaryAnnotation_value           = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Endpoint -> Text
endpoint_service_name Endpoint
loc
            , binaryAnnotation_annotation_type :: AnnotationType
binaryAnnotation_annotation_type = AnnotationType
Thrift.STRING
            , binaryAnnotation_host :: Maybe Endpoint
binaryAnnotation_host            = Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just Endpoint
loc
            }
        perhapsLocal ([a], [BinaryAnnotation])
xs = ([a], [BinaryAnnotation])
xs

    annFromLogs :: [LogRecord] -> [Thrift.Annotation]
    annFromLogs :: [LogRecord] -> [Annotation]
annFromLogs = ([Annotation] -> LogRecord -> [Annotation])
-> [Annotation] -> [LogRecord] -> [Annotation]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Annotation] -> LogRecord -> [Annotation]
go []
      where
        go :: [Annotation] -> LogRecord -> [Annotation]
go [Annotation]
acc (LogRecord UTCTime
t NonEmpty LogField
fs) = Annotation :: Int64 -> Text -> Maybe Endpoint -> Annotation
Thrift.Annotation
            { annotation_timestamp :: Int64
annotation_timestamp = UTCTime -> Int64
forall a b. (AsMicros a, Integral b) => a -> b
micros UTCTime
t
            , annotation_host :: Maybe Endpoint
annotation_host      = Endpoint -> Maybe Endpoint
forall a. a -> Maybe a
Just Endpoint
loc
            , annotation_value :: Text
annotation_value     = case NonEmpty LogField
fs of
                  (Event Text
x :| []) -> ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy Text
x -- proper zipkin annotation
                  NonEmpty LogField
fields          -> ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
toLazyByteString (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty LogField -> Builder
LogFieldsFormatter
logfmt NonEmpty LogField
fields
            }
            Annotation -> [Annotation] -> [Annotation]
forall a. a -> [a] -> [a]
: [Annotation]
acc

thriftEncodeSpan :: Thrift.Span -> Lazy.ByteString
thriftEncodeSpan :: Span -> ByteString
thriftEncodeSpan = BinaryProtocol EmptyTransport -> Span -> ByteString
forall p. StatelessProtocol p => p -> Span -> ByteString
Thrift.encode_Span (EmptyTransport -> BinaryProtocol EmptyTransport
forall a. Transport a => a -> BinaryProtocol a
BinaryProtocol EmptyTransport
EmptyTransport)

thriftEncodeSpans :: Traversable t => t Thrift.Span -> Lazy.ByteString
thriftEncodeSpans :: t Span -> ByteString
thriftEncodeSpans
    = ThriftVal -> ByteString
thriftEncodeVal
    (ThriftVal -> ByteString)
-> (t Span -> ThriftVal) -> t Span -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ThriftType -> [ThriftVal] -> ThriftVal
TList (TypeMap -> ThriftType
T_STRUCT TypeMap
Thrift.typemap_Span)
    ([ThriftVal] -> ThriftVal)
-> (t Span -> [ThriftVal]) -> t Span -> ThriftVal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t ThriftVal -> [ThriftVal]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
    (t ThriftVal -> [ThriftVal])
-> (t Span -> t ThriftVal) -> t Span -> [ThriftVal]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Span -> ThriftVal) -> t Span -> t ThriftVal
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Span -> ThriftVal
Thrift.from_Span

thriftEncodeVal :: ThriftVal -> Lazy.ByteString
thriftEncodeVal :: ThriftVal -> ByteString
thriftEncodeVal = BinaryProtocol EmptyTransport -> ThriftVal -> ByteString
forall a. StatelessProtocol a => a -> ThriftVal -> ByteString
Thrift.serializeVal (EmptyTransport -> BinaryProtocol EmptyTransport
forall a. Transport a => a -> BinaryProtocol a
BinaryProtocol EmptyTransport
EmptyTransport)

toThriftTag :: TagVal -> (Thrift.AnnotationType, Lazy.ByteString)
toThriftTag :: TagVal -> (AnnotationType, ByteString)
toThriftTag (BoolT   Bool
v) = (AnnotationType
Thrift.BOOL, if Bool
v then ByteString
"1" else ByteString
"0")
toThriftTag (StringT Text
v) = (AnnotationType
Thrift.STRING, Getting ByteString Text ByteString -> Text -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Text -> Const ByteString Text) -> Text -> Const ByteString Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy ((Text -> Const ByteString Text) -> Text -> Const ByteString Text)
-> ((ByteString -> Const ByteString ByteString)
    -> Text -> Const ByteString Text)
-> Getting ByteString Text ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> ByteString)
-> (ByteString -> Const ByteString ByteString)
-> Text
-> Const ByteString Text
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Text -> ByteString
encodeUtf8) Text
v)
toThriftTag (IntT    Int64
v) = (AnnotationType
Thrift.I64, Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Int64 -> Builder) -> Int64 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Builder
int64BE (Int64 -> ByteString) -> Int64 -> ByteString
forall a b. (a -> b) -> a -> b
$ Int64
v)
toThriftTag (DoubleT Double
v) = (AnnotationType
Thrift.DOUBLE, Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Double -> Builder) -> Double -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Builder
doubleBE (Double -> ByteString) -> Double -> ByteString
forall a b. (a -> b) -> a -> b
$ Double
v)
toThriftTag (BinaryT ByteString
v) = (AnnotationType
Thrift.BYTES, ByteString
v)

toThriftEndpoint :: Endpoint -> Thrift.Endpoint
toThriftEndpoint :: Endpoint -> Endpoint
toThriftEndpoint Endpoint{Maybe IPv6
Maybe Port
Text
IPv4
serviceName :: Endpoint -> Text
ipv4 :: Endpoint -> IPv4
ipv6 :: Endpoint -> Maybe IPv6
port :: Endpoint -> Maybe Port
port :: Maybe Port
ipv6 :: Maybe IPv6
ipv4 :: IPv4
serviceName :: Text
..} = Endpoint :: Int32 -> Int16 -> Text -> Maybe ByteString -> Endpoint
Thrift.Endpoint
    { endpoint_ipv4 :: Int32
endpoint_ipv4         = IPv4 -> Int32
packIPv4 (IPv4 -> Int32) -> IPv4 -> Int32
forall a b. (a -> b) -> a -> b
$ IPv4 -> IPv4
fromIPv4 IPv4
ipv4
    , endpoint_port :: Int16
endpoint_port         = Int16 -> (Port -> Int16) -> Maybe Port -> Int16
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int16
0 (Word16 -> Int16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int16) -> (Port -> Word16) -> Port -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Port -> Word16
fromPort) Maybe Port
port
    , endpoint_service_name :: Text
endpoint_service_name = ((Text -> Const Text Text) -> Text -> Const Text Text)
-> Text -> Text
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Text -> Const Text Text) -> Text -> Const Text Text
forall lazy strict. Strict lazy strict => Iso' strict lazy
lazy Text
serviceName
    , endpoint_ipv6 :: Maybe ByteString
endpoint_ipv6         = IPv6 -> ByteString
packIPv6 (IPv6 -> ByteString) -> (IPv6 -> IPv6) -> IPv6 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> IPv6
fromIPv6 (IPv6 -> ByteString) -> Maybe IPv6 -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IPv6
ipv6
    }
  where
    packIPv4 :: IP.IPv4 -> Int32
    packIPv4 :: IPv4 -> Int32
packIPv4 IPv4
ip =
        let [Int
a,Int
b,Int
c,Int
d] = IPv4 -> [Int]
IP.fromIPv4 IPv4
ip
         in Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Int
a Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
24 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
b Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
16 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
c Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8 Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
d

    packIPv6 :: IP.IPv6 -> Lazy.ByteString
    packIPv6 :: IPv6 -> ByteString
packIPv6 = Getting ByteString [Word8] ByteString -> [Word8] -> ByteString
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting ByteString [Word8] ByteString
forall t. IsByteString t => Iso' [Word8] t
packedBytes ([Word8] -> ByteString) -> (IPv6 -> [Word8]) -> IPv6 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word8) -> [Int] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Int] -> [Word8]) -> (IPv6 -> [Int]) -> IPv6 -> [Word8]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPv6 -> [Int]
IP.fromIPv6b


traceIdLo' :: SpanContext -> Int64
traceIdLo' :: SpanContext -> Int64
traceIdLo' = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64)
-> (SpanContext -> Word64) -> SpanContext -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceID -> Word64
traceIdLo (TraceID -> Word64)
-> (SpanContext -> TraceID) -> SpanContext -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> TraceID
ctxTraceID

traceIdHi' :: SpanContext -> Maybe Int64
traceIdHi' :: SpanContext -> Maybe Int64
traceIdHi' = (Word64 -> Int64) -> Maybe Word64 -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Word64 -> Maybe Int64)
-> (SpanContext -> Maybe Word64) -> SpanContext -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TraceID -> Maybe Word64
traceIdHi (TraceID -> Maybe Word64)
-> (SpanContext -> TraceID) -> SpanContext -> Maybe Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> TraceID
ctxTraceID

ctxSpanID' :: SpanContext -> Int64
ctxSpanID' :: SpanContext -> Int64
ctxSpanID' = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64)
-> (SpanContext -> Word64) -> SpanContext -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> Word64
ctxSpanID

ctxParentSpanID' :: SpanContext -> Maybe Int64
ctxParentSpanID' :: SpanContext -> Maybe Int64
ctxParentSpanID' = (Word64 -> Int64) -> Maybe Word64 -> Maybe Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe Word64 -> Maybe Int64)
-> (SpanContext -> Maybe Word64) -> SpanContext -> Maybe Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpanContext -> Maybe Word64
ctxParentSpanID