ClientSpec.hs

{-# LANGUAGE NamedFieldPuns, OverloadedStrings #-}

module Zipkin.ClientSpec (
    zipkinProps,
    zipkinSpec
    ) where

import Tracing.Zipkin
import Tracing.Core
import Instances()

import Data.Maybe (fromMaybe, maybe, isJust)
import Data.Aeson
import Data.Aeson.Types (parseMaybe)
import qualified Data.Text as T
import Test.HUnit
import Test.QuickCheck hiding (sample)
import Test.Tasty
import Test.Tasty.HUnit (testCase)
import Test.Tasty.QuickCheck (testProperty)
import Web.HttpApiData (parseUrlPiece)

zipkinProps :: TestTree
zipkinProps = testGroup "ZipkinProps" $  [
      testProperty "traceId always at least 16 chars long" $
        \s -> maybe False ((<=) 16 . T.length) . parseMaybe ( withObject "" ( .: "traceId") ) $ toJSON (ZipkinSpan (s :: Span))
    ,  testProperty "traceId never longer than 32 chars" $
        \s -> maybe False ((>=) 32 . T.length) . parseMaybe ( withObject "" ( .: "traceId") ) $ toJSON (ZipkinSpan (s :: Span))
    , testProperty "spanId always 16 chars long" $
        \s -> maybe False ((==) 16 . T.length) . parseMaybe ( withObject "" (.: "id") ) $ toJSON (ZipkinSpan (s :: Span))
    ]


zipkinSpec :: TestTree
zipkinSpec = testGroup "Zipkin Spec" $ [
    testCase "timestamp is in microseconds" $ do
        s <- generate arbitrary
        let fromMicros = maybe 0 (/ 1000000) . parseMaybe ( withObject "" (.: "timestamp") ) $ toJSON (ZipkinSpan (s :: Span))
        fromMicros @=? timestamp s
    , testCase "parentId set when a child Relation is present" $ do
        s <- generate arbitrary :: IO Span
        c <- generate arbitrary :: IO SpanContext
        let s' = s {relations = [ChildOf c]}
        let isPresent = maybe False (not . T.null) . parseMaybe ( withObject "" (.: "parentId") ) $ toJSON (ZipkinSpan s')
        isPresent @=? True
    , testCase "parentId set when a FollowsFrom Relation is present" $ do
        s <- generate arbitrary :: IO Span
        c <- generate arbitrary :: IO SpanContext
        let s' = s {relations = [FollowsFrom c]}
        let isPresent = maybe False (not . T.null) . parseMaybe ( withObject "" (.: "parentId") ) $ toJSON (ZipkinSpan s')
        isPresent @=? True
    , testCase "parentId unset when no Relation is present" $ do
        s <- generate arbitrary :: IO Span
        let s' = s {relations = []}
        let isPresent = maybe False (not . T.null) . parseMaybe ( withObject "" (.: "parentId") ) $ toJSON (ZipkinSpan s')
        isPresent @=? False
    ]