{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}

module OpenTracing.Zipkin.Types
    ( Endpoint (..)

    , defaultZipkinAddr
    )
where

import Data.Aeson
import Data.Aeson.Encoding
import Data.Maybe          (catMaybes)
import Data.Text           (Text)
import GHC.Generics        (Generic)
import OpenTracing.Types


data Endpoint = Endpoint
    { Endpoint -> Text
serviceName :: Text
    , Endpoint -> IPv4
ipv4        :: IPv4
    , Endpoint -> Maybe IPv6
ipv6        :: Maybe IPv6
    , Endpoint -> Maybe Port
port        :: Maybe Port
    } deriving (Endpoint -> Endpoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Endpoint -> Endpoint -> Bool
$c/= :: Endpoint -> Endpoint -> Bool
== :: Endpoint -> Endpoint -> Bool
$c== :: Endpoint -> Endpoint -> Bool
Eq, Int -> Endpoint -> ShowS
[Endpoint] -> ShowS
Endpoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Endpoint] -> ShowS
$cshowList :: [Endpoint] -> ShowS
show :: Endpoint -> String
$cshow :: Endpoint -> String
showsPrec :: Int -> Endpoint -> ShowS
$cshowsPrec :: Int -> Endpoint -> ShowS
Show, forall x. Rep Endpoint x -> Endpoint
forall x. Endpoint -> Rep Endpoint x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Endpoint x -> Endpoint
$cfrom :: forall x. Endpoint -> Rep Endpoint x
Generic)

instance ToJSON Endpoint where
    toEncoding :: Endpoint -> Encoding
toEncoding Endpoint{Maybe IPv6
Maybe Port
Text
IPv4
port :: Maybe Port
ipv6 :: Maybe IPv6
ipv4 :: IPv4
serviceName :: Text
port :: Endpoint -> Maybe Port
ipv6 :: Endpoint -> Maybe IPv6
ipv4 :: Endpoint -> IPv4
serviceName :: Endpoint -> Text
..} = Series -> Encoding
pairs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$
        [ Key -> Encoding -> Series
pair Key
"serviceName" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Text -> Encoding' a
text forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just Text
serviceName
        , Key -> Encoding -> Series
pair Key
"ipv4" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
toEncoding  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> Maybe a
Just IPv4
ipv4
        , Key -> Encoding -> Series
pair Key
"ipv6" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
toEncoding  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe IPv6
ipv6
        , Key -> Encoding -> Series
pair Key
"port" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
toEncoding  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Port
port
        ]

defaultZipkinAddr :: Addr 'HTTP
defaultZipkinAddr :: Addr 'HTTP
defaultZipkinAddr = String -> Port -> Bool -> Addr 'HTTP
HTTPAddr String
"127.0.0.1" Port
9411 Bool
False