diff --git a/nix/mk-shell.nix b/nix/mk-shell.nix index e351fb05..4fd8bbec 100644 --- a/nix/mk-shell.nix +++ b/nix/mk-shell.nix @@ -6,11 +6,12 @@ let with pkgs.haskell.lib; overrideCabal hpkg (drv: { enableSeparateBinOutput = false; }); # It is still necessary to run `hpack --force` into packages home dirs - haskell-language-server = pkgs.haskellPackages.haskell-language-server.override { - hls-ormolu-plugin = pkgs.haskellPackages.hls-ormolu-plugin.override { - ormolu = (workaround140774 pkgs.haskellPackages.ormolu); + haskell-language-server = + pkgs.haskellPackages.haskell-language-server.override { + hls-ormolu-plugin = pkgs.haskellPackages.hls-ormolu-plugin.override { + ormolu = (workaround140774 pkgs.haskellPackages.ormolu); + }; }; - }; in pkgs.mkShell { buildInputs = [ @@ -60,6 +61,7 @@ in pkgs.mkShell { text text-zipper time + th-test-utils unordered-containers uuid vector diff --git a/nri-postgresql/setup-postgres.sh b/nri-postgresql/setup-postgres.sh index ae7130b3..eb3b1231 100755 --- a/nri-postgresql/setup-postgres.sh +++ b/nri-postgresql/setup-postgres.sh @@ -23,3 +23,7 @@ psql -c "CREATE TABLE test_table2 (enum_array_col test_enum[] NOT NULL)" || true ## Setup for test/Test.hs psql -c "CREATE TABLE constraints_table (user_id int PRIMARY KEY)" || true + +## Setup for test/ObservabilitySpec.hs +createuser -s postgres +psql -c "GRANT ALL PRIVILEGES ON DATABASE testdb TO postgres;" || true diff --git a/nri-postgresql/test/ObservabilitySpec.hs b/nri-postgresql/test/ObservabilitySpec.hs index e2ff3037..9b2d2c77 100644 --- a/nri-postgresql/test/ObservabilitySpec.hs +++ b/nri-postgresql/test/ObservabilitySpec.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE QuasiQuotes #-} module ObservabilitySpec @@ -42,7 +43,13 @@ tests postgres = ) |> spanForTask Debug.toString span - |> Expect.equalToContentsOf "test/golden-results/observability-spec-postgres-reporting" + |> Expect.equalToContentsOf +#if __GLASGOW_HASKELL__ >= 902 + "test/golden-results/observability-spec-postgres-reporting-ghc-9" +#else + "test/golden-results/observability-spec-postgres-reporting-ghc-8" +#endif + ] spanForTask :: Show e => Task e () -> Expect.Expectation' Platform.TracingSpan diff --git a/nri-postgresql/test/golden-results/observability-spec-postgres-reporting b/nri-postgresql/test/golden-results/observability-spec-postgres-reporting-ghc-8 similarity index 94% rename from nri-postgresql/test/golden-results/observability-spec-postgres-reporting rename to nri-postgresql/test/golden-results/observability-spec-postgres-reporting-ghc-8 index 8832a53f..f61c545a 100644 --- a/nri-postgresql/test/golden-results/observability-spec-postgres-reporting +++ b/nri-postgresql/test/golden-results/observability-spec-postgres-reporting-ghc-8 @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "ObservabilitySpec" , srcLocFile = "test/ObservabilitySpec.hs" - , srcLocStartLine = 53 + , srcLocStartLine = 60 , srcLocStartCol = 7 - , srcLocEndLine = 57 + , srcLocEndLine = 64 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "ObservabilitySpec" , srcLocFile = "test/ObservabilitySpec.hs" - , srcLocStartLine = 35 + , srcLocStartLine = 36 , srcLocStartCol = 11 - , srcLocEndLine = 42 + , srcLocEndLine = 43 , srcLocEndCol = 14 } ) diff --git a/nri-postgresql/test/golden-results/observability-spec-postgres-reporting-ghc-9 b/nri-postgresql/test/golden-results/observability-spec-postgres-reporting-ghc-9 new file mode 100644 index 00000000..94767efe --- /dev/null +++ b/nri-postgresql/test/golden-results/observability-spec-postgres-reporting-ghc-9 @@ -0,0 +1,76 @@ +TracingSpan + { name = "test-root" + , started = MonotonicTime { inMicroseconds = 0 } + , finished = MonotonicTime { inMicroseconds = 0 } + , frame = + Just + ( "rootTracingSpanIO" + , SrcLoc + { srcLocPackage = "main" + , srcLocModule = "ObservabilitySpec" + , srcLocFile = "test/ObservabilitySpec.hs" + , srcLocStartLine = 60 + , srcLocStartCol = 7 + , srcLocEndLine = 60 + , srcLocEndCol = 33 + } + ) + , details = Nothing + , summary = Nothing + , succeeded = Succeeded + , containsFailures = False + , allocated = 0 + , children = + [ TracingSpan + { name = "Postgresql Query" + , started = MonotonicTime { inMicroseconds = 0 } + , finished = MonotonicTime { inMicroseconds = 0 } + , frame = + Just + ( "doQuery" + , SrcLoc + { srcLocPackage = "main" + , srcLocModule = "ObservabilitySpec" + , srcLocFile = "test/ObservabilitySpec.hs" + , srcLocStartLine = 36 + , srcLocStartCol = 11 + , srcLocEndLine = 36 + , srcLocEndCol = 27 + } + ) + , details = + Just + "{\"query\":\"Secret *****\",\"query template\":\"!SELECT 1::bigint\",\"sql operation\":\"UNKNOWN\",\"queried relation\":\"!SELECT 1::bigint\",\"database type\":\"PostgreSQL\",\"host\":\"/mock/db/path.sock\",\"database\":\"mock-db-name\",\"rows returned\":1}" + , summary = Just "UNKNOWN !SELECT 1::bigint" + , succeeded = Succeeded + , containsFailures = False + , allocated = 0 + , children = + [ TracingSpan + { name = "acquiring Postgres connection from pool" + , started = MonotonicTime { inMicroseconds = 0 } + , finished = MonotonicTime { inMicroseconds = 0 } + , frame = + Just + ( "withContext" + , SrcLoc + { srcLocPackage = "main" + , srcLocModule = "Postgres" + , srcLocFile = "src/Postgres.hs" + , srcLocStartLine = 225 + , srcLocStartCol = 9 + , srcLocEndLine = 225 + , srcLocEndCol = 24 + } + ) + , details = Just "{}" + , summary = Just "acquiring Postgres connection from pool" + , succeeded = Succeeded + , containsFailures = False + , allocated = 0 + , children = [] + } + ] + } + ] + } \ No newline at end of file diff --git a/nri-redis/nri-redis.cabal b/nri-redis/nri-redis.cabal index 37060b7b..ecc553eb 100644 --- a/nri-redis/nri-redis.cabal +++ b/nri-redis/nri-redis.cabal @@ -40,6 +40,7 @@ library Redis.Codec Redis.Handler Redis.Internal + Redis.Script Redis.Settings Paths_nri_redis hs-source-dirs: @@ -68,7 +69,10 @@ library , bytestring >=0.10.8.2 && <0.12 , conduit >=1.3.0 && <1.4 , containers >=0.6.0.1 && <0.7 + , cryptohash-sha1 >=0.11.101.0 && <0.12 + , haskell-src-meta >=0.8.12 && <0.9 , hedis >=0.14.0 && <0.16 + , megaparsec >=9.2.2 && <9.4 , modern-uri >=0.3.1.0 && <0.4 , nri-env-parser >=0.1.0.0 && <0.2 , nri-observability >=0.1.0 && <0.2 @@ -76,6 +80,7 @@ library , pcre-light >=0.4.1.0 && <0.4.2 , resourcet >=1.2.0 && <1.3 , safe-exceptions >=0.1.7.0 && <1.3 + , template-haskell >=2.16 && <3.0 , text >=1.2.3.1 && <2.1 , unordered-containers >=0.2.0.0 && <0.3 , uuid >=1.3.0 && <1.4 @@ -87,6 +92,7 @@ test-suite tests other-modules: Helpers Spec.Redis + Spec.Redis.Script Spec.Settings NonEmptyDict Redis @@ -96,6 +102,7 @@ test-suite tests Redis.Hash Redis.Internal Redis.List + Redis.Script Redis.Set Redis.Settings Redis.SortedSet @@ -127,7 +134,10 @@ test-suite tests , bytestring >=0.10.8.2 && <0.12 , conduit >=1.3.0 && <1.4 , containers >=0.6.0.1 && <0.7 + , cryptohash-sha1 >=0.11.101.0 && <0.12 + , haskell-src-meta >=0.8.12 && <0.9 , hedis >=0.14.0 && <0.16 + , megaparsec >=9.2.2 && <9.4 , modern-uri >=0.3.1.0 && <0.4 , nri-env-parser >=0.1.0.0 && <0.2 , nri-observability >=0.1.0 && <0.2 @@ -135,6 +145,7 @@ test-suite tests , pcre-light >=0.4.1.0 && <0.4.2 , resourcet >=1.2.0 && <1.3 , safe-exceptions >=0.1.7.0 && <1.3 + , template-haskell >=2.16 && <3.0 , text >=1.2.3.1 && <2.1 , unordered-containers >=0.2.0.0 && <0.3 , uuid >=1.3.0 && <1.4 diff --git a/nri-redis/package.yaml b/nri-redis/package.yaml index 84d83ab3..cf34c9ec 100644 --- a/nri-redis/package.yaml +++ b/nri-redis/package.yaml @@ -20,8 +20,11 @@ dependencies: - bytestring >= 0.10.8.2 && < 0.12 - conduit >= 1.3.0 && < 1.4 - containers >= 0.6.0.1 && < 0.7 + - cryptohash-sha1 >= 0.11.101.0 && < 0.12 + - haskell-src-meta >= 0.8.12 && < 0.9 # hedis 14 introduces redis-cluster support - hedis >= 0.14.0 && < 0.16 + - megaparsec >= 9.2.2 && < 9.4 - modern-uri >= 0.3.1.0 && < 0.4 - nri-env-parser >= 0.1.0.0 && < 0.2 - nri-observability >= 0.1.0 && < 0.2 @@ -30,6 +33,7 @@ dependencies: - resourcet >= 1.2.0 && < 1.3 - safe-exceptions >= 0.1.7.0 && < 1.3 - text >= 1.2.3.1 && < 2.1 + - template-haskell >= 2.16 && < 3.0 - unordered-containers >=0.2.0.0 && <0.3 - uuid >=1.3.0 && < 1.4 library: diff --git a/nri-redis/src/Redis.hs b/nri-redis/src/Redis.hs index 080401e7..8be6379b 100644 --- a/nri-redis/src/Redis.hs +++ b/nri-redis/src/Redis.hs @@ -48,6 +48,11 @@ module Redis Internal.map3, Internal.sequence, Internal.foldWithScan, + + -- * Lua Scripting + script, + ScriptParam (..), + Internal.eval, ) where @@ -60,6 +65,7 @@ import qualified NonEmptyDict import qualified Redis.Codec as Codec import qualified Redis.Handler as Handler import qualified Redis.Internal as Internal +import Redis.Script (ScriptParam (..), script) import qualified Redis.Settings as Settings import qualified Prelude diff --git a/nri-redis/src/Redis/Handler.hs b/nri-redis/src/Redis/Handler.hs index 585617be..dc2aac2b 100644 --- a/nri-redis/src/Redis/Handler.hs +++ b/nri-redis/src/Redis/Handler.hs @@ -18,6 +18,7 @@ import qualified Dict import qualified GHC.Stack as Stack import qualified Platform import qualified Redis.Internal as Internal +import qualified Redis.Script as Script import qualified Redis.Settings as Settings import qualified Set import qualified Text @@ -76,6 +77,9 @@ timeoutAfterMilliseconds milliseconds handler' = >> Task.timeout milliseconds Internal.TimeoutError, Internal.doTransaction = Stack.withFrozenCallStack (Internal.doTransaction handler') + >> Task.timeout milliseconds Internal.TimeoutError, + Internal.doEval = + Stack.withFrozenCallStack (Internal.doEval handler') >> Task.timeout milliseconds Internal.TimeoutError } @@ -94,7 +98,10 @@ defaultExpiryKeysAfterSeconds secs handler' = |> Stack.withFrozenCallStack (Internal.doQuery handler'), Internal.doTransaction = \query' -> wrapWithExpire query' - |> Stack.withFrozenCallStack (Internal.doTransaction handler') + |> Stack.withFrozenCallStack (Internal.doTransaction handler'), + Internal.doEval = \script' -> + -- We can't guarantee auto-expire for EVAL, so we just run it as-is + Stack.withFrozenCallStack (Internal.doEval handler' script') } acquireHandler :: Text -> Settings.Settings -> IO (Internal.Handler' x, Connection) @@ -131,6 +138,8 @@ acquireHandler namespace settings = do Database.Redis.TxError err -> Right (Err (Internal.RedisError (Text.fromList err))) ) |> Stack.withFrozenCallStack (platformRedis (Internal.cmds query) connection anything), + Internal.doEval = \script' -> + Stack.withFrozenCallStack (platformRedisScript script' connection anything), Internal.namespace = namespace, Internal.maxKeySize = Settings.maxKeySize settings }, @@ -364,15 +373,7 @@ platformRedis cmds connection anything action = Ok a -> a Err err -> Err err ) - |> Exception.handle (\(_ :: Database.Redis.ConnectionLostException) -> pure <| Err Internal.ConnectionLost) - |> Exception.handleAny - ( \err -> - Exception.displayException err - |> Text.fromList - |> Internal.LibraryError - |> Err - |> pure - ) + |> handleExceptions |> Platform.doAnything anything |> Stack.withFrozenCallStack Internal.traceQuery cmds (connectionHost connection) (connectionPort connection) @@ -383,5 +384,70 @@ toResult reply = Left err -> Err (Internal.RedisError ("Redis library got back a value with a type it didn't expect: " ++ Text.fromList (Prelude.show err))) Right r -> Ok r +handleExceptions :: IO (Result Internal.Error value) -> IO (Result Internal.Error value) +handleExceptions = + Exception.handle (\(_ :: Database.Redis.ConnectionLostException) -> pure <| Err Internal.ConnectionLost) + >> Exception.handleAny + ( \err -> + Exception.displayException err + |> Text.fromList + |> Internal.LibraryError + |> Err + |> pure + ) + +-- | Run a script in Redis trying to leverage the script cache +platformRedisScript :: + (Stack.HasCallStack, Database.Redis.RedisResult a) => + Script.Script a -> + Connection -> + Platform.DoAnythingHandler -> + Task Internal.Error a +platformRedisScript script connection anything = do + -- Try EVALSHA + evalsha script connection anything + |> Task.onError + ( \err -> + case err of + Internal.RedisError "NOSCRIPT No matching script. Please use EVAL." -> do + -- If it fails with NOSCRIPT, load the script and try again + loadScript script connection anything + evalsha script connection anything + _ -> Task.fail err + ) + +evalsha :: + (Stack.HasCallStack, Database.Redis.RedisResult a) => + Script.Script a -> + Connection -> + Platform.DoAnythingHandler -> + Task Internal.Error a +evalsha script connection anything = + Database.Redis.evalsha + (toB (Script.luaScriptHash script)) + (map toB (Script.keys script)) + (map toB (Log.unSecret (Script.arguments script))) + |> Database.Redis.runRedis (connectionHedis connection) + |> map toResult + |> handleExceptions + |> Platform.doAnything anything + |> Stack.withFrozenCallStack Internal.traceQuery [Script.evalShaString script] (connectionHost connection) (connectionPort connection) + +loadScript :: + Stack.HasCallStack => + Script.Script a -> + Connection -> + Platform.DoAnythingHandler -> + Task Internal.Error () +loadScript script connection anything = do + Database.Redis.scriptLoad (toB (Script.luaScript script)) + |> Database.Redis.runRedis (connectionHedis connection) + |> map toResult + |> handleExceptions + -- The result is the hash, which we already have. No sense in decoding it. + |> map (map (\_ -> ())) + |> Platform.doAnything anything + |> Stack.withFrozenCallStack Internal.traceQuery [Script.scriptLoadString script] (connectionHost connection) (connectionPort connection) + toB :: Text -> Data.ByteString.ByteString toB = Data.Text.Encoding.encodeUtf8 diff --git a/nri-redis/src/Redis/Internal.hs b/nri-redis/src/Redis/Internal.hs index e06c7dc6..490d8866 100644 --- a/nri-redis/src/Redis/Internal.hs +++ b/nri-redis/src/Redis/Internal.hs @@ -1,6 +1,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE RankNTypes #-} +-- For the RedisResult Text instance +{-# OPTIONS_GHC -fno-warn-orphans #-} module Redis.Internal ( Error (..), @@ -18,6 +20,7 @@ module Redis.Internal sequence, query, transaction, + eval, foldWithScan, -- internal tools traceQuery, @@ -30,6 +33,7 @@ import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty +import qualified Data.Text.Encoding import qualified Database.Redis import qualified Dict import qualified GHC.Stack as Stack @@ -37,6 +41,7 @@ import qualified List import qualified Log.RedisCommands as RedisCommands import NriPrelude hiding (map, map2, map3) import qualified Platform +import qualified Redis.Script as Script import qualified Redis.Settings as Settings import qualified Set import qualified Text @@ -225,6 +230,7 @@ data HasAutoExtendExpire = NoAutoExtendExpire | AutoExtendExpire data Handler' (x :: HasAutoExtendExpire) = Handler' { doQuery :: Stack.HasCallStack => forall a. Query a -> Task Error a, doTransaction :: Stack.HasCallStack => forall a. Query a -> Task Error a, + doEval :: Stack.HasCallStack => forall a. Database.Redis.RedisResult a => Script.Script a -> Task Error a, namespace :: Text, maxKeySize :: Settings.MaxKeySize } @@ -263,6 +269,11 @@ transaction handler query' = |> Task.andThen (ensureMaxKeySize handler) |> Task.andThen (Stack.withFrozenCallStack (doTransaction handler)) +eval :: (Stack.HasCallStack, Database.Redis.RedisResult a) => Handler' x -> Script.Script a -> Task Error a +eval handler script = + Script.mapKeys (\key -> Task.succeed (namespace handler ++ ":" ++ key)) script + |> Task.andThen (Stack.withFrozenCallStack (doEval handler)) + namespaceQuery :: Text -> Query a -> Task err (Query a) namespaceQuery prefix query' = mapKeys (\key -> Task.succeed (prefix ++ key)) query' @@ -460,3 +471,23 @@ foldWithScan handler keyMatchPattern approxCountPerBatch processKeyBatch initAcc then Task.succeed nextAccumulator else go nextAccumulator nextCursor in go initAccumulator Database.Redis.cursor0 + +-------------------------------------- +-- Orphaned instances for RedisResult +-------------------------------------- +instance Database.Redis.RedisResult Text where + decode r = do + decodedBs <- Database.Redis.decode r + Prelude.pure <| Data.Text.Encoding.decodeUtf8 decodedBs + +instance Database.Redis.RedisResult Int where + decode r = do + (decodedInteger :: Prelude.Integer) <- Database.Redis.decode r + Prelude.pure <| Prelude.fromIntegral decodedInteger + +instance Database.Redis.RedisResult () where + decode r = do + (reply :: Database.Redis.Reply) <- Database.Redis.decode r + case reply of + Database.Redis.Bulk Nothing -> Prelude.pure () + other -> Prelude.Left other diff --git a/nri-redis/src/Redis/Script.hs b/nri-redis/src/Redis/Script.hs new file mode 100644 index 00000000..1ab3e5a7 --- /dev/null +++ b/nri-redis/src/Redis/Script.hs @@ -0,0 +1,286 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE UndecidableInstances #-} + +module Redis.Script + ( Script (..), + script, + -- Internal API + luaScriptHash, + evalShaString, + scriptLoadString, + mapKeys, + -- For testing + parser, + Tokens (..), + ScriptParam (..), + HasScriptParam (..), + printScript, + ) +where + +import qualified Control.Monad +import qualified Crypto.Hash.SHA1 +import qualified Data.ByteString +import Data.Either (Either (..)) +import qualified Data.Text +import qualified Data.Text.Encoding +import Data.Void (Void) +import qualified GHC.TypeLits +import Language.Haskell.Meta.Parse (parseExp) +import qualified Language.Haskell.TH as TH +import qualified Language.Haskell.TH.Quote as QQ +import Text.Megaparsec ((<|>)) +import qualified Text.Megaparsec as P +import qualified Text.Megaparsec.Char as PC +import qualified Text.Printf +import Prelude (notElem, pure, (<*)) +import qualified Prelude + +data Script result = Script + { -- | The Lua script to be executed with @args placeholders for Redis + luaScript :: Text, + -- | The script string as extracted from a `script` quasi quote. + quasiQuotedString :: Text, + keys :: [Text], + -- | The parameters that fill the placeholders in this query + arguments :: Log.Secret [Text] + } + deriving (Eq, Show) + +-- | A type for enforcing parameters used in [script|${ ... }|] are either tagged as Key or Literal. +-- +-- We need keys to be tagged, otherwise we can't implement `mapKeys` and enforce namespacing +-- in Redis APIs. +-- +-- We make this extra generic to allow us to provide nice error messages using TypeError in a +-- type class below. +data ScriptParam + = forall a. (Show a) => Key a + | forall a. (Show a) => Literal a + +class HasScriptParam a where + getScriptParam :: a -> ScriptParam + +-- | This instance is marked as INCOHERENT so that it will be chosen if possible in the overlapping case +instance {-# INCOHERENT #-} HasScriptParam ScriptParam where + getScriptParam = Prelude.id + +-- | This instance is used to provide a helpful error message when a user tries to use a type +-- other than a ScriptParam in a [script|${ ... }|] quasi quote. +-- +-- It is what forces us to hav UndecidableInstances enabled. +instance + GHC.TypeLits.TypeError ('GHC.TypeLits.Text "[script| ${..} ] interpolation only supports Key or Literal inputs.") => + HasScriptParam x + where + getScriptParam = Prelude.error "This won't ever hit bc this generates a compile-time error." + +-- | Quasi-quoter for creating a Redis Lua script with placeholders for Redis keys and arguments. +-- +-- > [script|SET ${Key "a-redis-key"} ${Literal 123}|] +-- +-- **IMPORTANT**: It is NOT SAFE to return Redis keys using this. Our Redis APIs inject +-- "namespaces" (prefixes) on keys, and any keys returned by Lua will have their namespaces +-- applied. If you try to reuse those keys in follow-up queries, namespaces will be doubly-applied. +script :: QQ.QuasiQuoter +script = + QQ.QuasiQuoter + { QQ.quoteExp = qqScript, + QQ.quoteType = Prelude.error "script not supported in types", + QQ.quotePat = Prelude.error "script not supported in patterns", + QQ.quoteDec = Prelude.error "script not supported in declarations" + } + +qqScript :: Prelude.String -> TH.Q TH.Exp +qqScript scriptWithVars = do + let quotedScript = Text.fromList scriptWithVars + let parseResult = P.parse parser "" quotedScript + case parseResult of + Left err -> Prelude.error <| "Failed to parse script: " ++ P.errorBundlePretty err + Right tokens -> do + paramsExp <- + tokens + |> Control.Monad.mapM toEvaluatedToken + |> map TH.ListE + quotedScriptExp <- [|quotedScript|] + pure <| (TH.VarE 'scriptFromEvaluatedTokens) `TH.AppE` quotedScriptExp `TH.AppE` paramsExp + +---------------------------- +-- Script template compile-time evaluation +---------------------------- + +data EvaluatedToken + = EvaluatedText Text + | EvaluatedVariable EvaluatedParam + deriving (Show, Eq) + +data EvaluatedParam = EvaluatedParam + { kind :: ParamKind, + value :: Text + } + deriving (Eq, Show) + +data ParamKind = RedisKey | ArbitraryValue + deriving (Eq, Show) + +toEvaluatedToken :: Tokens -> TH.Q TH.Exp +toEvaluatedToken token = + case token of + ScriptText text -> [|EvaluatedText text|] + ScriptVariable var -> pure <| (TH.VarE 'evaluateScriptParam) `TH.AppE` (varToExp var) + +evaluateScriptParam :: HasScriptParam a => a -> EvaluatedToken +evaluateScriptParam scriptParam = + case getScriptParam scriptParam of + Key a -> + EvaluatedVariable + <| EvaluatedParam + { kind = RedisKey, + value = unquoteString (Debug.toString a) + } + Literal a -> + EvaluatedVariable + <| EvaluatedParam + { kind = ArbitraryValue, + value = unquoteString (Debug.toString a) + } + +-- | Remove leading and trailing quotes from a string +unquoteString :: Text -> Text +unquoteString str = + str + |> Data.Text.stripPrefix "\"" + |> Maybe.andThen (Data.Text.stripSuffix "\"") + |> Maybe.withDefault str + +varToExp :: Text -> TH.Exp +varToExp var = + case parseExp (Text.toList var) of + Left err -> Prelude.error <| "Failed to parse variable: " ++ err + Right exp -> exp + +----------------------------- +-- Script record construction +----------------------------- + +data ScriptBuilder = ScriptBuilder + { buffer :: Text, + keyIdx :: Int, + keyList :: List Text, + argIdx :: Int, + argList :: List Text + } + +scriptFromEvaluatedTokens :: Text -> [EvaluatedToken] -> Script a +scriptFromEvaluatedTokens quasiQuotedString' evaluatedTokens = + let keyTpl n = "KEYS[" ++ Text.fromInt n ++ "]" + argTpl n = "ARGV[" ++ Text.fromInt n ++ "]" + script' = + List.foldl + ( \token scriptBuilder@(ScriptBuilder {buffer, keyIdx, keyList, argIdx, argList}) -> + case token of + EvaluatedText text -> scriptBuilder {buffer = buffer ++ text} + EvaluatedVariable var -> + case kind var of + RedisKey -> + scriptBuilder + { buffer = buffer ++ keyTpl (keyIdx + 1), + keyIdx = keyIdx + 1, + keyList = value var : keyList + } + ArbitraryValue -> + scriptBuilder + { buffer = buffer ++ argTpl (argIdx + 1), + argIdx = argIdx + 1, + argList = value var : argList + } + ) + (ScriptBuilder "" 0 [] 0 []) + evaluatedTokens + in Script + { luaScript = buffer script', + quasiQuotedString = quasiQuotedString', + keys = keyList script', + arguments = Log.mkSecret (argList script') + } + +----------------------------- +-- Quasi-quoted text parser +----------------------------- + +-- | Tokens after parsing quasi-quoted text +data Tokens + = ScriptText Text + | ScriptVariable Text + deriving (Show, Eq) + +type Parser = P.Parsec Void Text + +parser :: Parser (List Tokens) +parser = do + (P.some (parseText <|> parseVariable)) + <* P.eof + +parseText :: Parser Tokens +parseText = do + text <- P.takeWhile1P (Just "some plain text") (/= '$') + pure <| ScriptText text + +parseVariable :: Parser Tokens +parseVariable = do + _ <- PC.string "${" + _ <- PC.space + name <- P.takeWhile1P (Just "anything but '$', '{' or '}' (no records, sorry)") (\t -> t `notElem` ['$', '{', '}']) + _ <- PC.char '}' + pure <| ScriptVariable <| Text.trim name + +--------------------------------------------- +-- Helper functions for internal library use +--------------------------------------------- + +-- | EVALSHA hash numkeys [key [key ...]] [arg [arg ...]] +evalShaString :: Script a -> Text +evalShaString script'@(Script {keys, arguments}) = + let keyCount = keys |> List.length |> Text.fromInt + keys' = keys |> Text.join " " + args' = arguments |> Log.unSecret |> List.map (\_ -> "***") |> Text.join " " + hash = luaScriptHash script' + in "EVALSHA " ++ hash ++ " " ++ keyCount ++ " " ++ keys' ++ " " ++ args' + +-- | SCRIPT LOAD "return KEYS[1]" +scriptLoadString :: Script a -> Text +scriptLoadString Script {luaScript} = + "SCRIPT LOAD \"" ++ luaScript ++ "\"" + +-- | Map the keys in the script to the keys in the Redis API +mapKeys :: (Text -> Task err Text) -> Script a -> Task err (Script a) +mapKeys fn script' = do + keys script' + |> List.map fn + |> Task.sequence + |> Task.map (\keys' -> script' {keys = keys'}) + +luaScriptHash :: Script a -> Text +luaScriptHash Script {luaScript} = + luaScript + |> Data.Text.Encoding.encodeUtf8 + |> Crypto.Hash.SHA1.hash + |> toHex + +toHex :: Data.ByteString.ByteString -> Text +toHex bytes = + bytes + |> Data.ByteString.unpack + |> List.map (Text.Printf.printf "%02x") + |> List.concat + |> Text.fromList + +--------------------------------------------- +-- Helper functions for testing +--------------------------------------------- + +printScript :: Script a -> Text +printScript Script {luaScript, quasiQuotedString, keys, arguments} = + let listStr l = List.map (\s -> "\"" ++ s ++ "\"") l |> Text.join ", " + in "Script { luaScript = \"" ++ luaScript ++ "\", quasiQuotedString = \"" ++ quasiQuotedString ++ "\", keys = [" ++ listStr keys ++ "], arguments = [" ++ listStr (Log.unSecret arguments) ++ "] }" diff --git a/nri-redis/test/Helpers.hs b/nri-redis/test/Helpers.hs index 406a1716..9522e36c 100644 --- a/nri-redis/test/Helpers.hs +++ b/nri-redis/test/Helpers.hs @@ -30,11 +30,10 @@ getHandlers = do -- > foo -- > bar -- > baz --- +-- -- In GHC 8.10.x (and possibly GHC 9.0.x?) `srcLocEndLine` and `srcLocEndCol` -- would correspond to the `z` at the end of `baz`. Unfortunately, in GHC 9.2.x -- it corresponds to the second `o` at the end of `foo`. - goldenResultsDir :: Text #if __GLASGOW_HASKELL__ >= 902 goldenResultsDir = "test/golden-results-9.2" diff --git a/nri-redis/test/Spec.hs b/nri-redis/test/Spec.hs index c4728238..bccfe6e0 100644 --- a/nri-redis/test/Spec.hs +++ b/nri-redis/test/Spec.hs @@ -1,6 +1,7 @@ import qualified Conduit import Helpers import qualified Spec.Redis +import qualified Spec.Redis.Script import qualified Spec.Settings import qualified Test import qualified Prelude @@ -12,5 +13,6 @@ main = <| Test.describe "nri-redis" [ Spec.Redis.tests testHandlers, - Spec.Settings.tests + Spec.Settings.tests, + Spec.Redis.Script.tests ] diff --git a/nri-redis/test/Spec/Redis.hs b/nri-redis/test/Spec/Redis.hs index 394c671d..2ebecc15 100644 --- a/nri-redis/test/Spec/Redis.hs +++ b/nri-redis/test/Spec/Redis.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE QuasiQuotes #-} + module Spec.Redis (tests) where import qualified Control.Concurrent.MVar as MVar @@ -369,7 +371,52 @@ queryTests redisHandler = |> Expect.equal (List.length expectedKeys) keySet |> Set.toList - |> Expect.equal expectedKeys + |> Expect.equal expectedKeys, + Test.test "eval runs and returns something" <| \() -> do + let script = [Redis.script|return 1|] + result <- Redis.eval testNS script |> Expect.succeeds + Expect.equal result 1, + Test.test "eval returns Int" <| \() -> do + let script = [Redis.script|return 1|] + (result :: Int) <- Redis.eval testNS script |> Expect.succeeds + Expect.equal result 1, + Test.test "eval returns ()" <| \() -> do + let script = [Redis.script|redis.call("ECHO", "hi")|] + Redis.eval testNS script |> Expect.succeeds, + Test.test "eval returns List Int" <| \() -> do + let script = [Redis.script|return {1,2}|] + (result :: List Int) <- Redis.eval testNS script |> Expect.succeeds + Expect.equal result [1, 2], + Test.test "eval with arguments runs and returns something" <| \() -> do + let script = + [Redis.script| + local a = ${Redis.Key "hi"} + local b = ${Redis.Literal "hello"} + return 1|] + result <- Redis.eval testNS script |> Expect.succeeds + Expect.equal result 1, + Test.test "eval with arguments returns argument" <| \() -> do + let script = + [Redis.script| + local a = ${Redis.Key 2} + local b = ${Redis.Literal 3} + return b|] + result <- Redis.eval testNS script |> Expect.succeeds + Expect.equal result 3, + Test.test "eval with arguments namespaces key" <| \() -> do + let script = [Redis.script|return ${Redis.Key "hi"}|] + (result :: Text) <- Redis.eval testNS script |> Expect.succeeds + Expect.true + ( List.member + result + -- All tests here run twice: + -- - once with the auto-extend-expire handler + -- - once with the normal handler + -- each run generates a different namespace + [ "tests-auto-extend-expire:testNamespace:hi", + "tests:testNamespace:hi" + ] + ) ] where testNS = addNamespace "testNamespace" redisHandler diff --git a/nri-redis/test/Spec/Redis/Script.hs b/nri-redis/test/Spec/Redis/Script.hs new file mode 100644 index 00000000..1c638cf2 --- /dev/null +++ b/nri-redis/test/Spec/Redis/Script.hs @@ -0,0 +1,132 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +module Spec.Redis.Script (tests) where + +import qualified Data.Bifunctor +import Data.Either (Either (..)) +import qualified Expect +import Redis.Script +import qualified Test +import qualified Text.Megaparsec as P + +tests :: Test.Test +tests = + Test.describe + "Redis.Script" + [ Test.describe "parser" parserTests, + Test.describe "th tests" thTests + ] + +parserTests :: List Test.Test +parserTests = + [ Test.test "1 word" <| \_ -> + P.runParser parser "" "Jabuticaba" + |> Expect.equal (Right [ScriptText "Jabuticaba"]), + Test.test "3 words" <| \_ -> + P.runParser parser "" "Picolé de Jabuticaba" + |> Expect.equal (Right [ScriptText "Picolé de Jabuticaba"]), + Test.test "1 value" <| \_ -> + P.runParser parser "" "${value}" + |> Expect.equal (Right [ScriptVariable "value"]), + Test.test "function application" <| \_ -> + P.runParser parser "" "${func arg1 arg2}" + |> Expect.equal (Right [ScriptVariable "func arg1 arg2"]), + Test.test "text and variables" <| \_ -> + P.runParser parser "" "some text ${value} some more text ${ anotherValue }" + |> Expect.equal + ( Right + [ ScriptText "some text ", + ScriptVariable "value", + ScriptText " some more text ", + ScriptVariable "anotherValue" + ] + ), + Test.test "ERROR: empty" <| \_ -> do + P.runParser parser "" "" + |> Data.Bifunctor.first P.errorBundlePretty + |> Expect.equal + ( Left + "1:1:\n\ + \ |\n\ + \1 | \n\ + \ | ^\n\ + \unexpected end of input\n\ + \expecting \"${\" or some plain text\n\ + \" + ), + Test.test "ERROR: empty variable" <| \_ -> do + P.runParser parser "" "${}" + |> Data.Bifunctor.first P.errorBundlePretty + |> Expect.equal + ( Left + "1:3:\n\ + \ |\n\ + \1 | ${}\n\ + \ | ^\n\ + \unexpected '}'\n\ + \expecting anything but '$', '{' or '}' (no records, sorry) or white space\n\ + \" + ), + Test.test "ERROR: nested ${}" <| \_ -> do + P.runParser parser "" "asdasd ${ ${ value } }" + |> Data.Bifunctor.first P.errorBundlePretty + |> Expect.equal + ( Left + "1:11:\n\ + \ |\n\ + \1 | asdasd ${ ${ value } }\n\ + \ | ^\n\ + \unexpected '$'\n\ + \expecting anything but '$', '{' or '}' (no records, sorry) or white space\n\ + \" + ), + Test.test "ERROR: misplaced ${ inside ${}" <| \_ -> do + P.runParser parser "" "${ v$alue }" + |> Data.Bifunctor.first P.errorBundlePretty + |> Expect.equal + ( Left + "1:5:\n\ + \ |\n\ + \1 | ${ v$alue }\n\ + \ | ^\n\ + \unexpected '$'\n\ + \expecting '}' or anything but '$', '{' or '}' (no records, sorry)\n\ + \" + ), + Test.test "ERROR: misplaced { inside ${}" <| \_ -> do + P.runParser parser "" "${ v{alue }" + |> Data.Bifunctor.first P.errorBundlePretty + |> Expect.equal + ( Left + "1:5:\n\ + \ |\n\ + \1 | ${ v{alue }\n\ + \ | ^\n\ + \unexpected '{'\n\ + \expecting '}' or anything but '$', '{' or '}' (no records, sorry)\n\ + \" + ) + ] + +thTests :: List Test.Test +thTests = + [ Test.test "just text" <| \_ -> + [script|some text|] + |> printScript + |> Expect.equal "Script { luaScript = \"some text\", quasiQuotedString = \"some text\", keys = [], arguments = [] }", + Test.test "one key argument" <| \_ -> + [script|${Key "hi"}|] + |> printScript + |> Expect.equal "Script { luaScript = \"KEYS[1]\", quasiQuotedString = \"${Key \"hi\"}\", keys = [\"hi\"], arguments = [] }", + Test.test "fails on type-checking when not given Key or Literal" <| \_ -> + [script|${False}|] + |> arguments + |> Log.unSecret + |> Expect.equal ["this would have been a type-checking error"] + ] + +-- This instance is picked when none of the instances in src/Redis/Script.hs work.. +-- proving in real code we would have a type-checking error. +instance {-# INCOHERENT #-} HasScriptParam Bool where + getScriptParam _ = Literal "this would have been a type-checking error" diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-query b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-query index dad85b78..a44457e7 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-query +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 103 + , srcLocStartLine = 105 , srcLocStartCol = 9 - , srcLocEndLine = 103 + , srcLocEndLine = 105 , srcLocEndCol = 68 } ) diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-transaction b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-transaction index 21c2a3f3..5b14ef76 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-transaction +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-counter-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 110 + , srcLocStartLine = 112 , srcLocStartCol = 9 - , srcLocEndLine = 110 + , srcLocEndLine = 112 , srcLocEndCol = 74 } ) diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-query b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-query index 12e996ff..dbc01a55 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-query +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 75 + , srcLocStartLine = 77 , srcLocStartCol = 9 - , srcLocEndLine = 75 + , srcLocEndLine = 77 , srcLocEndCol = 59 } ) diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-transaction b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-transaction index 1940b213..18d639d6 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-transaction +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-hash-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 82 + , srcLocStartLine = 84 , srcLocStartCol = 9 - , srcLocEndLine = 82 + , srcLocEndLine = 84 , srcLocEndCol = 65 } ) diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-query b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-query index f5b9c766..8923bfe1 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-query +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 89 + , srcLocStartLine = 91 , srcLocStartCol = 9 - , srcLocEndLine = 89 + , srcLocEndLine = 91 , srcLocEndCol = 59 } ) diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-transaction b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-transaction index 1d1ed703..ad1e253d 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-transaction +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-list-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 96 + , srcLocStartLine = 98 , srcLocStartCol = 9 - , srcLocEndLine = 96 + , srcLocEndLine = 98 , srcLocEndCol = 65 } ) diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-query b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-query index 755a0de0..1fcd70c0 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-query +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 61 + , srcLocStartLine = 63 , srcLocStartCol = 9 - , srcLocEndLine = 61 + , srcLocEndLine = 63 , srcLocEndCol = 45 } ) diff --git a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-transaction b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-transaction index 2c7749ea..345a0841 100644 --- a/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-transaction +++ b/nri-redis/test/golden-results-8.10/observability-spec-reporting-redis-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 33 + , srcLocEndLine = 35 , srcLocEndCol = 40 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 68 + , srcLocStartLine = 70 , srcLocStartCol = 9 - , srcLocEndLine = 68 + , srcLocEndLine = 70 , srcLocEndCol = 51 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-query b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-query index 603091d3..04341825 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-query +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 103 + , srcLocStartLine = 105 , srcLocStartCol = 9 - , srcLocEndLine = 103 + , srcLocEndLine = 105 , srcLocEndCol = 28 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-transaction b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-transaction index c23d218d..e07ff4cb 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-transaction +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 110 + , srcLocStartLine = 112 , srcLocStartCol = 9 - , srcLocEndLine = 110 + , srcLocEndLine = 112 , srcLocEndCol = 34 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-query b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-query index 8f3276fe..ac4a6b9d 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-query +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 75 + , srcLocStartLine = 77 , srcLocStartCol = 9 - , srcLocEndLine = 75 + , srcLocEndLine = 77 , srcLocEndCol = 25 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-transaction b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-transaction index ea1b4dae..0adbbfc1 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-transaction +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 82 + , srcLocStartLine = 84 , srcLocStartCol = 9 - , srcLocEndLine = 82 + , srcLocEndLine = 84 , srcLocEndCol = 31 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-query b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-query index fad2b828..45249434 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-query +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 89 + , srcLocStartLine = 91 , srcLocStartCol = 9 - , srcLocEndLine = 89 + , srcLocEndLine = 91 , srcLocEndCol = 25 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-transaction b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-transaction index af1747c1..32e95609 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-transaction +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 96 + , srcLocStartLine = 98 , srcLocStartCol = 9 - , srcLocEndLine = 96 + , srcLocEndLine = 98 , srcLocEndCol = 31 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-query b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-query index 6c6bad25..90079f79 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-query +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-query @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 61 + , srcLocStartLine = 63 , srcLocStartCol = 9 - , srcLocEndLine = 61 + , srcLocEndLine = 63 , srcLocEndCol = 20 } ) diff --git a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-transaction b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-transaction index 4c668af9..a501c913 100644 --- a/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-transaction +++ b/nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-transaction @@ -9,9 +9,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 29 + , srcLocStartLine = 31 , srcLocStartCol = 7 - , srcLocEndLine = 29 + , srcLocEndLine = 31 , srcLocEndCol = 33 } ) @@ -32,9 +32,9 @@ TracingSpan { srcLocPackage = "main" , srcLocModule = "Spec.Redis" , srcLocFile = "test/Spec/Redis.hs" - , srcLocStartLine = 68 + , srcLocStartLine = 70 , srcLocStartCol = 9 - , srcLocEndLine = 68 + , srcLocEndLine = 70 , srcLocEndCol = 26 } )