| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Testing.CurlRunnings.Types
Description
Data types for curl-runnings tests
Synopsis
- data AssertionFailure
- data Authentication = BasicAuthentication Text Text
- data CaseResult
- data CurlCase = CurlCase {}
- data CurlRunningsState = CurlRunningsState Environment [CaseResult] LogLevel TLSCheckType
- data CurlSuite = CurlSuite {
- suiteCases :: [CurlCase]
- suiteCaseFilter :: Maybe Text
- type FullQueryText = Text
- data Header = Header Text Text
- data HeaderMatcher = HeaderMatcher [PartialHeaderMatcher]
- newtype Headers = HeaderSet [Header]
- data HttpMethod
- data Index
- data InterpolatedQuery
- data JsonMatcher
- data JsonSubExpr
- = ValueMatch Value
- | KeyMatch Text
- | KeyValueMatch {
- matchKey :: Text
- matchValue :: Value
- data KeyValuePair = KeyValuePair KeyType Text
- newtype KeyValuePairs = KeyValuePairs [KeyValuePair]
- data PartialHeaderMatcher = PartialHeaderMatcher (Maybe Text) (Maybe Text)
- data Payload
- data Query
- data QueryError
- type SingleQueryText = Text
- data StatusCodeMatcher
- data TLSCheckType
- isFailing :: CaseResult -> Bool
- isPassing :: CaseResult -> Bool
- logger :: CurlRunningsState -> CurlRunningsLogger
- unsafeLogger :: Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a
Documentation
data AssertionFailure Source #
Represents the different type of test failures we can have. A single test case | might return many assertion failures.
Constructors
| DataFailure CurlCase JsonMatcher (Maybe Value) | The json we got back was wrong. We include this redundant field (it's included in the CurlCase field above) in order to enforce at the type level that we have to be expecting some data in order to have this type of failure. |
| StatusFailure CurlCase Int | The status code we got back was wrong |
| HeaderFailure CurlCase HeaderMatcher Headers | The headers we got back were wrong |
| QueryFailure CurlCase QueryError | Something went wrong with a test case json query |
| UnexpectedFailure | Something else |
Instances
data Authentication Source #
Constructors
| BasicAuthentication Text Text |
Instances
data CaseResult Source #
A type representing the result of a single curl, and all associated assertions
Constructors
| CasePass | |
Fields
| |
| CaseFail | |
Fields
| |
Instances
A single curl test case, the basic foundation of a curl-runnings test.
Constructors
| CurlCase | |
Fields
| |
Instances
data CurlRunningsState Source #
The state of a suite. Tracks environment variables, and all the test results so far
Constructors
| CurlRunningsState Environment [CaseResult] LogLevel TLSCheckType |
A wrapper type around a set of test cases. This is the top level spec type that we parse a test spec file into
Constructors
| CurlSuite | |
Fields
| |
Instances
| Show CurlSuite Source # | |
| Generic CurlSuite Source # | |
| ToJSON CurlSuite Source # | |
Defined in Testing.CurlRunnings.Types | |
| FromJSON CurlSuite Source # | |
| type Rep CurlSuite Source # | |
Defined in Testing.CurlRunnings.Types type Rep CurlSuite = D1 ('MetaData "CurlSuite" "Testing.CurlRunnings.Types" "curl-runnings-0.17.0-NVJ97QtMCJHtl9XbYoan8" 'False) (C1 ('MetaCons "CurlSuite" 'PrefixI 'True) (S1 ('MetaSel ('Just "suiteCases") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 [CurlCase]) :*: S1 ('MetaSel ('Just "suiteCaseFilter") 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 (Maybe Text)))) | |
type FullQueryText = Text Source #
The full string in which a query appears, eg "prefix-${{RESPONSES[0].key.another_key[0].last_key}}"
A representation of a single header
Instances
| Eq Header Source # | |
| Show Header Source # | |
| Generic Header Source # | |
| ToJSON Header Source # | |
Defined in Testing.CurlRunnings.Internal.Headers | |
| type Rep Header Source # | |
Defined in Testing.CurlRunnings.Internal.Headers type Rep Header = D1 ('MetaData "Header" "Testing.CurlRunnings.Internal.Headers" "curl-runnings-0.17.0-NVJ97QtMCJHtl9XbYoan8" 'False) (C1 ('MetaCons "Header" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Text))) | |
data HeaderMatcher Source #
Collection of matchers to run against a single curl response
Constructors
| HeaderMatcher [PartialHeaderMatcher] |
Instances
Simple container for a list of headers, useful for a vehicle for defining a fromJSON
data HttpMethod Source #
A basic enum for supported HTTP verbs
Instances
A single lookup operation in a json query
Constructors
| CaseResultIndex Integer | Drill into the json of a specific test case. The RESPONSES object is accessible as an array of values that have come back from previous test cases |
| KeyIndex Text | A standard json key lookup. |
| ArrayIndex Integer | A standard json array index lookup. |
data InterpolatedQuery Source #
A distinct parsed unit in a query
Constructors
| LiteralText Text | Regular text, no query |
| InterpolatedQuery Text Query | Some leading text, then a query |
| NonInterpolatedQuery Query | Just a query, no leading text |
Instances
| Show InterpolatedQuery Source # | |
Defined in Testing.CurlRunnings.Types Methods showsPrec :: Int -> InterpolatedQuery -> ShowS # show :: InterpolatedQuery -> String # showList :: [InterpolatedQuery] -> ShowS # | |
data JsonMatcher Source #
A predicate to apply to the json body from the response
Constructors
| Exactly Value | Performs |
| Contains [JsonSubExpr] | A list of matchers to make assertions that contains values exist in the response |
| NotContains [JsonSubExpr] | A list of matchers to make assertions that contains values do not exist in the response |
| MixedContains [JsonMatcher] | We're specifiying both Contains and NotContains matchers |
Instances
data JsonSubExpr Source #
A matcher for a subvalue of a json payload
Constructors
| ValueMatch Value | Assert some value anywhere in the json has a value equal to a given value. The motivation for this field is largely for checking contents of a top level array. It's also useful if you don't know the key ahead of time. |
| KeyMatch Text | Assert a key exists anywhere in the json |
| KeyValueMatch | Assert the key value pair can be found somewhere the json. |
Fields
| |
Instances
data KeyValuePair Source #
A representation of a single key-value pair
Constructors
| KeyValuePair KeyType Text |
Instances
| Eq KeyValuePair Source # | |
Defined in Testing.CurlRunnings.Internal.KeyValuePairs | |
| Show KeyValuePair Source # | |
Defined in Testing.CurlRunnings.Internal.KeyValuePairs Methods showsPrec :: Int -> KeyValuePair -> ShowS # show :: KeyValuePair -> String # showList :: [KeyValuePair] -> ShowS # | |
newtype KeyValuePairs Source #
A container for a list of key-value pairs
Constructors
| KeyValuePairs [KeyValuePair] |
Instances
| Eq KeyValuePairs Source # | |
Defined in Testing.CurlRunnings.Internal.KeyValuePairs Methods (==) :: KeyValuePairs -> KeyValuePairs -> Bool # (/=) :: KeyValuePairs -> KeyValuePairs -> Bool # | |
| Show KeyValuePairs Source # | |
Defined in Testing.CurlRunnings.Internal.KeyValuePairs Methods showsPrec :: Int -> KeyValuePairs -> ShowS # show :: KeyValuePairs -> String # showList :: [KeyValuePairs] -> ShowS # | |
| ToJSON KeyValuePairs Source # | |
Defined in Testing.CurlRunnings.Internal.KeyValuePairs Methods toJSON :: KeyValuePairs -> Value # toEncoding :: KeyValuePairs -> Encoding # toJSONList :: [KeyValuePairs] -> Value # toEncodingList :: [KeyValuePairs] -> Encoding # | |
| FromJSON KeyValuePairs Source # | |
Defined in Testing.CurlRunnings.Internal.KeyValuePairs Methods parseJSON :: Value -> Parser KeyValuePairs # parseJSONList :: Value -> Parser [KeyValuePairs] # | |
data PartialHeaderMatcher Source #
Specify a key, value, or both to match against in the returned headers of a response.
Constructors
| PartialHeaderMatcher (Maybe Text) (Maybe Text) |
Instances
Constructors
| JSON Value | |
| URLEncoded KeyValuePairs |
Instances
| Show Payload Source # | |
| Generic Payload Source # | |
| ToJSON Payload Source # | |
Defined in Testing.CurlRunnings.Internal.Payload | |
| FromJSON Payload Source # | |
| type Rep Payload Source # | |
Defined in Testing.CurlRunnings.Internal.Payload type Rep Payload = D1 ('MetaData "Payload" "Testing.CurlRunnings.Internal.Payload" "curl-runnings-0.17.0-NVJ97QtMCJHtl9XbYoan8" 'False) (C1 ('MetaCons "JSON" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 Value)) :+: C1 ('MetaCons "URLEncoded" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 KeyValuePairs))) | |
A single entity to be queries from a json value
Constructors
| Query [Index] | A single query contains a list of discrete index operations |
| EnvironmentVariable Text | Lookup a string in the environment |
data QueryError Source #
Different errors relating to querying json from previous test cases
Constructors
| QueryParseError Text Text | The query was malformed and couldn't be parsed |
| QueryTypeMismatch Text Value | The retrieved a value of the wrong type or was otherwise operating on the wrong type of thing |
| QueryValidationError Text | The query was parse-able |
| NullPointer Text Text | Tried to access a value in a null object. |
Instances
type SingleQueryText = Text Source #
The string for one query given the FullQueryText above, the single query text would be RESPONSES[0].key.another_key[0].last_key
data StatusCodeMatcher Source #
Check the status code of a response. You can specify one or many valid codes.
Instances
data TLSCheckType Source #
Constructors
| SkipTLSCheck | |
| DoTLSCheck |
Instances
| Eq TLSCheckType Source # | |
Defined in Testing.CurlRunnings.Types | |
| Show TLSCheckType Source # | |
Defined in Testing.CurlRunnings.Types Methods showsPrec :: Int -> TLSCheckType -> ShowS # show :: TLSCheckType -> String # showList :: [TLSCheckType] -> ShowS # | |
isFailing :: CaseResult -> Bool Source #
Simple predicate that checks if the result is failing
isPassing :: CaseResult -> Bool Source #
Simple predicate that checks if the result is passing
unsafeLogger :: Show a => CurlRunningsState -> CurlRunningsUnsafeLogger a Source #