From b802d677b40429ac3d1906d5376b2a40a07b1adb Mon Sep 17 00:00:00 2001 From: aviaviavi Date: Wed, 27 Feb 2019 18:09:17 -0700 Subject: [PATCH] skip-tls-check option --- app/Main.hs | 19 ++++++++++------- curl-runnings.cabal | 15 +++++++------ package.yaml | 11 +++------- src/Testing/CurlRunnings.hs | 35 +++++++++++++++++++++++-------- src/Testing/CurlRunnings/Types.hs | 9 +++++--- stack.yaml | 2 +- 6 files changed, 56 insertions(+), 35 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 1da6c9c..2666170 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -30,9 +30,10 @@ import Testing.CurlRunnings.Types -- | Command line flags data CurlRunnings = CurlRunnings - { file :: FilePath - , grep :: Maybe T.Text - , upgrade :: Bool + { file :: FilePath + , grep :: Maybe T.Text + , upgrade :: Bool + , skip_tls_check :: Bool } deriving (Show, Data, Typeable, Eq) -- | cmdargs object @@ -42,6 +43,7 @@ argParser = { 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)" } &= summary ("curl-runnings " ++ showVersion version) &= program "curl-runnings" &= @@ -72,17 +74,17 @@ instance FromJSON GithubReleasesResponse setGithubReqHeaders :: Request -> Request setGithubReqHeaders = setRequestHeaders [("User-Agent", "aviaviavi")] -runFile :: FilePath -> Verbosity -> Maybe T.Text -> IO () -runFile "" _ _ = +runFile :: FilePath -> Verbosity -> Maybe T.Text -> TLSCheckType -> IO () +runFile "" _ _ _ = putStrLn "Please specify an input file with the --file (-f) flag or use --help for more information" -runFile path verbosityLevel regexp = do +runFile path verbosityLevel regexp tlsType = 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 + runSuite (s {suiteCaseFilter = regexp}) (toLogLevel verbosityLevel) $ tlsType if any isFailing results then putStrLn (T.unpack $ makeRed "Some tests failed") >> exitWith (ExitFailure 1) @@ -188,6 +190,7 @@ main :: IO () main = do userArgs <- cmdArgs argParser verbosityLevel <- getVerbosity + let tlsCheckType = if skip_tls_check userArgs then SkipTLSCheck else DoTLSCheck if upgrade userArgs then upgradeCurlRunnings - else runFile (file userArgs) verbosityLevel (grep userArgs) + else runFile (file userArgs) verbosityLevel (grep userArgs) tlsCheckType diff --git a/curl-runnings.cabal b/curl-runnings.cabal index bd728ee..1d7068b 100644 --- a/curl-runnings.cabal +++ b/curl-runnings.cabal @@ -1,8 +1,10 @@ --- This file has been generated from package.yaml by hpack version 0.28.2. +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.31.0. -- -- see: https://github.com/sol/hpack -- --- hash: 0e66b58842dd3cfc4bba11992201740113a8539e45270702205df083d4feb579 +-- hash: 189771adeec42ac2e6e8c4262b0b81286359f74f9b96f05112a73a634b960615 name: curl-runnings version: 0.9.2 @@ -17,13 +19,12 @@ copyright: 2018 Avi Press license: MIT license-file: LICENSE build-type: Simple -cabal-version: >= 1.10 extra-source-files: + README.md examples/example-spec.json examples/example-spec.yaml examples/importable.yaml examples/interpolation-spec.yaml - README.md source-repository head type: git @@ -34,12 +35,14 @@ library src build-depends: aeson >=1.2.4.0 - , base >=4.7 && <5 + , base >=4.0 && <5 , bytestring >=0.10.8.2 , case-insensitive >=0.2.1 + , connection >=0.2.8 , directory >=1.3.0.2 , hspec >=2.4.4 , hspec-expectations >=0.8.2 + , http-client-tls >=0.3.5.3 , http-conduit >=2.2.4 , http-types >=0.9.1 , megaparsec >=6.3.0 @@ -85,7 +88,7 @@ test-suite curl-runnings-test test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: - base >=4.7 && <5 + base >=4.0 && <5 , curl-runnings , directory >=1.3.0.2 , hspec >=2.4.4 diff --git a/package.yaml b/package.yaml index 0eae550..e4c7f2c 100644 --- a/package.yaml +++ b/package.yaml @@ -12,17 +12,10 @@ extra-source-files: - README.md - examples/* -# Metadata used when publishing your package -# synopsis: Short description of your package -# category: Web - -# To avoid duplicated efforts in documentation and dealing with the -# complications of embedding Haddock markup inside cabal files, it is -# common to point users to the README.md file. description: Please see the README on Github at dependencies: -- base >= 4.7 && < 5 +- base >= 4.0 && < 5 library: source-dirs: src @@ -41,6 +34,8 @@ library: - http-conduit >=2.2.4 - http-types >=0.9.1 - megaparsec >=6.3.0 + - connection >=0.2.8 + - http-client-tls >=0.3.5.3 - pretty-simple >=2.0.2.1 - regex-posix >=0.95.2 - text >=1.2.2.2 diff --git a/src/Testing/CurlRunnings.hs b/src/Testing/CurlRunnings.hs index 957c0bd..d24ca56 100644 --- a/src/Testing/CurlRunnings.hs +++ b/src/Testing/CurlRunnings.hs @@ -24,6 +24,8 @@ import Data.Monoid import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.Yaml.Include as YI +import Network.Connection (TLSSettings (..)) +import Network.HTTP.Client.TLS (mkManagerSettings) import Network.HTTP.Conduit import Network.HTTP.Simple import qualified Network.HTTP.Types.Header as HTTP @@ -35,6 +37,7 @@ import Testing.CurlRunnings.Types import Text.Printf import Text.Regex.Posix + -- | decode a json or yaml file into a suite object decodeFile :: FilePath -> IO (Either String CurlSuite) decodeFile specPath = @@ -48,10 +51,22 @@ decodeFile specPath = _ -> return . Left $ printf "Invalid spec path %s" specPath else return . Left $ printf "%s not found" specPath + +noVerifyTlsManagerSettings :: ManagerSettings +noVerifyTlsManagerSettings = mkManagerSettings noVerifyTlsSettings Nothing + +noVerifyTlsSettings :: TLSSettings +noVerifyTlsSettings = + TLSSettingsSimple + { settingDisableCertificateValidation = True + , settingDisableSession = True + , settingUseServerName = False + } + -- | Run a single test case, and returns the result. IO is needed here since this method is responsible -- for actually curling the test case endpoint and parsing the result. runCase :: CurlRunningsState -> CurlCase -> IO CaseResult -runCase state curlCase = do +runCase state@(CurlRunningsState _ _ _ tlsCheckType) curlCase = do let eInterpolatedUrl = interpolateQueryString state $ url curlCase eInterpolatedHeaders = interpolateHeaders state $ fromMaybe (HeaderSet []) (headers curlCase) @@ -66,9 +81,11 @@ runCase state curlCase = do return $ CaseFail curlCase Nothing Nothing [QueryFailure curlCase l] Right replacedJSON -> do initReq <- parseRequest $ T.unpack interpolatedUrl + manager <- newManager noVerifyTlsManagerSettings let request = setRequestBodyJSON (fromMaybe emptyObject replacedJSON) . - setRequestHeaders (toHTTPHeaders interpolatedHeaders) $ + setRequestHeaders (toHTTPHeaders interpolatedHeaders) . + (if tlsCheckType == DoTLSCheck then id else (setRequestManager manager)) $ initReq {method = B8S.pack . show $ requestMethod curlCase} logger state DEBUG (pShow request) logger @@ -183,8 +200,8 @@ 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 -> LogLevel -> IO [CaseResult] -runSuite (CurlSuite cases filterRegex) logLevel = do +runSuite :: CurlSuite -> LogLevel -> TLSCheckType -> IO [CaseResult] +runSuite (CurlSuite cases filterRegex) logLevel tlsType = do fullEnv <- getEnvironment let envMap = H.fromList $ map (\(x, y) -> (T.pack x, T.pack y)) fullEnv filterNameByRegexp curlCase = @@ -198,12 +215,12 @@ runSuite (CurlSuite cases filterRegex) logLevel = do Just CaseFail {} -> return prevResults Just CasePass {} -> do result <- - runCase (CurlRunningsState envMap prevResults logLevel) curlCase >>= + runCase (CurlRunningsState envMap prevResults logLevel tlsType) curlCase >>= printR return $ prevResults ++ [result] Nothing -> do result <- - runCase (CurlRunningsState envMap [] logLevel) curlCase >>= printR + runCase (CurlRunningsState envMap [] logLevel tlsType) curlCase >>= printR return [result]) [] (filter filterNameByRegexp cases) @@ -367,14 +384,14 @@ 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 maybeCase = arrayGet previousResults $ fromInteger i @@ -417,7 +434,7 @@ getValueForQuery (CurlRunningsState _ previousResults _) full@(NonInterpolatedQu T.pack $ "'$< ... >' queries must start with a RESPONSES[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 diff --git a/src/Testing/CurlRunnings/Types.hs b/src/Testing/CurlRunnings/Types.hs index 83799e4..c399849 100644 --- a/src/Testing/CurlRunnings/Types.hs +++ b/src/Testing/CurlRunnings/Types.hs @@ -23,6 +23,7 @@ module Testing.CurlRunnings.Types , FullQueryText , SingleQueryText , CurlRunningsState(..) + , TLSCheckType(..) , isFailing , isPassing @@ -391,14 +392,16 @@ isFailing = not . isPassing -- | A map of the system environment type Environment = H.HashMap T.Text T.Text +data TLSCheckType = SkipTLSCheck | DoTLSCheck deriving (Show, Eq) + -- | The state of a suite. Tracks environment variables, and all the test results so far -data CurlRunningsState = CurlRunningsState Environment [CaseResult] LogLevel +data CurlRunningsState = CurlRunningsState Environment [CaseResult] LogLevel TLSCheckType logger :: CurlRunningsState -> CurlRunningsLogger -logger (CurlRunningsState _ _ l) = makeLogger l +logger (CurlRunningsState _ _ l _) = makeLogger l unsafeLogger :: Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a -unsafeLogger (CurlRunningsState _ _ l) = makeUnsafeLogger l +unsafeLogger (CurlRunningsState _ _ l _) = makeUnsafeLogger l -- | A single lookup operation in a json query data Index diff --git a/stack.yaml b/stack.yaml index 2c1ed0d..75a0965 100644 --- a/stack.yaml +++ b/stack.yaml @@ -15,7 +15,7 @@ # resolver: # name: custom-snapshot # location: "./custom-snapshot.yaml" -resolver: lts-10.8 +resolver: lts-12.14 # User packages to be built. # Various formats can be used as shown in the example below.