diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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) diff --git a/curl-runnings.cabal b/curl-runnings.cabal --- a/curl-runnings.cabal +++ b/curl-runnings.cabal @@ -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 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 diff --git a/examples/auth.yaml b/examples/auth.yaml new file mode 100644 --- /dev/null +++ b/examples/auth.yaml @@ -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' diff --git a/src/Testing/CurlRunnings.hs b/src/Testing/CurlRunnings.hs --- a/src/Testing/CurlRunnings.hs +++ b/src/Testing/CurlRunnings.hs @@ -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 diff --git a/src/Testing/CurlRunnings/Internal.hs b/src/Testing/CurlRunnings/Internal.hs --- a/src/Testing/CurlRunnings/Internal.hs +++ b/src/Testing/CurlRunnings/Internal.hs @@ -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 diff --git a/src/Testing/CurlRunnings/Types.hs b/src/Testing/CurlRunnings/Types.hs --- a/src/Testing/CurlRunnings/Types.hs +++ b/src/Testing/CurlRunnings/Types.hs @@ -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 diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -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