curl-runnings 0.12.0 → 0.14.0

raw patch · 7 files changed

+132/−44 lines, 7 filesdep +base64-bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: base64-bytestring

API changes (from Hackage documentation)

Files

• app/Main.hs +36/−11
• curl-runnings.cabal +4/−2
• examples/auth.yaml +11/−0
• src/Testing/CurlRunnings.hs +28/−12
• src/Testing/CurlRunnings/Internal.hs +4/−1
• src/Testing/CurlRunnings/Types.hs +49/−17
• test/Spec.hs +0/−1

@@ -9,6 +9,7 @@ import           Control.Monad import           Data.Aeson import qualified Data.ByteString.Lazy          as B+import           Data.Foldable import           Data.List import qualified Data.List.NonEmpty            as NE import           Data.Maybe@@ -33,6 +34,7 @@   { file           :: FilePath   , grep           :: Maybe T.Text   , upgrade        :: Bool+  , json_output    :: Maybe FilePath   , skip_tls_check :: Bool   } deriving (Show, Data, Typeable, Eq) @@ -40,11 +42,17 @@ argParser :: CurlRunnings argParser =   CurlRunnings-  { file = def &= typFile &= help "File to run"-  , grep = def &= help "Regex to filter test cases by name"-  , upgrade = def &= help "Pull the latest version of curl runnings"-  , skip_tls_check = def &= help "Don't perform a TLS check (USE WITH CAUTION. Only use this if you signed your own certs)"-  } &=+    { file = def &= typFile &= help "File to run"+    , grep = def &= help "Regex to filter test cases by name"+    , upgrade = def &= help "Pull the latest version of curl runnings"+    , json_output =+        def &= typFile &=+        help "Write test results to a json file specified by path"+    , skip_tls_check =+        def &=+        help+          "Don't perform a TLS check (USE WITH CAUTION. Only use this if you signed your own certs)"+    } &=   summary ("curl-runnings " ++ showVersion version) &=   program "curl-runnings" &=   verbosity &=@@ -74,17 +82,26 @@ setGithubReqHeaders :: Request -> Request setGithubReqHeaders = setRequestHeaders [("User-Agent", "aviaviavi")] -runFile :: FilePath -> Verbosity -> Maybe T.Text -> TLSCheckType -> IO ()-runFile "" _ _ _ =+runFile ::+     FilePath+  -> Verbosity+  -> Maybe T.Text+  -> TLSCheckType+  -> Maybe FilePath+  -> IO ()+runFile "" _ _ _ _ =   putStrLn     "Please specify an input file with the --file (-f) flag or use --help for more information"-runFile path verbosityLevel regexp tlsType = do+runFile path verbosityLevel regexp tlsType maybeOutputFile = 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 {suiteCaseFilter = regexp}) (toLogLevel verbosityLevel) $ tlsType+        runSuite (s {suiteCaseFilter = regexp}) (toLogLevel verbosityLevel) tlsType+      for_ maybeOutputFile $ \outputFile -> do+        let jsonSummary = encode results+        B.writeFile (outputFile) jsonSummary       if any isFailing results         then putStrLn (T.unpack $ makeRed "Some tests failed") >>              exitWith (ExitFailure 1)@@ -190,7 +207,15 @@ main = do   userArgs <- cmdArgs argParser   verbosityLevel <- getVerbosity-  let tlsCheckType = if skip_tls_check userArgs then SkipTLSCheck else DoTLSCheck+  let tlsCheckType =+        if skip_tls_check userArgs+          then SkipTLSCheck+          else DoTLSCheck   if upgrade userArgs     then upgradeCurlRunnings-    else runFile (file userArgs) verbosityLevel (grep userArgs) tlsCheckType+    else runFile+           (file userArgs)+           verbosityLevel+           (grep userArgs)+           tlsCheckType+           (json_output userArgs)

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 184f34d36c0d081262571516a7ddbef911407a4dc5c3c08f6b67982a7d30d485+-- hash: 106956606cfa1021bef8fdaaf6857a97c370bec27c29438f6216440f1309b480  name:           curl-runnings-version:        0.12.0+version:        0.14.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@@ -21,6 +21,7 @@ build-type:     Simple extra-source-files:     README.md+    examples/auth.yaml     examples/example-spec.json     examples/example-spec.yaml     examples/importable.yaml@@ -46,6 +47,7 @@   build-depends:       aeson >=1.2.4.0     , base >=4.0 && <5+    , base64-bytestring >=1.0.0.2     , bytestring >=0.10.8.2     , case-insensitive >=0.2.1     , clock >=0.7.2

@@ -0,0 +1,11 @@+cases:+  - name: Auth example+    url: http://your-endpoint.com/status+    requestMethod: GET+    expectStatus: 200+    # curl-runnings supports basic authentication at this time. if you need+    # another auth header types, feel free to open an issue!+    auth:+      basic:+        username: 'you'+        password: 'your password'

@@ -17,6 +17,7 @@ import           Control.Monad import           Data.Aeson import           Data.Aeson.Types+import qualified Data.ByteString.Base64               as B64 import qualified Data.ByteString.Char8                as B8S import qualified Data.ByteString.Lazy                 as B import qualified Data.CaseInsensitive                 as CI@@ -77,7 +78,12 @@   newQuery = NT.simpleQueryToQuery $ fmap (\(KeyValuePair k v) -> (T.encodeUtf8 k, T.encodeUtf8 v)) newParams  setPayload :: Maybe Payload -> Request -> Request-setPayload Nothing = id+-- TODO - for backwards compatability, empty requests will set an empty json+-- payload. Given that we support multiple content types, this funtionality+-- isn't exactly correct anymore. This behavior should be considered+-- deprecated and will be updated with the next major version release of+-- curl-runnings.+setPayload Nothing = setRequestBodyJSON emptyObject setPayload (Just (JSON v)) = setRequestBodyJSON v setPayload (Just (URLEncoded (KeyValuePairs xs))) = setRequestBodyURLEncoded $ kvpairs xs where   kvpairs = fmap (\(KeyValuePair k v) -> (T.encodeUtf8 k, T.encodeUtf8 v))@@ -88,7 +94,7 @@ runCase state@(CurlRunningsState _ _ _ tlsCheckType) curlCase = do   let eInterpolatedUrl = interpolateQueryString state $ url curlCase       eInterpolatedHeaders =-        interpolateHeaders state $ fromMaybe (HeaderSet []) (headers curlCase)+        interpolateHeaders state (auth curlCase) $ fromMaybe (HeaderSet []) (headers curlCase)       eInterpolatedQueryParams = interpolateViaJSON state $ fromMaybe (KeyValuePairs []) (queryParameters curlCase)   case (eInterpolatedUrl, eInterpolatedHeaders, eInterpolatedQueryParams) of     (Left err, _, _) ->@@ -198,16 +204,26 @@          unsafeLogger state ERROR "WARNING: empty header matcher found" . Right $          PartialHeaderMatcher Nothing Nothing -interpolateHeaders :: CurlRunningsState -> Headers -> Either QueryError Headers-interpolateHeaders state (HeaderSet headerList) =-  mapM-    (\(Header k v) ->-       case sequence-              [interpolateQueryString state k, interpolateQueryString state v] of-         Left err       -> Left err-         Right [k', v'] -> Right $ Header k' v')-    headerList >>=-  (Right . HeaderSet)+makeBasicAuthToken :: T.Text -> T.Text -> T.Text+makeBasicAuthToken u p = T.decodeUtf8 . B64.encode $ T.encodeUtf8 (u <> ":" <> p)++interpolateHeaders :: CurlRunningsState -> Maybe Authentication -> Headers -> Either QueryError Headers+interpolateHeaders state maybeAuth (HeaderSet headerList) = do+  authHeaders <- case maybeAuth of+        (Just (BasicAuthentication u p)) ->+          let interpolated = sequence [interpolateQueryString state u, interpolateQueryString state p] in+          case interpolated of+            Right [u, p] -> Right [Header "Authorization" ("Basic " <> (makeBasicAuthToken u p))]+            Left l -> Left l+        Nothing -> Right []+  mainHeaders <- (mapM+        (\(Header k v) ->+          case sequence+                  [interpolateQueryString state k, interpolateQueryString state v] of+            Left err       -> Left err+            Right [k', v'] -> Right $ Header k' v')+      headerList)+  Right . HeaderSet $ mainHeaders <> authHeaders  -- | Does this header contain our matcher? headerMatches :: PartialHeaderMatcher -> Header -> Bool

@@ -13,7 +13,7 @@   , makeUnsafeLogger   , pShow   , nowMillis-  , roundToStr+  , millisToS   , LogLevel(..)   , CurlRunningsLogger   , CurlRunningsUnsafeLogger@@ -86,3 +86,6 @@  roundToStr :: (PrintfArg a, Floating a) => a -> String roundToStr = printf "%0.2f"++millisToS :: Integer -> Double+millisToS t = (fromIntegral t :: Double) / 1000.0

@@ -7,27 +7,28 @@  module Testing.CurlRunnings.Types   ( AssertionFailure(..)+  , Authentication(..)   , CaseResult(..)-  , CurlSuite(..)   , CurlCase(..)+  , CurlRunningsState(..)+  , CurlSuite(..)+  , FullQueryText   , Header(..)   , HeaderMatcher(..)   , Headers(..)-  , KeyValuePair(..)-  , KeyValuePairs(..)-  , Payload(..)   , HttpMethod(..)+  , Index(..)+  , InterpolatedQuery(..)   , JsonMatcher(..)   , JsonSubExpr(..)+  , KeyValuePair(..)+  , KeyValuePairs(..)   , PartialHeaderMatcher(..)-  , StatusCodeMatcher(..)-  , QueryError(..)-  , Index(..)+  , Payload(..)   , Query(..)-  , InterpolatedQuery(..)-  , FullQueryText+  , QueryError(..)   , SingleQueryText-  , CurlRunningsState(..)+  , StatusCodeMatcher(..)   , TLSCheckType(..)    , isFailing@@ -129,6 +130,7 @@   -- | Tried to access a value in a null object.   | NullPointer T.Text -- full query                 T.Text -- message+                deriving (Generic)  instance Show QueryError where   show (QueryParseError t q) = printf "error parsing query %s: %s" q $ T.unpack t@@ -136,6 +138,8 @@   show (QueryTypeMismatch message val) = printf "type error: %s %s" message $ show val   show (QueryValidationError message) = printf "invalid query: %s" message +instance ToJSON QueryError+ instance FromJSON HeaderMatcher where   parseJSON o@(String v) =     either@@ -194,6 +198,15 @@   parseJSON obj@(Array _)  = AnyCodeIn <$> parseJSON obj   parseJSON invalid        = typeMismatch "StatusCodeMatcher" invalid +data Authentication =+  BasicAuthentication T.Text T.Text+  deriving (Show, Generic)++instance FromJSON Authentication where+  parseJSON (Object o) = BasicAuthentication <$> (o .: "basic" >>= (.: "username")) <*> (o .: "basic" >>= (.: "password"))+  parseJSON invalid    = typeMismatch "Authentication" invalid+instance ToJSON Authentication+ -- | A single curl test case, the basic foundation of a curl-runnings test. data CurlCase = CurlCase   { name            :: T.Text -- ^ The name of the test case@@ -202,6 +215,7 @@   , requestData     :: Maybe Payload -- ^ Payload to send with the request, if any   , queryParameters :: Maybe KeyValuePairs -- ^ Query parameters to set in the request, if any   , headers         :: Maybe Headers -- ^ Headers to send with the request, if any+  , auth            :: Maybe Authentication -- ^ Authentication to add to the request, if any   , expectData      :: Maybe JsonMatcher -- ^ The assertions to make on the response payload, if any   , expectStatus    :: StatusCodeMatcher -- ^ Assertion about the status code returned by the target   , expectHeaders   :: Maybe HeaderMatcher -- ^ Assertions to make about the response headers, if any@@ -232,8 +246,9 @@   | QueryFailure CurlCase                  QueryError   -- | Something else-  | UnexpectedFailure+  | UnexpectedFailure deriving (Generic) +instance ToJSON AssertionFailure  colorizeExpects :: String -> String colorizeExpects t =@@ -309,9 +324,6 @@     printf "JSON query error in spec %s: %s" (name curlCase) (show queryErr)   show UnexpectedFailure = "Unexpected Error D:" -formatSecToMS :: Integer -> String-formatSecToMS t = roundToStr ((fromIntegral t :: Double) / 1000.0)- -- | A type representing the result of a single curl, and all associated -- assertions data CaseResult@@ -327,15 +339,35 @@       , caseResponseValue   :: Maybe Value       , failures            :: [AssertionFailure]       , elapsedTime         :: Integer -- ^ Elapsed time-      }+      } deriving (Generic)+ instance Show CaseResult where-  show CasePass{curlCase, elapsedTime} = T.unpack . makeGreen $ "[PASS] " <> (T.pack $ printf "%s (%s seconds)" (name curlCase) (formatSecToMS elapsedTime))+  show CasePass{curlCase, elapsedTime} = T.unpack . makeGreen $ "[PASS] " <> (T.pack $ printf "%s (%0.2f seconds)" (name curlCase) (millisToS elapsedTime))   show CaseFail{curlCase, failures, elapsedTime} =     T.unpack $ makeRed "[FAIL] " <>     name curlCase <>-    (T.pack $ printf " (%s seconds) " (formatSecToMS elapsedTime)) <>+    (T.pack $ printf " (%0.2f seconds) " (millisToS elapsedTime)) <>     "\n" <>     mconcat (map ((\s -> "\nAssertion failed: " <> s) . (<> "\n") . (T.pack . show)) failures)++instance ToJSON CaseResult where+  toJSON CasePass {curlCase, caseResponseHeaders, caseResponseValue, elapsedTime} =+    object+      [ "testPassed" .= (Bool True)+      , "case" .= curlCase+      , "responseHeaders" .= caseResponseHeaders+      , "responseValue" .= caseResponseValue+      , "elapsedTimeSeconds" .= millisToS elapsedTime+      ]+  toJSON CaseFail {curlCase, caseResponseHeaders, caseResponseValue, elapsedTime, failures} =+    object+      [ "testPassed" .= (Bool False)+      , "case" .= curlCase+      , "responseHeaders" .= caseResponseHeaders+      , "responseValue" .= caseResponseValue+      , "elapsedTimeSeconds" .= millisToS elapsedTime+      , "failures" .= failures+      ]  -- | A wrapper type around a set of test cases. This is the top level spec type -- that we parse a test spec file into

@@ -129,7 +129,6 @@     decodePayload [r|{"other": ["key1", "value1"]}|] `shouldSatisfy` isJSON     -- "other" is ignored     decodePayload [r|{"bodyType": "json", "content": {"a": "b"}, "other": 1}|] `shouldSatisfy` isJSON-    decodePayload [r|{"bodytype": "urlencoded", "content": ["key1", "value1"]}|] `shouldSatisfy` isJSON    it "should not decode invalid request body" $ do     decodePayload [r|{"bodyType": "plain", "content": {"key1": "value1"}}|] `shouldSatisfy` isLeft