aws-xray-client (empty) → 0.1.0.0
raw patch · 13 files changed
+1197/−0 lines, 13 filesdep +QuickCheckdep +aesondep +aeson-qq
Dependencies added: QuickCheck, aeson, aeson-qq, async, aws-xray-client, base, bytestring, criterion, deepseq, generic-arbitrary, hspec, http-types, lens, network, random, text, time
Files
- CHANGELOG.md +7/−0
- README.md +3/−0
- aws-xray-client.cabal +113/−0
- benchmarks/Bench.hs +81/−0
- library/Network/AWS/XRayClient.hs +7/−0
- library/Network/AWS/XRayClient/JSONHelpers.hs +41/−0
- library/Network/AWS/XRayClient/Segment.hs +479/−0
- library/Network/AWS/XRayClient/SendSegments.hs +60/−0
- library/Network/AWS/XRayClient/TraceId.hs +143/−0
- library/System/Random/XRayCustom.hs +28/−0
- tests/Network/AWS/XRayClient/SegmentSpec.hs +196/−0
- tests/Network/AWS/XRayClient/TraceIdSpec.hs +38/−0
- tests/Spec.hs +1/−0
+ CHANGELOG.md view
@@ -0,0 +1,7 @@+## [*Unreleased*](https://github.com/freckle/aws-xray-client/tree/aws-xray-client-v0.1.0.0...main)++None++## [v0.1.0.0](https://github.com/freckle/aws-xray-client/tree/aws-xray-client-v0.1.0.0)++First tagged release.
+ README.md view
@@ -0,0 +1,3 @@+# aws-xray-client++A Haskell client for AWS X-Ray.
+ aws-xray-client.cabal view
@@ -0,0 +1,113 @@+cabal-version: 1.12+name: aws-xray-client+version: 0.1.0.0+license: MIT+copyright: 2021 Renaissance Learning Inc+maintainer: engineering@freckle.com+author: Freckle R&D+homepage: https://github.com/freckle/aws-xray-client#readme+bug-reports: https://github.com/freckle/aws-xray-client/issues+synopsis: A client for AWS X-Ray.+description:+ The core client for enabling AWX X-Ray.+ .+ See other `aws-xray-client-*` packages for usage and integration examples.++category: Tracing+build-type: Simple+extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/freckle/aws-xray-client++library+ exposed-modules:+ Network.AWS.XRayClient+ Network.AWS.XRayClient.JSONHelpers+ Network.AWS.XRayClient.Segment+ Network.AWS.XRayClient.SendSegments+ Network.AWS.XRayClient.TraceId+ System.Random.XRayCustom++ hs-source-dirs: library+ other-modules: Paths_aws_xray_client+ default-language: Haskell2010+ default-extensions:+ BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+ DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+ FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+ LambdaCase MultiParamTypeClasses NoImplicitPrelude+ NoMonomorphismRestriction OverloadedStrings RankNTypes+ RecordWildCards ScopedTypeVariables StandaloneDeriving+ TypeApplications TypeFamilies++ build-depends:+ aeson >=1.4.2.0,+ base >=4.12.0.0 && <5,+ bytestring >=0.10.8.2,+ deepseq >=1.4.4.0,+ http-types >=0.12.3,+ lens >=4.17.1,+ network >=2.8.0.1,+ random >=1.1,+ text >=1.2.3.1,+ time >=1.8.0.2++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: tests+ other-modules:+ Network.AWS.XRayClient.SegmentSpec+ Network.AWS.XRayClient.TraceIdSpec+ Paths_aws_xray_client++ default-language: Haskell2010+ default-extensions:+ BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+ DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+ FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+ LambdaCase MultiParamTypeClasses NoImplicitPrelude+ NoMonomorphismRestriction OverloadedStrings RankNTypes+ RecordWildCards ScopedTypeVariables StandaloneDeriving+ TypeApplications TypeFamilies++ ghc-options: -threaded -rtsopts -O0 -with-rtsopts=-N+ build-depends:+ QuickCheck >=2.12.6.1,+ aeson >=1.4.2.0,+ aeson-qq >=0.8.2,+ aws-xray-client -any,+ base >=4.12.0.0 && <5,+ generic-arbitrary >=0.1.0,+ hspec >=2.6.1,+ lens >=4.17.1,+ random >=1.1,+ text >=1.2.3.1++benchmark bench+ type: exitcode-stdio-1.0+ main-is: Bench.hs+ hs-source-dirs: benchmarks+ other-modules: Paths_aws_xray_client+ default-language: Haskell2010+ default-extensions:+ BangPatterns DataKinds DeriveAnyClass DeriveFoldable DeriveFunctor+ DeriveGeneric DeriveLift DeriveTraversable DerivingStrategies+ FlexibleContexts FlexibleInstances GADTs GeneralizedNewtypeDeriving+ LambdaCase MultiParamTypeClasses NoImplicitPrelude+ NoMonomorphismRestriction OverloadedStrings RankNTypes+ RecordWildCards ScopedTypeVariables StandaloneDeriving+ TypeApplications TypeFamilies++ ghc-options: -threaded -O2 -with-rtsopts=-N+ build-depends:+ async >=2.2.2,+ aws-xray-client -any,+ base >=4.12.0.0 && <5,+ criterion >=1.5.5.0,+ random >=1.1,+ time >=1.8.0.2
+ benchmarks/Bench.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE OverloadedStrings #-}++module Main+ ( main+ ) where++import Prelude++import Control.Concurrent.Async+import Control.Monad (replicateM_)+import Criterion.Main+import Data.Char (intToDigit)+import Data.IORef+import Data.Time.Clock.POSIX+import Network.AWS.XRayClient+import System.Random++main :: IO ()+main = do+ stdGenIORef <- newIORef =<< newStdGen++ let+ segmentIdNotShared = splitActionAcrossThreads+ (pure ())+ (const $ getStdRandom generateXRaySegmentId)+ segmentIdShared = splitActionAcrossThreads+ (newStdGen >>= newIORef)+ (`withRandomGenIORef` generateXRaySegmentId)+ parNewStdGen = splitActionAcrossThreads (pure ()) (const newStdGen)+ defaultMain+ [ bgroup+ "single-threaded timings"+ [ -- These ID generation functions use the machine's random number generator,+ -- which can be slow if used improperly.+ bench "generateTraceId" $ nfIO (generateXRayTraceId stdGenIORef)+ , bench "generateSegmentId"+ $ nfIO (withRandomGenIORef stdGenIORef generateXRaySegmentId)+ , bench "getPOSIXTime" $ nfIO getPOSIXTime+ , bench "intToDigit" $ nf intToDigit 0+ , bench "newStdGen" $ whnfIO newStdGen+ , bench "makeSegment" $ whnfIO (makeSegment stdGenIORef)+ ]+ , bgroup+ "generateXRaySegmentId not shared parallel"+ [ benchGenerateXRaySegmentId 100 segmentIdNotShared+ , benchGenerateXRaySegmentId 4 segmentIdNotShared+ , benchGenerateXRaySegmentId 2 segmentIdNotShared+ , benchGenerateXRaySegmentId 1 segmentIdNotShared+ ]+ , bgroup+ "generateXRaySegmentId shared parallel"+ [ benchGenerateXRaySegmentId 100 segmentIdShared+ , benchGenerateXRaySegmentId 4 segmentIdShared+ , benchGenerateXRaySegmentId 2 segmentIdShared+ , benchGenerateXRaySegmentId 1 segmentIdShared+ ]+ , bgroup+ "newStdGen parallel"+ [ bench "newStdGen parallel 100" $ whnfIO $ parNewStdGen 100 10000+ , bench "newStdGen parallel 4" $ whnfIO $ parNewStdGen 4 10000+ , bench "newStdGen parallel 2" $ whnfIO $ parNewStdGen 2 10000+ , bench "newStdGen parallel 1" $ whnfIO $ parNewStdGen 1 10000+ ]+ ]++benchGenerateXRaySegmentId :: Int -> (Int -> Int -> IO a) -> Benchmark+benchGenerateXRaySegmentId n segmentIdSharing =+ bench ("generateXRaySegmentId " ++ show n) $ whnfIO $ segmentIdSharing n 10000++makeSegment :: IORef StdGen -> IO XRaySegment+makeSegment stdGenIORef = do+ startTime <- getPOSIXTime+ endTime <- getPOSIXTime+ segmentId <- withRandomGenIORef stdGenIORef generateXRaySegmentId+ pure $ xraySubsegment "segment" segmentId startTime (Just endTime)++splitActionAcrossThreads :: IO a -> (a -> IO b) -> Int -> Int -> IO ()+splitActionAcrossThreads setup action numThreads totalActions =+ replicateConcurrently_ numThreads $ do+ setupArg <- setup+ replicateM_ (totalActions `div` numThreads) (action setupArg)
+ library/Network/AWS/XRayClient.hs view
@@ -0,0 +1,7 @@+module Network.AWS.XRayClient+ ( module X+ ) where++import Network.AWS.XRayClient.Segment as X+import Network.AWS.XRayClient.TraceId as X+import System.Random.XRayCustom as X
+ library/Network/AWS/XRayClient/JSONHelpers.hs view
@@ -0,0 +1,41 @@+module Network.AWS.XRayClient.JSONHelpers+ ( xrayAesonOptions+ ) where++import Prelude++import Data.Aeson+import qualified Data.Char as C+import Data.List (isPrefixOf)++-- | Aeson 'Options' to remove prefix and apply snake_case.+xrayAesonOptions :: String -> Options+xrayAesonOptions prefix = defaultOptions+ { fieldLabelModifier = snakeCaseify . unCapitalize . dropPrefix prefix+ , omitNothingFields = True+ }++-- | Lower-case and insert an underscore before upper-case letters+--+-- >>> snakeCaseify "levelSubtraction"+-- "level_subtraction"+--+snakeCaseify :: String -> String+snakeCaseify [] = []+snakeCaseify (c : cs)+ | C.isLower c || C.isNumber c = c : snakeCaseify cs+ | otherwise = '_' : C.toLower c : snakeCaseify cs++-- | Lower-case leading character+--+-- >>> unCapitalize "Capped"+-- "capped"+--+unCapitalize :: String -> String+unCapitalize [] = []+unCapitalize (c : cs) = C.toLower c : cs++dropPrefix :: String -> String -> String+dropPrefix prefix x = if prefix `isPrefixOf` x+ then drop (length prefix) x+ else error $ "dropPrefix: " ++ show prefix ++ " is not a prefix of " ++ show x
+ library/Network/AWS/XRayClient/Segment.hs view
@@ -0,0 +1,479 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Network.AWS.XRayClient.Segment+ ( -- * Segment+ XRaySegment(..)+ , xraySegment+ , xraySubsegment+ , xrayIndependentSubsegment++ , xraySegmentName+ , xraySegmentId+ , xraySegmentTraceId+ , xraySegmentStartTime+ , xraySegmentEndTime+ , xraySegmentInProgress+ , xraySegmentParentId+ , xraySegmentType+ , xraySegmentOrigin+ , xraySegmentUser+ , xraySegmentNamespace+ , xraySegmentService+ , xraySegmentError+ , xraySegmentThrottle+ , xraySegmentFault+ , xraySegmentCause+ , xraySegmentHttp+ , xraySegmentAnnotations+ , xraySegmentMetadata+ , xraySegmentSubsegments+ , xraySegmentAws+ , xraySegmentSql++ , XRaySegmentService(..)+ , xraySegmentServiceVersion++ -- * HTTP+ , XRaySegmentHttp(..)+ , xraySegmentHttpDef+ , xraySegmentHttpRequest+ , xraySegmentHttpResponse++ , XRaySegmentHttpRequest(..)+ , xraySegmentHttpRequestDef+ , xraySegmentHttpRequestMethod+ , xraySegmentHttpRequestUrl+ , xraySegmentHttpRequestUserAgent+ , xraySegmentHttpRequestClientIp+ , xraySegmentHttpRequestXForwardedFor+ , xraySegmentHttpRequestTraced++ , XRaySegmentHttpResponse(..)+ , xraySegmentHttpResponseDef+ , xraySegmentHttpResponseStatus+ , xraySegmentHttpResponseContentLength++ -- * AWS Resource Data+ , XRaySegmentAws(..)+ , xraySegmentAwsDef+ , xraySegmentAwsAccountId+ , xraySegmentAwsEcs+ , xraySegmentAwsEc2+ , xraySegmentAwsElasticBeanstalk+ , xraySegmentAwsOperation+ , xraySegmentAwsRegion+ , xraySegmentAwsRequestId+ , xraySegmentAwsQueueUrl+ , xraySegmentAwsTableName++ , XRaySegmentAwsEcs(..)+ , xraySegmentAwsEcsDef+ , xraySegmentAwsEcsContainer++ , XRaySegmentAwsEc2(..)+ , xraySegmentAwsEc2Def+ , xraySegmentAwsEc2InstanceId+ , xraySegmentAwsEc2AvailabilityZone++ , XRaySegmentAwsElasticBeanstalk(..)+ , xraySegmentAwsElasticBeanstalkDef+ , xraySegmentAwsElasticBeanstalkEnvironmentName+ , xraySegmentAwsElasticBeanstalkVersionLabel+ , xraySegmentAwsElasticBeanstalkDeploymentId++ -- * SQL+ , XRaySegmentSql(..)+ , xraySegmentSqlDef+ , xraySegmentSqlConnectionString+ , xraySegmentSqlUrl+ , xraySegmentSqlSanitizedQuery+ , xraySegmentSqlDatabaseType+ , xraySegmentSqlDatabaseVersion+ , xraySegmentSqlDriverVersion+ , xraySegmentSqlUser+ , xraySegmentSqlPreparation+ ) where++import Prelude++import Control.Lens.TH+import Data.Aeson+import Data.Aeson.TH+import Data.Maybe (isNothing)+import Data.Text (Text)+import Data.Time.Clock.POSIX+import Network.AWS.XRayClient.JSONHelpers+import Network.AWS.XRayClient.TraceId++-- TODO: Make different types for segment, subsegment, and independent+-- subsegment instead of relying on different smart constructors. The+-- sub-sections, like aws, will also have different variants.++-- | Represents an entire X-Ray Segment document. See+-- <http://docs.aws.amazon.com/xray/latest/devguide/xray-api-segmentdocuments.html#api-segmentdocuments-fields>+data XRaySegment+ = XRaySegment+ { _xraySegmentName :: !Text+ -- ^ The logical name of the service that handled the request, up to 200+ -- characters. For example, your application's name or domain name. Names+ -- can contain Unicode letters, numbers, and whitespace, and the following+ -- symbols: _, ., :, /, %, &, #, =, +, \, -, @+ , _xraySegmentId :: !XRaySegmentId+ -- ^ A 64-bit identifier for the segment, unique among segments in the same+ -- trace, in 16 hexadecimal digits.+ , _xraySegmentTraceId :: !(Maybe XRayTraceId)+ -- ^ A unique identifier that connects all segments and subsegments+ -- originating from a single client request.+ , _xraySegmentStartTime :: !POSIXTime+ -- ^ number that is the time the segment was created, in floating point+ -- seconds in epoch time. For example, 1480615200.010 or 1.480615200010E9.+ -- Use as many decimal places as you need. Microsecond resolution is+ -- recommended when available.+ , _xraySegmentEndTime :: !(Maybe POSIXTime)+ -- ^ number that is the time the segment was closed. For example,+ -- 1480615200.090 or 1.480615200090E9. Specify either an end_time or+ -- in_progress.+ , _xraySegmentInProgress :: !(Maybe Bool)+ -- ^ boolean, set to true instead of specifying an end_time to record that+ -- a segment is started, but is not complete. Send an in-progress segment+ -- when your application receives a request that will take a long time to+ -- serve, to trace the request receipt. When the response is sent, send the+ -- complete segment to overwrite the in-progress segment. Only send one+ -- complete segment, and one or zero in-progress segments, per request.+ , _xraySegmentParentId :: !(Maybe XRaySegmentId)+ -- ^ A subsegment ID you specify if the request originated from an+ -- instrumented application. The X-Ray SDK adds the parent subsegment ID to+ -- the tracing header for downstream HTTP calls.+ , _xraySegmentType :: !(Maybe Text)+ -- ^ Set this to @"subsegment"@ if this is an independent subsegment.+ , _xraySegmentOrigin :: !(Maybe Text)+ -- ^ The type of AWS resource running your application.+ , _xraySegmentUser :: !(Maybe Text)+ -- ^ A string that identifies the user who sent the request.+ , _xraySegmentNamespace :: !(Maybe Text)+ -- ^ "aws" for AWS SDK calls; "remote" for other downstream calls.+ , _xraySegmentService :: !(Maybe XRaySegmentService)+ -- ^ An object with information about your application.+ , _xraySegmentError :: !(Maybe Bool)+ -- ^ fields that indicate an error occurred and that include information+ -- about the exception that caused the error.+ , _xraySegmentThrottle :: !(Maybe Bool)+ -- ^ fields that indicate an error occurred and that include information+ -- about the exception that caused the error.+ , _xraySegmentFault :: !(Maybe Bool)+ -- ^ fields that indicate an error occurred and that include information+ -- about the exception that caused the error.++ -- TODO: Make cause more type-safe+ , _xraySegmentCause :: !(Maybe Value)+ -- ^ fields that indicate an error occurred and that include information+ -- about the exception that caused the error.+ , _xraySegmentHttp :: !(Maybe XRaySegmentHttp)+ -- ^ 'XRaySegmentHttp' object with information about the original HTTP+ -- request.+ , _xraySegmentAnnotations :: !(Maybe Object)+ -- ^ object with key-value pairs that you want X-Ray to index for search.+ , _xraySegmentMetadata :: !(Maybe Object)+ -- ^ object with any additional data that you want to store in the segment.+ , _xraySegmentSubsegments :: !(Maybe [XRaySegment])+ -- ^ array of 'XRaySegment' objects. See 'xraySubSegment' for a smart+ -- constructor.+ , _xraySegmentAws :: !(Maybe XRaySegmentAws)+ -- ^ object with information about the AWS resource on which your+ -- application served the request.+ , _xraySegmentSql :: !(Maybe XRaySegmentSql)+ -- ^ Object representing a sql query.+ } deriving (Show, Eq)++-- | Smart constructor for 'XRaySegment' with all the required fields.+--+-- Note that in 'XRaySegment', @end_time@ and @in_progress@ are mutually+-- exclusive. If your @end_time@ is 'Nothing', then @in_progress@ will be set+-- to 'True'.+xraySegment+ :: Text -- ^ name+ -> XRaySegmentId -- ^ id+ -> XRayTraceId -- ^ trace_id+ -> POSIXTime -- ^ start_time+ -> Maybe POSIXTime -- ^ end_time+ -> XRaySegment+xraySegment name segmentId traceId startTime mEndTime =+ (xraySubsegment name segmentId startTime mEndTime)+ { _xraySegmentTraceId = Just traceId+ }++-- | An 'XRaySegment' meant to be used as an embedded subsegment in another+-- 'XRaySegment'.+xraySubsegment+ :: Text -- ^ name+ -> XRaySegmentId -- ^ id+ -> POSIXTime -- ^ start_time+ -> Maybe POSIXTime -- ^ end_time+ -> XRaySegment+xraySubsegment name segmentId startTime mEndTime = XRaySegment+ { _xraySegmentName = name+ , _xraySegmentId = segmentId+ , _xraySegmentTraceId = Nothing+ , _xraySegmentStartTime = startTime+ -- NB: We must either specify end time or in_progress = true+ , _xraySegmentEndTime = mEndTime+ , _xraySegmentInProgress = if isNothing mEndTime then Just True else Nothing+ , _xraySegmentParentId = Nothing+ , _xraySegmentType = Nothing+ , _xraySegmentOrigin = Nothing+ , _xraySegmentUser = Nothing+ , _xraySegmentNamespace = Nothing+ , _xraySegmentService = Nothing+ , _xraySegmentError = Nothing+ , _xraySegmentThrottle = Nothing+ , _xraySegmentFault = Nothing+ , _xraySegmentCause = Nothing+ , _xraySegmentHttp = Nothing+ , _xraySegmentAnnotations = Nothing+ , _xraySegmentMetadata = Nothing+ , _xraySegmentSubsegments = Nothing+ , _xraySegmentAws = Nothing+ , _xraySegmentSql = Nothing+ }++-- | Smart constructor for an independent subsegment. Includes additional+-- required fields.+xrayIndependentSubsegment+ :: Text -- ^ name+ -> XRaySegmentId -- ^ id+ -> XRayTraceId -- ^ trace_id+ -> POSIXTime -- ^ start_time+ -> Maybe POSIXTime -- ^ end_time+ -> XRaySegmentId -- ^ parent_id+ -> XRaySegment+xrayIndependentSubsegment name segmentId traceId startTime mEndTime parentId =+ (xraySegment name segmentId traceId startTime mEndTime)+ { _xraySegmentType = Just "subsegment"+ , _xraySegmentParentId = Just parentId+ }++-- | Type for the @service@ field of a segment document.+newtype XRaySegmentService+ = XRaySegmentService+ { _xraySegmentServiceVersion :: Text+ -- ^ A string that identifies the version of your application that served+ -- the request.+ } deriving (Show, Eq)++-- | See+-- <http://docs.aws.amazon.com/xray/latest/devguide/xray-api-segmentdocuments.html#api-segmentdocuments-http>+data XRaySegmentHttp+ = XRaySegmentHttp+ { _xraySegmentHttpRequest :: !(Maybe XRaySegmentHttpRequest)+ , _xraySegmentHttpResponse :: !(Maybe XRaySegmentHttpResponse)+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentHttp' with fields initialized to 'Nothing'.+xraySegmentHttpDef :: XRaySegmentHttp+xraySegmentHttpDef = XRaySegmentHttp+ { _xraySegmentHttpRequest = Nothing+ , _xraySegmentHttpResponse = Nothing+ }++data XRaySegmentHttpRequest+ = XRaySegmentHttpRequest+ { _xraySegmentHttpRequestMethod :: !(Maybe Text)+ -- ^ The request method. For example, GET.+ , _xraySegmentHttpRequestUrl :: !(Maybe Text)+ -- ^ The full URL of the request, compiled from the protocol, hostname, and+ -- path of the request.+ , _xraySegmentHttpRequestUserAgent :: !(Maybe Text)+ -- ^ The user agent string from the requester's client.+ , _xraySegmentHttpRequestClientIp :: !(Maybe Text)+ -- ^ The IP address of the requester. Can be retrieved from the IP packet's+ -- Source Address or, for forwarded requests, from an X-Forwarded-For+ -- header.+ , _xraySegmentHttpRequestXForwardedFor :: !(Maybe Bool)+ -- ^ (segments only) boolean indicating that the client_ip was read from an+ -- X-Forwarded-For header and is not reliable as it could have been forged.+ , _xraySegmentHttpRequestTraced :: !(Maybe Bool)+ -- ^ (subsegments only) boolean indicating that the downstream call is to+ -- another traced service. If this field is set to true, X-Ray considers+ -- the trace to be broken until the downstream service uploads a segment+ -- with a parent_id that matches the id of the subsegment that contains+ -- this block.+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentHttpRequest' with fields initialized to 'Nothing'.+xraySegmentHttpRequestDef :: XRaySegmentHttpRequest+xraySegmentHttpRequestDef = XRaySegmentHttpRequest+ { _xraySegmentHttpRequestMethod = Nothing+ , _xraySegmentHttpRequestUrl = Nothing+ , _xraySegmentHttpRequestUserAgent = Nothing+ , _xraySegmentHttpRequestClientIp = Nothing+ , _xraySegmentHttpRequestXForwardedFor = Nothing+ , _xraySegmentHttpRequestTraced = Nothing+ }++data XRaySegmentHttpResponse+ = XRaySegmentHttpResponse+ { _xraySegmentHttpResponseStatus :: !(Maybe Int)+ -- ^ number indicating the HTTP status of the response.+ , _xraySegmentHttpResponseContentLength :: !(Maybe Int)+ -- ^ number indicating the length of the response body in bytes.+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentHttpResponse' with fields initialized to 'Nothing'.+xraySegmentHttpResponseDef :: XRaySegmentHttpResponse+xraySegmentHttpResponseDef = XRaySegmentHttpResponse+ { _xraySegmentHttpResponseStatus = Nothing+ , _xraySegmentHttpResponseContentLength = Nothing+ }++-- | Type for the @aws@ field in a segment. See+-- <http://docs.aws.amazon.com/xray/latest/devguide/xray-api-segmentdocuments.html#api-segmentdocuments-aws>+--+-- NOTE: Please see the documentation for what fields are allowed in a segment+-- versus a subsegment.+data XRaySegmentAws+ = XRaySegmentAws+ { _xraySegmentAwsAccountId :: !(Maybe Text)+ -- ^ If your application sends segments to a different AWS account, record+ -- the ID of the account running your application.+ , _xraySegmentAwsEcs :: !(Maybe XRaySegmentAwsEcs)+ -- ^ Information about an Amazon ECS container.+ , _xraySegmentAwsEc2 :: !(Maybe XRaySegmentAwsEc2)+ -- ^ Information about an EC2 instance.+ , _xraySegmentAwsElasticBeanstalk :: !(Maybe XRaySegmentAwsElasticBeanstalk)+ -- ^ Information about an Elastic Beanstalk environment. You can find this+ -- information in a file named /var/elasticbeanstalk/xray/environment.conf+ -- on the latest Elastic Beanstalk platforms.+ , _xraySegmentAwsOperation :: !(Maybe Text)+ -- ^ The name of the API action invoked against an AWS service or resource.+ , _xraySegmentAwsRegion :: !(Maybe Text)+ -- ^ If the resource is in a region different from your application, record+ -- the region. For example, us-west-2.+ , _xraySegmentAwsRequestId :: !(Maybe Text)+ -- ^ Unique identifier for the request.+ , _xraySegmentAwsQueueUrl :: !(Maybe Text)+ -- ^ For operations on an Amazon SQS queue, the queue's URL.+ , _xraySegmentAwsTableName :: !(Maybe Text)+ -- ^ For operations on a DynamoDB table, the name of the table.+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentAws' with fields initialized to 'Nothing'.+xraySegmentAwsDef :: XRaySegmentAws+xraySegmentAwsDef = XRaySegmentAws+ { _xraySegmentAwsAccountId = Nothing+ , _xraySegmentAwsEcs = Nothing+ , _xraySegmentAwsEc2 = Nothing+ , _xraySegmentAwsElasticBeanstalk = Nothing+ , _xraySegmentAwsOperation = Nothing+ , _xraySegmentAwsRegion = Nothing+ , _xraySegmentAwsRequestId = Nothing+ , _xraySegmentAwsQueueUrl = Nothing+ , _xraySegmentAwsTableName = Nothing+ }++newtype XRaySegmentAwsEcs+ = XRaySegmentAwsEcs+ { _xraySegmentAwsEcsContainer :: Maybe Text+ -- ^ The container ID of the container running your application.+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentAwsEcs' with fields initialized to 'Nothing'.+xraySegmentAwsEcsDef :: XRaySegmentAwsEcs+xraySegmentAwsEcsDef =+ XRaySegmentAwsEcs {_xraySegmentAwsEcsContainer = Nothing}++data XRaySegmentAwsEc2+ = XRaySegmentAwsEc2+ { _xraySegmentAwsEc2InstanceId :: !(Maybe Text)+ -- ^ The instance ID of the EC2 instance.+ , _xraySegmentAwsEc2AvailabilityZone :: !(Maybe Text)+ -- ^ The Availability Zone in which the instance is running.+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentAwsEc2' with fields initialized to 'Nothing'.+xraySegmentAwsEc2Def :: XRaySegmentAwsEc2+xraySegmentAwsEc2Def = XRaySegmentAwsEc2+ { _xraySegmentAwsEc2InstanceId = Nothing+ , _xraySegmentAwsEc2AvailabilityZone = Nothing+ }++data XRaySegmentAwsElasticBeanstalk+ = XRaySegmentAwsElasticBeanstalk+ { _xraySegmentAwsElasticBeanstalkEnvironmentName :: !(Maybe Text)+ -- ^ The name of the environment.+ , _xraySegmentAwsElasticBeanstalkVersionLabel :: !(Maybe Text)+ -- ^ The name of the application version that is currently deployed to the+ -- instance that served the request.+ , _xraySegmentAwsElasticBeanstalkDeploymentId :: !(Maybe Int)+ -- ^ number indicating the ID of the last successful deployment to the+ -- instance that served the request.+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentAwsElasticBeanstalk' with fields initialized+-- to 'Nothing'.+xraySegmentAwsElasticBeanstalkDef :: XRaySegmentAwsElasticBeanstalk+xraySegmentAwsElasticBeanstalkDef = XRaySegmentAwsElasticBeanstalk+ { _xraySegmentAwsElasticBeanstalkEnvironmentName = Nothing+ , _xraySegmentAwsElasticBeanstalkVersionLabel = Nothing+ , _xraySegmentAwsElasticBeanstalkDeploymentId = Nothing+ }++data XRaySegmentSql+ = XRaySegmentSql+ { _xraySegmentSqlConnectionString :: !(Maybe Text)+ -- ^ For SQL Server or other database connections that don't use URL+ -- connection strings, record the connection string, excluding passwords.+ , _xraySegmentSqlUrl :: !(Maybe Text)+ -- ^ For a database connection that uses a URL connection string, record+ -- the URL, excluding passwords.+ , _xraySegmentSqlSanitizedQuery :: !(Maybe Text)+ -- ^ The database query, with any user provided values removed or replaced+ -- by a placeholder.+ , _xraySegmentSqlDatabaseType :: !(Maybe Text)+ -- ^ The name of the database engine.+ , _xraySegmentSqlDatabaseVersion :: !(Maybe Text)+ -- ^ The version number of the database engine.+ , _xraySegmentSqlDriverVersion :: !(Maybe Text)+ -- ^ The name and version number of the database engine driver that your+ -- application uses.+ , _xraySegmentSqlUser :: !(Maybe Text)+ -- ^ The database username.+ , _xraySegmentSqlPreparation :: !(Maybe Text)+ -- ^ call if the query used a PreparedCall; statement if the query used a+ -- PreparedStatement.+ } deriving (Show, Eq)++-- | Constructor for 'XRaySegmentSql' with fields initialized to 'Nothing'.+xraySegmentSqlDef :: XRaySegmentSql+xraySegmentSqlDef = XRaySegmentSql+ { _xraySegmentSqlConnectionString = Nothing+ , _xraySegmentSqlUrl = Nothing+ , _xraySegmentSqlSanitizedQuery = Nothing+ , _xraySegmentSqlDatabaseType = Nothing+ , _xraySegmentSqlDatabaseVersion = Nothing+ , _xraySegmentSqlDriverVersion = Nothing+ , _xraySegmentSqlUser = Nothing+ , _xraySegmentSqlPreparation = Nothing+ }++makeLenses ''XRaySegment+makeLenses ''XRaySegmentHttp+makeLenses ''XRaySegmentHttpRequest+makeLenses ''XRaySegmentHttpResponse+makeLenses ''XRaySegmentAws+makeLenses ''XRaySegmentAwsEcs+makeLenses ''XRaySegmentAwsEc2+makeLenses ''XRaySegmentAwsElasticBeanstalk+makeLenses ''XRaySegmentSql+makeLenses ''XRaySegmentService++deriveJSON (xrayAesonOptions "_xraySegment") ''XRaySegment+deriveJSON (xrayAesonOptions "_xraySegmentHttp") ''XRaySegmentHttp+deriveJSON (xrayAesonOptions "_xraySegmentHttpRequest") ''XRaySegmentHttpRequest+deriveJSON (xrayAesonOptions "_xraySegmentHttpResponse") ''XRaySegmentHttpResponse+deriveJSON (xrayAesonOptions "_xraySegmentAws") ''XRaySegmentAws+deriveJSON (xrayAesonOptions "_xraySegmentAwsEcs") ''XRaySegmentAwsEcs+deriveJSON (xrayAesonOptions "_xraySegmentAwsEc2") ''XRaySegmentAwsEc2+deriveJSON (xrayAesonOptions "_xraySegmentAwsElasticBeanstalk") ''XRaySegmentAwsElasticBeanstalk+deriveJSON (xrayAesonOptions "_xraySegmentSql") ''XRaySegmentSql+deriveJSON (xrayAesonOptions "_xraySegmentService") ''XRaySegmentService
+ library/Network/AWS/XRayClient/SendSegments.hs view
@@ -0,0 +1,60 @@+-- | Module for sending segments to the XRay daemon.++module Network.AWS.XRayClient.SendSegments+ ( sendSegmentsToDaemon+ , NoAddressInfoException(..)+ ) where++import Prelude++import Control.Exception (Exception, SomeException, catch, throwIO)+import Data.Aeson+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as BSL+import Data.Foldable (traverse_)+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import Data.Typeable+import Network.AWS.XRayClient.Segment as X+import Network.Socket+import Network.Socket.ByteString (sendAll)+import System.IO (hPutStrLn, stderr)++-- | Makes JSON payloads for each segment and sends it to the daemon.+sendSegmentsToDaemon :: Text -> Int -> [XRaySegment] -> IO ()+sendSegmentsToDaemon host port segments = catch+ (sendUDPByteStrings host port $ makeXRayPayload <$> segments)+ (\(err :: SomeException) ->+ hPutStrLn stderr ("sendUDPByteStrings: " ++ show err)+ )++makeXRayPayload :: XRaySegment -> ByteString+makeXRayPayload segment =+ let header = object ["format" .= ("json" :: String), "version" .= (1 :: Int)]+ in BSL.toStrict $ encode header <> "\n" <> encode segment++-- | Sends the entirety of multiple 'ByteString' values to a given host/port+-- via UDP Datagrams.+sendUDPByteStrings :: Text -> Int -> [ByteString] -> IO ()+sendUDPByteStrings host port payloads = do+ addrInfos <- getAddrInfo Nothing (Just $ T.unpack host) (Just $ show port)+ case addrInfos of+ [] ->+ throwIO+ $ NoAddressInfoException+ $ "No address info for "+ ++ T.unpack host+ ++ ":"+ ++ show port+ (serverAddr : _) -> do+ sock <- socket (addrFamily serverAddr) Datagram defaultProtocol+ connect sock (addrAddress serverAddr)+ traverse_ (sendAll sock) payloads+ close sock++newtype NoAddressInfoException+ = NoAddressInfoException String+ deriving (Show, Typeable)++instance Exception NoAddressInfoException
+ library/Network/AWS/XRayClient/TraceId.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE FlexibleContexts #-}++module Network.AWS.XRayClient.TraceId+ ( amazonTraceIdHeaderName+ , -- * Trace ID+ XRayTraceId(..)+ , generateXRayTraceId+ , makeXRayTraceId+ , XRaySegmentId(..)+ , generateXRaySegmentId+ -- * Trace ID Header+ , XRayTraceIdHeaderData(..)+ , xrayTraceIdHeaderData+ , parseXRayTraceIdHeaderData+ , makeXRayTraceIdHeaderValue+ ) where++import Prelude++import Control.DeepSeq (NFData)+import Data.Aeson+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Char8 as BS8+import Data.Char (intToDigit)+import Data.IORef+import Data.Monoid ((<>))+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Time.Clock.POSIX (getPOSIXTime)+import GHC.Generics+import Network.HTTP.Types.Header+import Numeric (showHex)+import System.Random+import System.Random.XRayCustom++-- | Variable for "X-Amzn-Trace-Id" so you don't have to worry about+-- misspelling it.+amazonTraceIdHeaderName :: HeaderName+amazonTraceIdHeaderName = "X-Amzn-Trace-Id"++-- | A trace_id consists of three numbers separated by hyphens. For example,+-- 1-58406520-a006649127e371903a2de979. This includes: The version number, that+-- is, 1. The time of the original request, in Unix epoch time, in 8+-- hexadecimal digits. For example, 10:00AM December 2nd, 2016 PST in epoch+-- time is 1480615200 seconds, or 58406520 in hexadecimal. A 96-bit identifier+-- for the trace, globally unique, in 24 hexadecimal digits.+newtype XRayTraceId = XRayTraceId { unXRayTraceId :: Text }+ deriving (Show, Eq)+ deriving newtype (FromJSON, ToJSON, NFData)++-- TODO: Make a parse function and don't export constructor+-- parseXRayTraceId :: (MonadError String m) => ByteString -> m XRayTraceId++-- | Generates an 'XRayTraceId' in 'IO'. WARNING: This uses the global+-- 'StdGen', so this can be a bottleneck in multi-threaded applications.+generateXRayTraceId :: IORef StdGen -> IO XRayTraceId+generateXRayTraceId ioRef = do+ timeInSeconds <- round <$> getPOSIXTime+ withRandomGenIORef ioRef $ makeXRayTraceId timeInSeconds++makeXRayTraceId :: Int -> StdGen -> (XRayTraceId, StdGen)+makeXRayTraceId timeInSeconds gen = first make $ randomHexString 24 gen+ where+ make hexString =+ XRayTraceId $ T.pack $ "1-" ++ showHex timeInSeconds "" ++ "-" ++ hexString++-- | Generates a random hexadecimal string of a given length.+randomHexString :: Int -> StdGen -> (String, StdGen)+randomHexString n gen =+ replicateRandom n gen $ first intToDigit . randomR (0, 15)++-- | A 64-bit identifier for the segment, unique among segments in the same+-- trace, in 16 hexadecimal digits.+newtype XRaySegmentId = XRaySegmentId { unXRaySegmentId :: Text }+ deriving (Show, Eq)+ deriving newtype (FromJSON, ToJSON, NFData)++-- TODO: Make parse function for XRaySegmentId so it is safer.++-- | Generates an 'XRaySegmentId' using a given 'StdGen'.+generateXRaySegmentId :: StdGen -> (XRaySegmentId, StdGen)+generateXRaySegmentId = first (XRaySegmentId . T.pack) . randomHexString 16++-- | This holds the data from the X-Amzn-Trace-Id header. See+-- http://docs.aws.amazon.com/xray/latest/devguide/xray-concepts.html#xray-concepts-tracingheader+data XRayTraceIdHeaderData+ = XRayTraceIdHeaderData+ { xrayTraceIdHeaderDataRootTraceId :: !XRayTraceId+ , xrayTraceIdHeaderDataParentId :: !(Maybe XRaySegmentId)+ , xrayTraceIdHeaderDataSampled :: !(Maybe Bool)+ } deriving (Show, Eq, Generic)++-- | Constructor for 'XRayTraceIdHeaderData'.+xrayTraceIdHeaderData :: XRayTraceId -> XRayTraceIdHeaderData+xrayTraceIdHeaderData traceId = XRayTraceIdHeaderData+ { xrayTraceIdHeaderDataRootTraceId = traceId+ , xrayTraceIdHeaderDataParentId = Nothing+ , xrayTraceIdHeaderDataSampled = Nothing+ }++-- | Try to parse the value of the X-Amzn-Trace-Id into a+-- 'XRayTraceIdHeaderData'.+parseXRayTraceIdHeaderData :: ByteString -> Maybe XRayTraceIdHeaderData+parseXRayTraceIdHeaderData rawHeader = do+ components <- traverse parseHeaderComponent $ BS8.split ';' rawHeader+ traceId <- lookup "Root" components+ pure XRayTraceIdHeaderData+ { xrayTraceIdHeaderDataRootTraceId = XRayTraceId (T.decodeUtf8 traceId)+ , xrayTraceIdHeaderDataParentId = XRaySegmentId+ . T.decodeUtf8+ <$> lookup "Parent" components+ , xrayTraceIdHeaderDataSampled = lookup "Sampled" components >>= readSampled+ }+ where+ readSampled :: ByteString -> Maybe Bool+ readSampled "0" = Just False+ readSampled "1" = Just True+ readSampled _ = Nothing++-- | Turns a 'XRayTraceIdHeaderData' into a 'ByteString' meant for the+-- X-Amzn-Trace-Id header value.+makeXRayTraceIdHeaderValue :: XRayTraceIdHeaderData -> ByteString+makeXRayTraceIdHeaderValue XRayTraceIdHeaderData {..} =+ traceIdPart <> parentPart <> sampledPart+ where+ traceIdPart =+ "Root=" <> T.encodeUtf8 (unXRayTraceId xrayTraceIdHeaderDataRootTraceId)+ parentPart = maybe+ ""+ ((";Parent=" <>) . T.encodeUtf8 . unXRaySegmentId)+ xrayTraceIdHeaderDataParentId+ sampledPart = maybe+ ""+ ((";Sampled=" <>) . BS8.pack . show . fromEnum)+ xrayTraceIdHeaderDataSampled++-- | Header components look like Name=Value+parseHeaderComponent :: ByteString -> Maybe (ByteString, ByteString)+parseHeaderComponent rawComponent = case BS8.split '=' rawComponent of+ [name, value] -> Just (name, value)+ _ -> Nothing
+ library/System/Random/XRayCustom.hs view
@@ -0,0 +1,28 @@+-- | Helpful functions that should have been included in System.Random.++module System.Random.XRayCustom+ ( withRandomGenIORef+ , replicateRandom+ ) where++import Prelude++import Data.IORef+import System.Random++-- | Like 'getStdRandom', except use a given 'IORef StdGen' instead of the+-- global 'theStdGen'.+withRandomGenIORef :: (RandomGen g) => IORef g -> (g -> (a, g)) -> IO a+withRandomGenIORef ioRef f = atomicModifyIORef' ioRef (swap . f)+ where swap (x, y) = (y, x)++-- | Runs the supplied function a specified number of times, each time using+-- the new 'RandomGen' value.+replicateRandom :: (RandomGen g) => Int -> g -> (g -> (a, g)) -> ([a], g)+replicateRandom n gen f = replicateRandom' n ([], gen)+ where+ replicateRandom' n' (xs, gen')+ | n' <= 0+ = (xs, gen')+ | otherwise+ = let ~(x, gen'') = f gen' in replicateRandom' (n' - 1) (x : xs, gen'')
+ tests/Network/AWS/XRayClient/SegmentSpec.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE MonomorphismRestriction #-}+{-# LANGUAGE OverloadedLists #-}+{-# LANGUAGE QuasiQuotes #-}++module Network.AWS.XRayClient.SegmentSpec+ ( spec+ ) where++import Prelude++import Control.Lens hiding ((.=))+import Data.Aeson+import Data.Aeson.QQ+import Test.Hspec++import Network.AWS.XRayClient.Segment+import Network.AWS.XRayClient.TraceId++spec :: Spec+spec = do+ let+ traceId = XRayTraceId "1-5880168b-fd5158284b67678a3bb5a78c"+ segmentId = XRaySegmentId "6b55dcc497934f1a"+ startTime = 123.456+ endTime = 789.123++ describe "Segment JSON instances" $ do+ it "should correctly encode the minimum segment" $ do+ let+ segment =+ xraySegment+ "my-service"+ segmentId+ traceId+ startTime+ (Just endTime)+ toJSON segment `shouldBe`+ [aesonQQ|+ {+ "id": #{segmentId},+ "trace_id": #{traceId},+ "name": "my-service",+ "start_time": #{startTime},+ "end_time": #{endTime}+ }+ |]++ it "should handle in_progress properly" $ do+ let+ segment =+ xraySegment+ "my-service"+ segmentId+ traceId+ startTime+ Nothing+ toJSON segment `shouldBe`+ [aesonQQ|+ {+ "id": #{segmentId},+ "trace_id": #{traceId},+ "name": "my-service",+ "start_time": #{startTime},+ "in_progress": true+ }+ |]++ -- NB: This is basically a big integration test taken from the AWS docs+ it "should handle a super long segment" $ do+ toJSON bigSegment `shouldBe` bigSegmentJSON++bigSegment :: XRaySegment+bigSegment =+ xraySegment+ "www.example.com"+ (XRaySegmentId "6b55dcc497934f1a")+ (XRayTraceId "1-5880168b-fd5158284b67678a3bb5a78c")+ 1484789387.126+ (Just 1484789387.535)+ & xraySegmentOrigin ?~ "AWS::EC2::Instance"+ & xraySegmentHttp ?~ (+ xraySegmentHttpDef+ & xraySegmentHttpRequest ?~ (+ xraySegmentHttpRequestDef+ & xraySegmentHttpRequestMethod ?~ "POST"+ & xraySegmentHttpRequestClientIp ?~ "78.255.233.48"+ & xraySegmentHttpRequestUrl ?~ "http://www.example.com/api/user"+ & xraySegmentHttpRequestUserAgent ?~ "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:45.0) Gecko/20100101 Firefox/45.0"+ & xraySegmentHttpRequestXForwardedFor ?~ True+ )+ & xraySegmentHttpResponse ?~ (+ xraySegmentHttpResponseDef+ & xraySegmentHttpResponseStatus ?~ 200+ )+ )+ & xraySegmentAnnotations ?~+ [ "customer_category" .= (124 :: Int)+ , "zip_code" .= (98101 :: Int)+ , "country" .= ("United States" :: String)+ , "internal" .= False+ ]+ & xraySegmentAws ?~ (+ xraySegmentAwsDef+ & xraySegmentAwsEc2 ?~ (+ xraySegmentAwsEc2Def+ & xraySegmentAwsEc2InstanceId ?~ "i-0b5a4678fc325bg98"+ & xraySegmentAwsEc2AvailabilityZone ?~ "us-west-2c"+ )+ )+ & xraySegmentSubsegments ?~+ [ xraySubsegment+ "RDS"+ (XRaySegmentId "0f910026178b71eb")+ 1484789387.502+ (Just 1484789387.534)+ & xraySegmentNamespace ?~ "aws"+ & xraySegmentHttp ?~ (+ xraySegmentHttpDef+ & xraySegmentHttpResponse ?~ (+ xraySegmentHttpResponseDef+ & xraySegmentHttpResponseStatus ?~ 200+ & xraySegmentHttpResponseContentLength ?~ 58+ )+ )+ & xraySegmentSql ?~ (+ xraySegmentSqlDef+ & xraySegmentSqlUrl ?~ "jdbc:postgresql://aawijb5u25wdoy.cpamxznpdoq8.us-west-2.rds.amazonaws.com:5432/ebdb"+ & xraySegmentSqlPreparation ?~ "statement"+ & xraySegmentSqlDatabaseType ?~ "PostgreSQL"+ & xraySegmentSqlDatabaseVersion ?~ "9.5.4"+ & xraySegmentSqlDriverVersion ?~ "PostgreSQL 9.4.1211.jre7"+ & xraySegmentSqlUser ?~ "dbuser"+ & xraySegmentSqlSanitizedQuery ?~ "SELECT * FROM customers WHERE customer_id=?;"+ )+ ]++bigSegmentJSON :: Value+bigSegmentJSON =+ [aesonQQ|+{+ "id": "6b55dcc497934f1a",+ "start_time": 1484789387.126,+ "end_time": 1484789387.535,+ "trace_id": "1-5880168b-fd5158284b67678a3bb5a78c",+ "name": "www.example.com",+ "origin": "AWS::EC2::Instance",+ "aws": {+ "ec2": {+ "availability_zone": "us-west-2c",+ "instance_id": "i-0b5a4678fc325bg98"+ }+ },+ "annotations": {+ "customer_category" : 124,+ "zip_code" : 98101,+ "country" : "United States",+ "internal" : false+ },+ "http": {+ "request": {+ "method": "POST",+ "client_ip": "78.255.233.48",+ "url": "http://www.example.com/api/user",+ "user_agent": "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:45.0) Gecko/20100101 Firefox/45.0",+ "x_forwarded_for": true+ },+ "response": {+ "status": 200+ }+ },+ "subsegments": [+ {+ "id": "0f910026178b71eb",+ "start_time": 1484789387.502,+ "end_time": 1484789387.534,+ "name": "RDS",+ "namespace": "aws",+ "http": {+ "response": {+ "content_length": 58,+ "status": 200+ }+ },+ "sql" : {+ "url": "jdbc:postgresql://aawijb5u25wdoy.cpamxznpdoq8.us-west-2.rds.amazonaws.com:5432/ebdb",+ "preparation": "statement",+ "database_type": "PostgreSQL",+ "database_version": "9.5.4",+ "driver_version": "PostgreSQL 9.4.1211.jre7",+ "user" : "dbuser",+ "sanitized_query" : "SELECT * FROM customers WHERE customer_id=?;"+ }+ }+ ]+}+|]
+ tests/Network/AWS/XRayClient/TraceIdSpec.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Network.AWS.XRayClient.TraceIdSpec+ ( spec+ ) where++import Prelude++import qualified Data.Text as T+import Network.AWS.XRayClient.TraceId+import System.Random+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Arbitrary.Generic++instance Arbitrary XRayTraceId where+ arbitrary = do+ -- aws expects a timestamp in a specific range for their hex+ timeStamp <- choose (1000000000, 4000000000)+ gen <- mkStdGen . getPositive <$> arbitrary+ pure . fst $ makeXRayTraceId timeStamp gen++instance Arbitrary XRaySegmentId where+ arbitrary = fst . generateXRaySegmentId . mkStdGen . getPositive <$> arbitrary++instance Arbitrary XRayTraceIdHeaderData where+ arbitrary = genericArbitrary++spec :: Spec+spec = do+ describe "generateXRayTraceId" $ do+ it "should always be of length 35" $ property $ \(XRayTraceId traceId) ->+ T.length traceId `shouldBe` 35++ describe "parseXRayTraceIdHeaderData/makeXRayTraceIdHeaderValue" $ do+ it "should be idempotent between writes/reads" $ property $ \headerData ->+ parseXRayTraceIdHeaderData (makeXRayTraceIdHeaderValue headerData)+ `shouldBe` Just headerData
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}