-
Notifications
You must be signed in to change notification settings - Fork 2.8k
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
PR-URL: hasura/graphql-engine-mono#4175 GitOrigin-RevId: d37d7d131597af6b9cca6bd773c8dbbce8719ca5
- Loading branch information
1 parent
e9436c5
commit 38c41b2
Showing
18 changed files
with
3,641 additions
and
8 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,197 @@ | ||
| {-# LANGUAGE TemplateHaskell #-} | ||
|
|
||
| module Command | ||
| ( Command (..), | ||
| TestOptions (..), | ||
| AgentCapabilities (..), | ||
| parseCommandLine, | ||
| ) | ||
| where | ||
|
|
||
| import Control.Arrow (left) | ||
| import Control.Lens (contains, modifying, use, (^.), _2) | ||
| import Control.Lens.TH (makeLenses) | ||
| import Control.Monad (when) | ||
| import Control.Monad.State (State, runState) | ||
| import Data.HashSet (HashSet) | ||
| import Data.HashSet qualified as HashSet | ||
| import Data.Text (Text) | ||
| import Data.Text qualified as Text | ||
| import Data.Version (showVersion) | ||
| import Hasura.Backends.DataWrapper.API qualified as API | ||
| import Options.Applicative | ||
| import Paths_graphql_engine qualified as PackageInfo | ||
| import Servant.Client (BaseUrl, parseBaseUrl) | ||
| import Prelude | ||
|
|
||
| data Command | ||
| = Test TestOptions | ||
| | ExportOpenAPISpec | ||
|
|
||
| data TestOptions = TestOptions | ||
| { _toAgentBaseUrl :: BaseUrl, | ||
| _toAgentCapabilities :: AgentCapabilities, | ||
| _toParallelDegree :: Maybe Int, | ||
| _toMatch :: Maybe String, | ||
| _toSkip :: Maybe String | ||
| } | ||
|
|
||
| data AgentCapabilities | ||
| = AutoDetect | ||
| | Explicit API.Capabilities | ||
|
|
||
| data CapabilitiesState = CapabilitiesState | ||
| { _csRemainingCapabilities :: HashSet Text, | ||
| _csCapabilitiesEnquired :: HashSet Text | ||
| } | ||
|
|
||
| $(makeLenses ''CapabilitiesState) | ||
|
|
||
| parseCommandLine :: IO Command | ||
| parseCommandLine = | ||
| execParser $ | ||
| info | ||
| (helper <*> version <*> commandParser) | ||
| ( fullDesc | ||
| <> header "Hasura GraphQL Data Wrapper Agent Test Utility" | ||
| ) | ||
|
|
||
| version :: Parser (a -> a) | ||
| version = | ||
| infoOption | ||
| displayText | ||
| ( long "version" | ||
| <> short 'v' | ||
| <> help "Prints the version of the application and quits" | ||
| <> hidden | ||
| ) | ||
| where | ||
| displayText = "Version " <> showVersion PackageInfo.version | ||
|
|
||
| commandParser :: Parser Command | ||
| commandParser = | ||
| subparser | ||
| (testCommand <> exportOpenApiSpecCommand) | ||
| where | ||
| testCommand = | ||
| command | ||
| "test" | ||
| ( info | ||
| (helper <*> testCommandParser) | ||
| (progDesc "Executes a suite of tests against an agent to ensure its correct function") | ||
| ) | ||
| exportOpenApiSpecCommand = | ||
| command | ||
| "export-openapi-spec" | ||
| ( info | ||
| (helper <*> pure ExportOpenAPISpec) | ||
| (progDesc "Exports the OpenAPI specification of the GDW API agents must implement") | ||
| ) | ||
|
|
||
| testOptionsParser :: Parser TestOptions | ||
| testOptionsParser = | ||
| TestOptions | ||
| <$> option | ||
| baseUrl | ||
| ( long "agent-base-url" | ||
| <> short 'u' | ||
| <> metavar "URL" | ||
| <> help "The base URL of the GDW agent to be tested" | ||
| ) | ||
| <*> agentCapabilitiesParser | ||
| <*> optional | ||
| ( option | ||
| positiveNonZeroInt | ||
| ( long "jobs" | ||
| <> short 'j' | ||
| <> metavar "INT" | ||
| <> help "Run at most N parallelizable tests simultaneously (default: number of available processors)" | ||
| ) | ||
| ) | ||
| <*> optional | ||
| ( option | ||
| auto | ||
| ( long "match" | ||
| <> short 'm' | ||
| <> metavar "PATTERN" | ||
| <> help "Only run tests that match given PATTERN" | ||
| ) | ||
| ) | ||
| <*> optional | ||
| ( option | ||
| auto | ||
| ( long "skip" | ||
| <> short 's' | ||
| <> metavar "PATTERN" | ||
| <> help "Skip tests that match given PATTERN" | ||
| ) | ||
| ) | ||
|
|
||
| testCommandParser :: Parser Command | ||
| testCommandParser = Test <$> testOptionsParser | ||
|
|
||
| baseUrl :: ReadM BaseUrl | ||
| baseUrl = eitherReader $ left show . parseBaseUrl | ||
|
|
||
| positiveNonZeroInt :: ReadM Int | ||
| positiveNonZeroInt = | ||
| auto >>= \int -> | ||
| if int <= 0 then readerError "Must be a positive, non-zero integer" else pure int | ||
|
|
||
| agentCapabilitiesParser :: Parser AgentCapabilities | ||
| agentCapabilitiesParser = | ||
| option | ||
| agentCapabilities | ||
| ( long "capabilities" | ||
| <> short 'c' | ||
| <> metavar "CAPABILITIES" | ||
| <> value AutoDetect | ||
| <> help (Text.unpack helpText) | ||
| ) | ||
| where | ||
| helpText = | ||
| "The capabilities that the agent has, to determine what tests to run. By default, they will be autodetected. The valid capabilities are: " <> allCapabilitiesText | ||
| allCapabilitiesText = | ||
| "[autodetect | none | " <> Text.intercalate "," (HashSet.toList allPossibleCapabilities) <> "]" | ||
|
|
||
| agentCapabilities :: ReadM AgentCapabilities | ||
| agentCapabilities = | ||
| str >>= \text -> do | ||
| let capabilities = HashSet.fromList $ Text.strip <$> Text.split (== ',') text | ||
| if HashSet.member "autodetect" capabilities | ||
| then | ||
| if HashSet.size capabilities == 1 | ||
| then pure AutoDetect | ||
| else readerError "You can either autodetect capabilities or specify them manually, not both" | ||
| else | ||
| if HashSet.member "none" capabilities | ||
| then | ||
| if HashSet.size capabilities == 1 | ||
| then pure . Explicit . fst $ readCapabilities mempty | ||
| else readerError "You cannot specify other capabilities when specifying none" | ||
| else Explicit <$> readExplicitCapabilities capabilities | ||
| where | ||
| readExplicitCapabilities :: HashSet Text -> ReadM API.Capabilities | ||
| readExplicitCapabilities providedCapabilities = | ||
| let (capabilities, CapabilitiesState {..}) = readCapabilities providedCapabilities | ||
| in if _csRemainingCapabilities /= mempty | ||
| then readerError . Text.unpack $ "Unknown capabilities: " <> Text.intercalate "," (HashSet.toList _csRemainingCapabilities) | ||
| else pure capabilities | ||
|
|
||
| readCapabilities :: HashSet Text -> (API.Capabilities, CapabilitiesState) | ||
| readCapabilities providedCapabilities = | ||
| flip runState (CapabilitiesState providedCapabilities mempty) $ | ||
| API.Capabilities | ||
| <$> readCapability "relationships" | ||
|
|
||
| readCapability :: Text -> State CapabilitiesState Bool | ||
| readCapability capability = do | ||
| modifying csCapabilitiesEnquired $ HashSet.insert capability | ||
| hasCapability <- use $ csRemainingCapabilities . contains capability | ||
| when hasCapability $ | ||
| modifying csRemainingCapabilities $ HashSet.delete capability | ||
| pure hasCapability | ||
|
|
||
| allPossibleCapabilities :: HashSet Text | ||
| allPossibleCapabilities = | ||
| readCapabilities mempty ^. _2 . csCapabilitiesEnquired |
Oops, something went wrong.