diff --git a/common/Network/Helics/Internal/Types.hs b/common/Network/Helics/Internal/Types.hs new file mode 100644 --- /dev/null +++ b/common/Network/Helics/Internal/Types.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} + +module Network.Helics.Internal.Types where + +import Control.Exception + +import Foreign.C.Types +import Foreign.C.String + +import Data.IORef +import Data.Typeable +import Data.Default.Class +import qualified Data.ByteString as S + +-- common +newtype ReturnCode = ReturnCode CInt deriving (Eq, Typeable, Show) +instance Exception ReturnCode + +-- client +type StatusCallback = CInt -> IO () +newtype StatusCode = StatusCode CInt deriving (Eq, Show) + +-- transaction +data TransactionError = TransactionError + { exceptionType :: S.ByteString + , errorMessage :: S.ByteString + , stackTrace :: S.ByteString + , stackFrameDelimiter :: S.ByteString + } + +data TransactionId = TransactionId + { rawTransactionId :: CLong + , transactionError :: IORef (Maybe TransactionError) + } + +newtype SegmentId = SegmentId CLong +type SqlObfuscator = CString -> IO CString + +-- main +data HelicsConfig = HelicsConfig + { licenseKey :: S.ByteString + , appName :: S.ByteString + , language :: S.ByteString + , languageVersion :: S.ByteString + , statusCallback :: Maybe (StatusCode -> IO ()) + } + +instance Default HelicsConfig where + def = HelicsConfig + (error "license key is not set.") + "App" + "Haskell" + COMPILER_VERSION + Nothing + +data TransactionType + = Default + | Web S.ByteString + | Other S.ByteString + +instance Default TransactionType where + def = Default + +data Operation + = SELECT + | INSERT + | UPDATE + | DELETE + deriving (Show) + +data DatastoreSegment = DatastoreSegment + { table :: S.ByteString + , operation :: Operation + , sql :: S.ByteString + , sqlTraceRollupName :: S.ByteString + , sqlObFuscator :: Maybe (S.ByteString -> S.ByteString) + } +instance Default DatastoreSegment where + def = DatastoreSegment "unknown" SELECT "" "unknown" Nothing + + diff --git a/common/Network/Helics/Types.hs b/common/Network/Helics/Types.hs deleted file mode 100644 --- a/common/Network/Helics/Types.hs +++ /dev/null @@ -1,72 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE CPP #-} - -module Network.Helics.Types where - -import Control.Exception - -import Foreign.C.Types -import Foreign.C.String - -import Data.Typeable -import Data.Default.Class -import qualified Data.ByteString as S - --- common -newtype ReturnCode = ReturnCode CInt deriving (Eq, Typeable, Show) -instance Exception ReturnCode - --- client -type StatusCallback = CInt -> IO () -newtype StatusCode = StatusCode CInt deriving (Eq, Show) - --- transaction -newtype TransactionId = TransactionId CLong - -newtype SegmentId = SegmentId CLong -type SqlObfuscator = CString -> IO CString - --- main -data HelicsConfig = HelicsConfig - { licenseKey :: S.ByteString - , appName :: S.ByteString - , language :: S.ByteString - , languageVersion :: S.ByteString - , statusCallback :: Maybe (StatusCode -> IO ()) - } - -instance Default HelicsConfig where - def = HelicsConfig - (error "license key is not set.") - "App" - "Haskell" - COMPILER_VERSION - Nothing - -data TransactionType - = Default - | Web S.ByteString - | Other S.ByteString - -instance Default TransactionType where - def = Default - -data Operation - = SELECT - | INSERT - | UPDATE - | DELETE - deriving (Show) - -data DatastoreSegment = DatastoreSegment - { table :: S.ByteString - , operation :: Operation - , sql :: S.ByteString - , sqlTraceRollupName :: S.ByteString - , sqlObFuscator :: Maybe (S.ByteString -> S.ByteString) - } -instance Default DatastoreSegment where - def = DatastoreSegment "unknown" SELECT "" "unknown" Nothing - - diff --git a/dummy/Network/Helics.hs b/dummy/Network/Helics.hs --- a/dummy/Network/Helics.hs +++ b/dummy/Network/Helics.hs @@ -17,6 +17,9 @@ , addAttribute , setRequestUrl , setMaxTraceSegments + , setError + , noticeError + , clearError -- * segment , SegmentId , autoScope @@ -47,12 +50,13 @@ import Foreign.Marshal import Foreign.Storable +import Data.IORef import Data.Word import Data.Default.Class import qualified Data.ByteString as S import qualified Network.Helics.Sampler as Sampler -import Network.Helics.Types +import Network.Helics.Internal.Types autoScope, rootSegment :: SegmentId autoScope = SegmentId 0 @@ -88,7 +92,9 @@ withTransaction :: S.ByteString -- ^ name of transaction -> TransactionType -> (TransactionId -> IO c) -> IO c -withTransaction _ _ m = m (TransactionId 0) +withTransaction _ _ m = do + ref <- newIORef Nothing + m (TransactionId 0 ref) genericSegment :: SegmentId -- ^ parent segment id -> S.ByteString -- ^ name of represent segment @@ -114,3 +120,12 @@ setMaxTraceSegments :: Int -> TransactionId -> IO () setMaxTraceSegments _ _ = return () + +setError :: Maybe TransactionError -> TransactionId -> IO () +setError _ _ = return () + +noticeError :: TransactionError -> TransactionId -> IO () +noticeError _ _ = return () + +clearError :: TransactionId -> IO () +clearError _ = return () diff --git a/helics.cabal b/helics.cabal --- a/helics.cabal +++ b/helics.cabal @@ -1,5 +1,5 @@ name: helics -version: 0.3.0 +version: 0.4.0 synopsis: New Relic® agent SDK wrapper for Haskell. description: New Relic® agent SDK wrapper for Haskell. @@ -35,7 +35,7 @@ library exposed-modules: Network.Helics Network.Helics.Sampler - other-modules: Network.Helics.Types + Network.Helics.Internal.Types ghc-options: -Wall -O2 default-language: Haskell2010 build-depends: base >=4.6 && <4.8 @@ -61,7 +61,7 @@ executable helics-example main-is: example.hs if flag(example) - build-depends: base >=4.6 && <4.8 + build-depends: base , helics , bytestring buildable: True diff --git a/src/Network/Helics/Foreign/Client.hsc b/src/Network/Helics/Foreign/Client.hsc --- a/src/Network/Helics/Foreign/Client.hsc +++ b/src/Network/Helics/Foreign/Client.hsc @@ -6,7 +6,7 @@ import Foreign.C import Foreign.Ptr -import Network.Helics.Types +import Network.Helics.Internal.Types #{enum StatusCode, StatusCode , statusShutdown = NEWRELIC_STATUS_CODE_SHUTDOWN diff --git a/src/Network/Helics/Foreign/Common.hsc b/src/Network/Helics/Foreign/Common.hsc --- a/src/Network/Helics/Foreign/Common.hsc +++ b/src/Network/Helics/Foreign/Common.hsc @@ -7,7 +7,7 @@ import Foreign.C import Foreign.Ptr -import Network.Helics.Types +import Network.Helics.Internal.Types #{enum ReturnCode, ReturnCode , returnCodeOk = NEWRELIC_RETURN_CODE_OK diff --git a/src/Network/Helics/Foreign/Transaction.hsc b/src/Network/Helics/Foreign/Transaction.hsc --- a/src/Network/Helics/Foreign/Transaction.hsc +++ b/src/Network/Helics/Foreign/Transaction.hsc @@ -8,7 +8,7 @@ import Foreign.C import Foreign.Ptr import qualified Data.ByteString as S -import Network.Helics.Types +import Network.Helics.Internal.Types autoScope, rootSegment :: SegmentId autoScope = SegmentId #const NEWRELIC_AUTOSCOPE