Merge pull request #12 from aviaviavi/logging

Verbosity levels

README.md

@@ -8,7 +8,8 @@ curl-runnings is a framework for writing declarative, curl based tests for your
 
 Write your tests quickly and correctly with a straight-forward specification in
 yaml or json. A DSL for writing your tests is on the way! Alternatively, you can
-use the curl-runnings library to write your tests directly in Haskell.
+use the curl-runnings library to write your tests in Haskell (a haskell setup is
+absolutely not required to use this tool).
 
 ### Why?
 
@@ -33,8 +34,7 @@ There are few options to install:
 
 - download the releases from the
   github [releases page](https://github.com/aviaviavi/curl-runnings/releases)
-- `stack install curl-runnings`
-- `cabal install curl-runnings`
+- install the binary with `stack` or `cabal`
 - build from source with `stack`
 
 ### Writing a test specification
@@ -56,11 +56,13 @@ For more info:
 
 ```bash $ curl-runnings --help ```
 
-### Roadmap
+### Contributing
 
 Curl-runnings is totally usable now but is also being actively developed.
 Contributions in any form are welcome and encouraged. Don't be shy! :D
 
+### Roadmap
+
 - [x] Json specifications for tests
 - [x] Yaml specifications for tests
 - [ ] More specification features
@@ -71,7 +73,6 @@ Contributions in any form are welcome and encouraged. Don't be shy! :D
   - [ ] Timeouts
   - [ ] Support for non-json content type
   - [ ] Retry logic
-  - [ ] Ability to configure alerts
 - [ ] Embedded dsl for specifications for tests. As the specification gets more complex.
   - [ ] Spec out dsl that can compile down into a yaml/json spec
   - [ ] Implement dsl

app/Main.hs

@@ -3,9 +3,9 @@
 
 module Main where
 
-import qualified Data.Text                       as T
-import           Data.Version                    (showVersion)
-import           Paths_curl_runnings             (version)
+import qualified Data.Text                     as T
+import           Data.Version                  (showVersion)
+import           Paths_curl_runnings           (version)
 import           System.Console.CmdArgs
 import           System.Environment
 import           System.Exit
@@ -24,23 +24,30 @@ argParser =
   CurlRunnings {file = def &= typFile &= help "File to run"} &=
   summary ("curl-runnings " ++ showVersion version) &=
   program "curl-runnings" &=
+  verbosity &=
   help "Use the --file or -f flag to specify an intput file spec to run"
 
-runFile :: FilePath -> IO ()
-runFile "" =
+runFile :: FilePath -> Verbosity -> IO ()
+runFile "" _ =
   putStrLn
     "Please specify an input file with the --file (-f) flag or use --help for more information"
-runFile path = do
-      home <- getEnv "HOME"
-      suite <- decodeFile . T.unpack $ T.replace "~" (T.pack home) (T.pack path)
-      case suite of
-        Right s -> do
-          results <- runSuite s
-          if any isFailing results
-            then putStrLn (makeRed "Some tests failed") >>
-                 exitWith (ExitFailure 1)
-            else putStrLn $ makeGreen "All tests passed!"
-        Left messgage -> putStrLn . makeRed $ "Couldn't read input json or yaml file: " ++ messgage
+runFile path verbosityLevel = do
+  home <- getEnv "HOME"
+  suite <- decodeFile . T.unpack $ T.replace "~" (T.pack home) (T.pack path)
+  case suite of
+    Right s -> do
+      results <- runSuite s $ toLogLevel verbosityLevel
+      if any isFailing results
+        then putStrLn (makeRed "Some tests failed") >> exitWith (ExitFailure 1)
+        else putStrLn $ makeGreen "All tests passed!"
+    Left messgage ->
+      putStrLn . makeRed $ "Couldn't read input json or yaml file: " ++ messgage
+
+toLogLevel :: Verbosity -> LogLevel
+toLogLevel v = toEnum $ fromEnum v
 
 main :: IO ()
-main = cmdArgs argParser >>= runFile . file
+main = do
+  userArgs <- cmdArgs argParser
+  verbosityLevel <- getVerbosity
+  runFile (file userArgs) verbosityLevel

curl-runnings.cabal

@@ -2,10 +2,10 @@
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: f7bf475463248ca5311f48309a9d417ac30a9591678a51010e5a1813dbaefd76
+-- hash: 00ab6da505f40306f6558ac123f3c5e24a78dcf4cb61b5f8d7facc514c8b68dd
 
 name:           curl-runnings
-version:        0.5.5
+version:        0.6.0
 synopsis:       A framework for declaratively writing curl based API tests
 description:    Please see the README on Github at <https://github.com/aviaviavi/curl-runnings#readme>
 category:       Testing

package.yaml

@@ -1,5 +1,5 @@
 name:                curl-runnings
-version:             0.5.5
+version:             0.6.0
 github:              aviaviavi/curl-runnings
 license:             MIT
 author:              Avi Press

src/Testing/CurlRunnings.hs

@@ -66,11 +66,13 @@ runCase state curlCase = do
           return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase l]
         Right replacedJSON -> do
           initReq <- parseRequest $ T.unpack interpolatedUrl
-          response <-
-            httpBS .
-            setRequestBodyJSON (fromMaybe emptyObject replacedJSON) .
-            setRequestHeaders (toHTTPHeaders interpolatedHeaders) $
-            initReq {method = B8S.pack . show $ requestMethod curlCase}
+          let request =
+                setRequestBodyJSON (fromMaybe emptyObject replacedJSON) .
+                setRequestHeaders (toHTTPHeaders interpolatedHeaders) $
+                initReq {method = B8S.pack . show $ requestMethod curlCase}
+          logger state DEBUG (show request)
+          response <- httpBS request
+          logger state DEBUG (show response)
           returnVal <-
             (return . decode . B.fromStrict $ getResponseBody response) :: IO (Maybe Value)
           let returnCode = getResponseStatusCode response
@@ -97,7 +99,9 @@ checkHeaders state curlCase@(CurlCase _ _ _ _ _ _ _ (Just (HeaderMatcher m))) re
        Left f -> Just $ QueryFailure curlCase f
        Right headerList ->
          let notFound =
-               filter (not . headerIn receivedHeaders) headerList
+               filter
+                 (not . headerIn receivedHeaders)
+                 (unsafeLogger state DEBUG "header matchers" headerList)
          in if null notFound
               then Nothing
               else Just $
@@ -120,7 +124,7 @@ interpolatePartialHeader state (PartialHeaderMatcher k v) =
        (Nothing, Just (Right p)) ->
          Right $ PartialHeaderMatcher Nothing (Just p)
        _ ->
-         tracer "WARNING: empty header matcher found" . Right $
+         unsafeLogger state ERROR "WARNING: empty header matcher found" . Right $
          PartialHeaderMatcher Nothing Nothing
 
 interpolateHeaders :: CurlRunningsState -> Headers -> Either QueryError Headers
@@ -152,19 +156,19 @@ printR :: Show a => a -> IO a
 printR x = print x >> return x
 
 -- | Runs the test cases in order and stop when an error is hit. Returns all the results
-runSuite :: CurlSuite -> IO [CaseResult]
-runSuite (CurlSuite cases) = do
+runSuite :: CurlSuite -> LogLevel -> IO [CaseResult]
+runSuite (CurlSuite cases) logLevel = do
   fullEnv <- getEnvironment
   let envMap = H.fromList $ map (\(x, y) -> (T.pack x, T.pack y)) fullEnv
   foldM
     (\prevResults curlCase ->
        case safeLast prevResults of
          Just CaseFail {} -> return prevResults
          Just CasePass {} -> do
-           result <- runCase (CurlRunningsState envMap prevResults) curlCase >>= printR
+           result <- runCase (CurlRunningsState envMap prevResults logLevel) curlCase >>= printR
            return $ prevResults ++ [result]
          Nothing -> do
-           result <- runCase (CurlRunningsState envMap []) curlCase >>= printR
+           result <- runCase (CurlRunningsState envMap [] logLevel) curlCase >>= printR
            return [result])
     []
     cases
@@ -176,7 +180,7 @@ checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (Exactly expectedValue)) _ _)
   case runReplacements state expectedValue of
     (Left err) -> Just $ QueryFailure curlCase err
     (Right interpolated) ->
-      if interpolated /= receivedBody
+      if (unsafeLogger state DEBUG "exact body matcher" interpolated) /= receivedBody
         then Just $
              DataFailure
                (curlCase {expectData = Just $ Exactly interpolated})
@@ -189,7 +193,7 @@ checkBody state curlCase@(CurlCase _ _ _ _ _ (Just (Contains subexprs)) _ _) (Ju
   case runReplacementsOnSubvalues state subexprs of
     Left f -> Just $ QueryFailure curlCase f
     Right updatedMatcher ->
-      if jsonContainsAll receivedBody updatedMatcher
+      if jsonContainsAll receivedBody (unsafeLogger state DEBUG "partial json body matcher" updatedMatcher)
         then Nothing
         else Just $
              DataFailure curlCase (Contains updatedMatcher) (Just receivedBody)
@@ -291,13 +295,13 @@ getStringValueForQuery state i@(InterpolatedQuery rawText (Query _)) =
     Left l           -> Left l
     Right (String s) -> Right $ rawText <> s
     (Right o)        -> Left $ QueryTypeMismatch "Expected a string" o
-getStringValueForQuery (CurlRunningsState env _) (InterpolatedQuery rawText (EnvironmentVariable v)) =
+getStringValueForQuery (CurlRunningsState env _ _) (InterpolatedQuery rawText (EnvironmentVariable v)) =
   Right $ rawText <> H.lookupDefault "" v env
 
 -- | Lookup the value for the specified query
 getValueForQuery :: CurlRunningsState -> InterpolatedQuery -> Either QueryError Value
 getValueForQuery _ (LiteralText rawText) = Right $ String rawText
-getValueForQuery (CurlRunningsState _ previousResults) full@(NonInterpolatedQuery (Query indexes)) =
+getValueForQuery (CurlRunningsState _ previousResults _) full@(NonInterpolatedQuery (Query indexes)) =
   case head indexes of
     (CaseResultIndex i) ->
       let (CasePass _ _ returnedJSON) = arrayGet previousResults $ fromInteger i
@@ -324,7 +328,7 @@ getValueForQuery (CurlRunningsState _ previousResults) full@(NonInterpolatedQuer
     _ ->
       Left . QueryValidationError $
       T.pack $ "$<> queries must start with a SUITE[index] query: " ++ show full
-getValueForQuery (CurlRunningsState env _) (NonInterpolatedQuery (EnvironmentVariable var)) =
+getValueForQuery (CurlRunningsState env _ _) (NonInterpolatedQuery (EnvironmentVariable var)) =
   Right . String $ H.lookupDefault "" var env
 getValueForQuery state (InterpolatedQuery _ q) =
   case getValueForQuery state (NonInterpolatedQuery q) of

src/Testing/CurlRunnings/Internal.hs

@@ -6,9 +6,16 @@ module Testing.CurlRunnings.Internal
   , tracer
   , mapRight
   , arrayGet
+  , makeLogger
+  , makeUnsafeLogger
+
+  , LogLevel(..)
+  , CurlRunningsLogger
+  , CurlRunningsUnsafeLogger
   ) where
 
-import Debug.Trace
+import           Control.Monad
+import           Debug.Trace
 
 makeGreen :: String -> String
 makeGreen s = "\x1B[32m" ++ s ++ "\x1B[0m"
@@ -28,3 +35,26 @@ arrayGet :: [a] -> Int -> a
 arrayGet a i
   | i >= 0 = a !! i
   | otherwise = reverse a !! (-i)
+
+data LogLevel = ERROR | INFO | DEBUG deriving (Show, Eq, Ord, Enum)
+
+-- | A logger that respects the verbosity level given by input args
+type CurlRunningsLogger = (LogLevel -> String -> IO ())
+
+-- | A tracer that respects the verbosity level given by input args. Logging
+-- with this calls out to Debug.trace and can be used in pure code, but be aware
+-- of the unsafe IO.
+type CurlRunningsUnsafeLogger a = (LogLevel -> String -> a -> a)
+
+makeLogger :: LogLevel -> CurlRunningsLogger
+makeLogger threshold level text =
+  when (level <= threshold) $ putStrLn text
+
+makeUnsafeLogger :: Show a => LogLevel -> CurlRunningsUnsafeLogger a
+makeUnsafeLogger threshold level text object =
+  if level <= threshold then
+    tracer text object
+  else
+    object
+
+

src/Testing/CurlRunnings/Types.hs

@@ -26,6 +26,8 @@ module Testing.CurlRunnings.Types
 
   , isFailing
   , isPassing
+  , logger
+  , unsafeLogger
 
   ) where
 
@@ -240,47 +242,57 @@ data AssertionFailure
   -- | Something else
   | UnexpectedFailure
 
+
+colorizeExpects :: String -> String
+colorizeExpects t =
+  let expectedColor = makeRed "Excpected:"
+      actualColor = makeRed "Actual:"
+      replacedExpected = T.replace "Expected:" (T.pack expectedColor) (T.pack t)
+  in T.unpack $ T.replace "Actual:" (T.pack actualColor) replacedExpected
+
 instance Show AssertionFailure where
   show (StatusFailure c receivedCode) =
     case expectStatus c of
       ExactCode code ->
+        colorizeExpects $
         printf
           "Incorrect status code from %s. Expected: %s. Actual: %s"
           (url c)
           (show code)
           (show receivedCode)
       AnyCodeIn codes ->
+        colorizeExpects $
         printf
-          "Incorrect status code from %s. Expected one of: %s. Actual: %s"
+          "Incorrect status code from %s. Expected: %s. Actual: %s"
           (url c)
           (show codes)
           (show receivedCode)
   show (DataFailure curlCase expected receivedVal) =
     case expected of
       Exactly expectedVal ->
-
+        colorizeExpects $
         printf
           "JSON response from %s didn't match spec. Expected: %s. Actual: %s"
           (url curlCase)
           (B8.unpack (encodePretty expectedVal))
           (B8.unpack (encodePretty receivedVal))
       (Contains expectedVals) ->
+        colorizeExpects $
         printf
           "JSON response from %s didn't contain the matcher. Expected: %s to be each be subvalues in: %s"
           (url curlCase)
           (B8.unpack (encodePretty expectedVals))
           (B8.unpack (encodePretty receivedVal))
   show (HeaderFailure curlCase expected receivedHeaders) =
+    colorizeExpects $
     printf
-      "Headers from %s didn't contain expected headers. Expected headers: %s. Received headers: %s"
+      "Headers from %s didn't contain expected headers. Expected: %s. Actual: %s"
       (url curlCase)
       (show expected)
       (show receivedHeaders)
   show (QueryFailure curlCase queryErr) =
-    printf
-      "JSON query error in spec %s: %s"
-      (name curlCase)
-      (show queryErr)
+    colorizeExpects $
+    printf "JSON query error in spec %s: %s" (name curlCase) (show queryErr)
   show UnexpectedFailure = "Unexpected Error D:"
 
 -- | A type representing the result of a single curl, and all associated
@@ -325,7 +337,13 @@ isFailing = not . isPassing
 type Environment = H.HashMap T.Text T.Text
 
 -- | The state of a suite. Tracks environment variables, and all the test results so far
-data CurlRunningsState = CurlRunningsState Environment [CaseResult]
+data CurlRunningsState = CurlRunningsState Environment [CaseResult] LogLevel
+
+logger :: CurlRunningsState -> CurlRunningsLogger
+logger (CurlRunningsState _ _ l) = makeLogger l
+
+unsafeLogger :: Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
+unsafeLogger (CurlRunningsState _ _ l) = makeUnsafeLogger l
 
 -- | A single lookup operation in a json query
 data Index
@@ -364,7 +382,8 @@ data InterpolatedQuery
 
 printQueryString :: InterpolatedQuery -> String
 printQueryString (LiteralText t) = show t
-printQueryString (InterpolatedQuery raw (Query indexes)) = printf "%s$<%s>" raw (concat $ map show indexes)
+printQueryString (InterpolatedQuery raw (Query indexes)) =
+  printf "%s$<%s>" raw (concat $ map show indexes)
 printQueryString (NonInterpolatedQuery (Query indexes)) = printf "$<%s>" (concat $ map show indexes)
 
 -- | The full string in which a query appears, eg "prefix-${{SUITE[0].key.another_key[0].last_key}}"