-- Copyright (C) 2017 Red Hat, Inc. -- -- This file is part of bdcs-api. -- -- bdcs-api is free software: you can redistribute it and/or modify -- it under the terms of the GNU General Public License as published by -- the Free Software Foundation, either version 3 of the License, or -- (at your option) any later version. -- -- bdcs-api is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with bdcs-api. If not, see . {-# LANGUAGE DataKinds #-} module ServerSpec where import BDCS.API.Customization(RecipeCustomization(..), RecipeSshKey(..), emptyCustomization) import BDCS.API.Error(APIResponse(..)) import BDCS.API.Recipe(Recipe(..), RecipeModule(..)) import BDCS.API.Recipes(CommitDetails(..), RecipeDiffType(..), RecipeDiffEntry(..)) import BDCS.API.Server import BDCS.API.V0 import BDCS.DB(Projects(..), schemaVersion) import Control.Conditional(whenM) import Control.Exception(throwIO) import Control.Monad.Loops(allM) import qualified Data.ByteString.Lazy as LBS import Data.List(isSuffixOf) import qualified Data.Text as T import Data.Time.Clock(UTCTime) import Network.HTTP.Client (Manager, newManager, defaultManagerSettings) import Network.Wai (Application) import Network.Wai.Handler.Warp import Servant import Servant.Client import System.Directory(copyFileWithMetadata, createDirectoryIfMissing, doesPathExist, listDirectory, removeDirectoryRecursive) import System.FilePath.Posix(()) import Text.Printf(printf) import Test.Hspec {-# ANN module ("HLint: ignore Reduce duplication" :: String) #-} {-# ANN module ("HLint: ignore Use null" :: String) #-} {-# ANN module ("HLint: ignore Use head" :: String) #-} -- Client API getStatus :: ClientM ServerStatus getProjectsList :: Maybe Int -> Maybe Int -> ClientM ProjectsListResponse getProjectsInfo :: String -> ClientM ProjectsInfoResponse getProjectsDepsolve :: String -> ClientM ProjectsDepsolveResponse getRecipes :: Maybe Int -> Maybe Int -> Maybe String -> ClientM RecipesListResponse getRecipesInfo :: String -> Maybe String -> ClientM RecipesInfoResponse getRecipesChanges :: String -> Maybe Int -> Maybe Int -> Maybe String -> ClientM RecipesChangesResponse postRecipesNew :: Recipe -> Maybe String -> ClientM APIResponse deleteRecipes :: String -> Maybe String -> ClientM APIResponse postRecipesUndo :: String -> String -> Maybe String -> ClientM APIResponse postRecipesWorkspace :: Recipe -> Maybe String -> ClientM APIResponse deleteRecipesWorkspace :: String -> Maybe String -> ClientM APIResponse postRecipesTag :: String -> Maybe String -> ClientM APIResponse getRecipesDiff :: String -> String -> String -> Maybe String -> ClientM RecipesDiffResponse getRecipesDepsolve :: String -> Maybe String -> ClientM RecipesDepsolveResponse getRecipesFreeze :: String -> Maybe String -> ClientM RecipesFreezeResponse getModulesList :: Maybe Int -> Maybe Int -> ClientM ModulesListResponse getModulesList' :: String -> Maybe Int -> Maybe Int -> ClientM ModulesListResponse getModulesInfo :: String -> ClientM ModulesInfoResponse getCompose :: ComposeBody -> Maybe Int -> ClientM ComposeResponse getComposeTypes :: ClientM ComposeTypesResponse getComposeQueue :: ClientM ComposeQueueResponse getComposeQueueFinished :: ClientM ComposeFinishedResponse getComposeQueueFailed :: ClientM ComposeFailedResponse getComposeStatus :: String -> ClientM ComposeStatusResponse getComposeInfo :: String -> ClientM ComposeInfoResponse getComposeCancel :: String -> ClientM APIResponse getComposeDelete :: String -> ClientM ComposeDeleteResponse getComposeLogs :: String -> ClientM (Headers '[Header "Content-Disposition" String] LBS.ByteString) getComposeImage :: String -> ClientM (Headers '[Header "Content-Disposition" String] LBS.ByteString) getComposeMetadata :: String -> ClientM (Headers '[Header "Content-Disposition" String] LBS.ByteString) getComposeResults :: String -> ClientM (Headers '[Header "Content-Disposition" String] LBS.ByteString) getStatus :<|> getProjectsList :<|> getProjectsInfo :<|> getProjectsDepsolve :<|> getRecipes :<|> getRecipesInfo :<|> getRecipesChanges :<|> postRecipesNew :<|> deleteRecipes :<|> postRecipesUndo :<|> postRecipesWorkspace :<|> deleteRecipesWorkspace :<|> postRecipesTag :<|> getRecipesDiff :<|> getRecipesDepsolve :<|> getRecipesFreeze :<|> getModulesList :<|> getModulesList' :<|> getModulesInfo :<|> getCompose :<|> getComposeTypes :<|> getComposeQueue :<|> getComposeQueueFinished :<|> getComposeQueueFailed :<|> getComposeStatus :<|> getComposeInfo :<|> getComposeCancel :<|> getComposeDelete :<|> getComposeLogs :<|> getComposeImage :<|> getComposeMetadata :<|> getComposeResults = client proxyAPI -- Test results, depends on the contents of the ./tests/recipes files. recipesListResponse1 :: RecipesListResponse recipesListResponse1 = RecipesListResponse ["glusterfs", "http-server", "kubernetes", "test-fake"] 0 20 4 recipesListResponse2 :: RecipesListResponse recipesListResponse2 = RecipesListResponse ["http-server"] 1 1 4 missingRecipeResponse :: RecipesInfoResponse missingRecipeResponse = RecipesInfoResponse [] [] ["missing-recipe: missing-recipe.toml is not present on branch master"] httpserverRecipeResponse :: RecipesInfoResponse httpserverRecipeResponse = RecipesInfoResponse [WorkspaceChanges "http-server" False] [Recipe "http-server" (Just "0.2.0") "An example http server with PHP and MySQL support." [RecipeModule "tmux" "2.2", RecipeModule "openssh-server" "6.6.*", RecipeModule "rsync" "3.0.*"] [RecipeModule "httpd" "2.4.*", RecipeModule "mod_auth_kerb" "5.4", RecipeModule "mod_ssl" "2.4.*", RecipeModule "php" "5.4.*", RecipeModule "php-mysql" "5.4.*"] emptyCustomization ] [] multipleRecipeResponse :: RecipesInfoResponse multipleRecipeResponse = RecipesInfoResponse [WorkspaceChanges "glusterfs" False, WorkspaceChanges "http-server" False] [Recipe "glusterfs" (Just "0.0.1") "An example GlusterFS server with samba" [RecipeModule "samba" "4.2.*"] [RecipeModule "glusterfs" "3.7.*", RecipeModule "glusterfs-cli" "3.7.*"] emptyCustomization, Recipe "http-server" (Just "0.2.0") "An example http server with PHP and MySQL support." [RecipeModule "tmux" "2.2", RecipeModule "openssh-server" "6.6.*", RecipeModule "rsync" "3.0.*"] [RecipeModule "httpd" "2.4.*", RecipeModule "mod_auth_kerb" "5.4", RecipeModule "mod_ssl" "2.4.*", RecipeModule "php" "5.4.*", RecipeModule "php-mysql" "5.4.*"] emptyCustomization ] [] errorRecipeResponse :: RecipesInfoResponse errorRecipeResponse = RecipesInfoResponse [WorkspaceChanges "glusterfs" False, WorkspaceChanges "http-server" False] [Recipe "glusterfs" (Just "0.0.1") "An example GlusterFS server with samba" [RecipeModule "samba" "4.2.*"] [RecipeModule "glusterfs" "3.7.*", RecipeModule "glusterfs-cli" "3.7.*"] emptyCustomization, Recipe "http-server" (Just "0.2.0") "An example http server with PHP and MySQL support." [RecipeModule "tmux" "2.2", RecipeModule "openssh-server" "6.6.*", RecipeModule "rsync" "3.0.*"] [RecipeModule "httpd" "2.4.*", RecipeModule "mod_auth_kerb" "5.4", RecipeModule "mod_ssl" "2.4.*", RecipeModule "php" "5.4.*", RecipeModule "php-mysql" "5.4.*"] emptyCustomization ] ["missing-recipe: missing-recipe.toml is not present on branch master"] recipesNewResponse :: APIResponse recipesNewResponse = APIResponse True [] aTestRecipe :: Recipe aTestRecipe = Recipe "A Test Recipe" (Just "0.0.1") "A simple recipe to use for testing" [RecipeModule "rsync" "3.0.*"] [RecipeModule "httpd" "2.4.*"] emptyCustomization recipesCustomization1 :: RecipeCustomization recipesCustomization1 = RecipeCustomization (Just "ralph") [RecipeSshKey "maggie" "KEYDATA"] recipesDepsolveResponse1 :: RecipesDepsolveResponse recipesDepsolveResponse1 = RecipesDepsolveResponse [RecipeDependencies (Recipe "test-fake" (Just "0.0.1") "A test recipe that uses the fake rpms" [RecipeModule "bdcs-fake-lisa""1.0.*"] [RecipeModule "bdcs-fake-bart" "1.3.*"] recipesCustomization1) [PackageNEVRA "bdcs-fake-bart" (Just 0) "1.3.1" "12" "x86_64", PackageNEVRA "bdcs-fake-homer" (Just 0) "2.0.1" "4" "x86_64", PackageNEVRA "bdcs-fake-lisa" (Just 3) "1.0.0" "1" "x86_64", PackageNEVRA "bdcs-fake-sax" (Just 0) "3.8.1" "1" "x86_64"] [PackageNEVRA "bdcs-fake-bart" (Just 0) "1.3.1" "12" "x86_64", PackageNEVRA "bdcs-fake-lisa" (Just 3) "1.0.0" "1" "x86_64"]] [] recipesDepsolveResponse2 :: RecipesDepsolveResponse recipesDepsolveResponse2 = RecipesDepsolveResponse [] ["unknown-recipe: unknown-recipe.toml is not present on branch master"] recipesFreezeResponse1 :: RecipesFreezeResponse recipesFreezeResponse1 = RecipesFreezeResponse [Recipe "test-fake" (Just "0.0.1") "A test recipe that uses the fake rpms" [RecipeModule "bdcs-fake-lisa" "3:1.0.0-1"] [RecipeModule "bdcs-fake-bart" "1.3.1-12"] recipesCustomization1] [] recipesFreezeResponse2 :: RecipesFreezeResponse recipesFreezeResponse2 = RecipesFreezeResponse [] ["unknown-recipe: unknown-recipe.toml is not present on branch master"] projectsDepsolveResponse1 :: ProjectsDepsolveResponse projectsDepsolveResponse1 = ProjectsDepsolveResponse [PackageNEVRA "bdcs-fake-lisa" (Just 3) "1.0.0" "1" "x86_64", PackageNEVRA "bdcs-fake-sax" (Just 0) "3.8.1" "1" "x86_64"] projectsDepsolveResponse2 :: ProjectsDepsolveResponse projectsDepsolveResponse2 = ProjectsDepsolveResponse [] projectsListResponse1 :: ProjectsListResponse projectsListResponse1 = ProjectsListResponse [Projects "bdcs-fake-bart" "Dummy summary" "This is a dummy description." Nothing Nothing, Projects "bdcs-fake-homer" "Dummy summary" "This is a dummy description." Nothing Nothing, Projects "bdcs-fake-lisa" "Dummy summary" "This is a dummy description." Nothing Nothing, Projects "bdcs-fake-sax" "Dummy summary" "This is a dummy description." Nothing Nothing] 0 20 4 projectsListResponse2 :: ProjectsListResponse projectsListResponse2 = ProjectsListResponse [Projects "bdcs-fake-bart" "Dummy summary" "This is a dummy description." Nothing Nothing, Projects "bdcs-fake-homer" "Dummy summary" "This is a dummy description." Nothing Nothing] 0 2 4 projectsListResponse3 :: ProjectsListResponse projectsListResponse3 = ProjectsListResponse [ Projects "bdcs-fake-lisa" "Dummy summary" "This is a dummy description." Nothing Nothing, Projects "bdcs-fake-sax" "Dummy summary" "This is a dummy description." Nothing Nothing] 2 20 4 projectsInfoResponse1 :: ProjectsInfoResponse projectsInfoResponse1 = ProjectsInfoResponse [ ProjectInfo { piBuilds = [BuildInfo { biArch = "x86_64", biConfigRef = "BUILD_CONFIG_REF", biEnvRef = "BUILD_ENV_REF", biBuildTime = read "2018-01-10 18:29:25 UTC" :: UTCTime, biChangelog = "- Initial version", biEpoch = Nothing, biMetadata = [], biRelease = "12", biSource = SourceInfo { siLicense = "GPL", siMetadata = [], siSourceRef = "SOURCE_REF", siVersion = "1.3.1" } }], piDescription = "This is a dummy description.", piHomepage = Nothing, piName = "bdcs-fake-bart", piSummary = "Dummy summary", piUpstream = Nothing } ] projectsInfoResponse2 :: ProjectsInfoResponse projectsInfoResponse2 = ProjectsInfoResponse [ ProjectInfo { piBuilds = [BuildInfo { biArch = "x86_64", biConfigRef = "BUILD_CONFIG_REF", biEnvRef = "BUILD_ENV_REF", biBuildTime = read "2018-01-10 18:29:25 UTC" :: UTCTime, biChangelog = "- Initial version", biEpoch = Nothing, biMetadata = [], biRelease = "12", biSource = SourceInfo { siLicense = "GPL", siMetadata = [], siSourceRef = "SOURCE_REF", siVersion = "1.3.1" } }], piDescription = "This is a dummy description.", piHomepage = Nothing, piName = "bdcs-fake-bart", piSummary = "Dummy summary", piUpstream = Nothing }, ProjectInfo { piBuilds = [BuildInfo { biArch = "x86_64", biConfigRef = "BUILD_CONFIG_REF", biEnvRef = "BUILD_ENV_REF", biBuildTime = read "2018-01-10 18:29:25 UTC" :: UTCTime, biChangelog = "- Initial version", biEpoch = Nothing, biMetadata = [], biRelease = "1", biSource = SourceInfo { siLicense = "GPL", siMetadata = [], siSourceRef = "SOURCE_REF", siVersion = "3.8.1" } }], piDescription = "This is a dummy description.", piHomepage = Nothing, piName = "bdcs-fake-sax", piSummary = "Dummy summary", piUpstream = Nothing } ] modulesListResponse1 :: ModulesListResponse modulesListResponse1 = ModulesListResponse [ ModuleName "bdcs-fake-bart" "rpm" , ModuleName "bdcs-fake-homer" "rpm" , ModuleName "bdcs-fake-lisa" "rpm" , ModuleName "bdcs-fake-sax" "rpm"] 0 20 4 modulesListResponse2 :: ModulesListResponse modulesListResponse2 = ModulesListResponse [ ModuleName "bdcs-fake-bart" "rpm" , ModuleName "bdcs-fake-homer" "rpm"] 0 2 4 modulesListResponse3 :: ModulesListResponse modulesListResponse3 = ModulesListResponse [ ModuleName "bdcs-fake-lisa" "rpm" , ModuleName "bdcs-fake-sax" "rpm"] 2 20 4 modulesListResponse4 :: ModulesListResponse modulesListResponse4 = ModulesListResponse [ ModuleName "bdcs-fake-bart" "rpm"] 0 20 1 -- | Check the status response -- Make sure it looks reasonable checkStatusResponse :: ClientM Bool checkStatusResponse = do response <- getStatus return $ weldrOK response && schemaOK response && dbOK response && srvDbSupported response where weldrOK :: ServerStatus -> Bool weldrOK response = srvBackend response == "weldr" schemaOK :: ServerStatus -> Bool schemaOK response = srvSchemaVersion response == show schemaVersion -- During testing the schema and the database should always be equal dbOK :: ServerStatus -> Bool dbOK response = srvDbVersion response == show schemaVersion -- Post 10 changes to the test recipe postMultipleChanges :: ClientM Bool postMultipleChanges = allM newVersion [0..10] where newVersion :: Integer -> ClientM Bool newVersion patch = status_ok <$> postRecipesNew aTestRecipe {rVersion = Just $ patchedVersion patch} Nothing patchedVersion :: Integer -> String patchedVersion = printf "0.1.%d" status_ok :: APIResponse -> Bool status_ok = arjStatus -- If it has 0 errors, 1 change named http-server, 0 offset and a limit of 20 it passes recipesChangesTest1 :: ClientM Bool recipesChangesTest1 = do response <- getRecipesChanges "http-server" Nothing Nothing Nothing return $ length_ok response && name_ok response && error_ok response && limits_ok response where length_ok :: RecipesChangesResponse -> Bool length_ok response = length (rcrRecipes response) == 1 name_ok :: RecipesChangesResponse -> Bool name_ok response = rcName (rcrRecipes response !! 0) == "http-server" error_ok :: RecipesChangesResponse -> Bool error_ok response = length (rcrErrors response) == 0 limits_ok :: RecipesChangesResponse -> Bool limits_ok response = rcrOffset response == 0 && rcrLimit response == 20 -- If it has 0 errors, 1 change named http-server, 1 named glusterfs, 0 offset and a limit of 20 it passes recipesChangesTest2 :: ClientM Bool recipesChangesTest2 = do response <- getRecipesChanges "http-server,glusterfs" Nothing Nothing Nothing return $ length_ok response && name_ok response && error_ok response && limits_ok response where length_ok :: RecipesChangesResponse -> Bool length_ok response = length (rcrRecipes response) == 2 name_ok :: RecipesChangesResponse -> Bool name_ok response = rcName (rcrRecipes response !! 0) == "glusterfs" && rcName (rcrRecipes response !! 1) == "http-server" error_ok :: RecipesChangesResponse -> Bool error_ok response = length (rcrErrors response) == 0 limits_ok :: RecipesChangesResponse -> Bool limits_ok response = rcrOffset response == 0 && rcrLimit response == 20 -- | Check that limit and offset are parsed correctly -- -- This must be called after posting > 10 changes to the recipe recipesChangesTest3 :: ClientM Bool recipesChangesTest3 = do response <- getRecipesChanges "A Test Recipe" (Just 5) (Just 5) Nothing return $ limits_ok response && length_ok response && name_ok response && total_ok response where limits_ok :: RecipesChangesResponse -> Bool limits_ok response = rcrOffset response == 5 && rcrLimit response == 5 -- Should only be 1 recipe in the response length_ok :: RecipesChangesResponse -> Bool length_ok response = length (rcrRecipes response) == 1 name_ok :: RecipesChangesResponse -> Bool name_ok response = rcName (rcrRecipes response !! 0) == "A Test Recipe" total_ok :: RecipesChangesResponse -> Bool total_ok response = rcTotal (rcrRecipes response !! 0) == 5 -- | Check that deleting a recipe removes it from the list recipesDeleteTest :: ClientM Bool recipesDeleteTest = do result_1 <- recipe_in_list result_2 <- delete_recipe result_3 <- recipe_not_in_list return $ result_1 && result_2 && result_3 where -- Is the recipe in the list? recipe_in_list :: ClientM Bool recipe_in_list = do response <- getRecipes Nothing Nothing Nothing return $ "A-Test-Recipe" `elem` rlrRecipes response -- Delete it from the list delete_recipe :: ClientM Bool delete_recipe = arjStatus <$> deleteRecipes "A Test Recipe" Nothing -- Is it NOT in the list? recipe_not_in_list = do response <- getRecipes Nothing Nothing Nothing return $ "A-Test-Recipe" `notElem` rlrRecipes response -- | Check reverting a recipe to a previous commit recipesUndoTest :: ClientM Bool recipesUndoTest = do -- Get a list of the commits response_1 <- getRecipesChanges "A Test Recipe" Nothing Nothing Nothing let commit = cdCommit (rcChange (rcrRecipes response_1 !! 0) !! 1) -- Revert to a previous commit arjStatus <$> postRecipesUndo "A Test Recipe" (T.unpack commit) Nothing -- | Check that writing to the workspace storage works recipesWorkspaceTest :: ClientM Bool recipesWorkspaceTest = status_ok <$> postRecipesWorkspace aTestRecipe {rDescription = "A workspace only recipe"} Nothing where status_ok :: APIResponse -> Bool status_ok = arjStatus -- | Test the various /recipes/diff/ methods recipesDiffTest :: ClientM Bool recipesDiffTest = do result_1 <- oldest_diff result_2 <- workspace_diff result_3 <- commit_diff return $ result_1 && result_2 && result_3 where oldest_diff = do response <- getRecipesChanges "A Test Recipe" Nothing Nothing Nothing let first_commit = cdCommit $ last $ rcChange (rcrRecipes response !! 0) response_1 <- getRecipesDiff "A Test Recipe" (T.unpack first_commit) "NEWEST" Nothing let old_version = rdtVersion $ rdeOld (rdrDiff response_1 !! 0) let new_version = rdtVersion $ rdeNew (rdrDiff response_1 !! 0) return $ old_version /= new_version && new_version == Just "0.1.9" workspace_diff = do response <- getRecipesChanges "A Test Recipe" Nothing Nothing Nothing let first_commit = cdCommit $ last $ rcChange (rcrRecipes response !! 0) response_1 <- getRecipesDiff "A Test Recipe" (T.unpack first_commit) "WORKSPACE" Nothing let old_desc = rdtDescription $ rdeOld (rdrDiff response_1 !! 0) let new_desc = rdtDescription $ rdeNew (rdrDiff response_1 !! 0) return $ old_desc /= new_desc && new_desc == "A workspace only recipe" commit_diff = do response <- getRecipesChanges "A Test Recipe" Nothing Nothing Nothing let first_commit = cdCommit $ last $ rcChange (rcrRecipes response !! 0) let newer_commit = cdCommit (rcChange (rcrRecipes response !! 0) !! 3) response_1 <- getRecipesDiff "A Test Recipe" (T.unpack first_commit) (T.unpack newer_commit) Nothing let old_version = rdtVersion $ rdeOld (rdrDiff response_1 !! 0) let new_version = rdtVersion $ rdeNew (rdrDiff response_1 !! 0) return $ old_version /= new_version && new_version == Just "0.1.8" composeTypesResponse :: ComposeTypesResponse composeTypesResponse = ComposeTypesResponse [ ComposeType True "directory" , ComposeType True "ostree" , ComposeType True "qcow2" , ComposeType True "tar"] composeEmptyQueueResponse :: ComposeQueueResponse composeEmptyQueueResponse = ComposeQueueResponse [] [] composeEmptyFailedResponse :: ComposeFailedResponse composeEmptyFailedResponse = ComposeFailedResponse [] composeEmptyFinishedResponse :: ComposeFinishedResponse composeEmptyFinishedResponse = ComposeFinishedResponse [] -- | Setup the temporary repo directory with some example recipes -- -- If the directory exists it is first removed. -- Then example recipes are copied into it setupTempRepoDir :: FilePath -> FilePath -> IO () setupTempRepoDir exampleRecipes gitRepoPath = do whenM (doesPathExist gitRepoPath) (removeDirectoryRecursive gitRepoPath) createDirectoryIfMissing True gitRepoPath copyTOMLFiles exampleRecipes gitRepoPath where -- Copy files ending with .toml from one directory to another copyTOMLFiles :: FilePath -> FilePath -> IO () copyTOMLFiles fromDir toDir = do files <- filter (".toml" `isSuffixOf`) <$> listDirectory fromDir let fromFiles = map (fromDir ) files let toFiles = map (toDir ) files mapM_ (\(from, to) -> copyFileWithMetadata from to) $ zip fromFiles toFiles spec :: Spec spec = do describe "Setup" $ do it "Setup the temporary test directory" $ setupTempRepoDir "./tests/recipes/" "/var/tmp/bdcs-tmp-recipes/" it "Copy the test database to /var/tmp/test-bdcs.db" $ copyFileWithMetadata "./tests/mddb/metadata.db" "/var/tmp/test-bdcs.db" describe "/api" $ -- NOTE that mkApp is executed for EACH of the 'it' sections withClient (mkApp "/var/tmp/content-store" "/var/tmp/bdcs-tmp-recipes/" "/var/tmp/test-bdcs.db") $ do it "API Status" $ \env -> try env checkStatusResponse `shouldReturn` True it "list the available recipes" $ \env -> try env (getRecipes Nothing Nothing Nothing) `shouldReturn` recipesListResponse1 it "list recipes with offset and limit" $ \env -> try env (getRecipes (Just 1) (Just 1) Nothing) `shouldReturn` recipesListResponse2 it "Get a non-existant recipe's info" $ \env -> try env (getRecipesInfo "missing-recipe" Nothing) `shouldReturn` missingRecipeResponse it "Get the http-server recipe's info" $ \env -> try env (getRecipesInfo "http-server" Nothing) `shouldReturn` httpserverRecipeResponse it "Get multiple recipe's info" $ \env -> try env (getRecipesInfo "http-server,glusterfs" Nothing) `shouldReturn` multipleRecipeResponse it "Get http-server recipe and missing-recipe info" $ \env -> try env (getRecipesInfo "http-server,missing-recipe,glusterfs" Nothing) `shouldReturn` errorRecipeResponse it "Post a test recipe" $ \env -> try env (postRecipesNew aTestRecipe Nothing) `shouldReturn` recipesNewResponse it "Post several changes to test recipe" $ \env -> try env postMultipleChanges `shouldReturn` True it "Get changes to http-server recipe" $ \env -> try env recipesChangesTest1 `shouldReturn` True it "Get changes to http-server and glusterfs recipes" $ \env -> try env recipesChangesTest2 `shouldReturn` True it "Check offset and limit usage" $ \env -> try env recipesChangesTest3 `shouldReturn` True it "Check delete recipe" $ \env -> try env recipesDeleteTest `shouldReturn` True it "Undo the recipe delete" $ \env -> try env recipesUndoTest `shouldReturn` True it "Write a recipe to the workspace" $ \env -> try env recipesWorkspaceTest `shouldReturn` True it "Tag the most recent commit of the recipe" $ \env -> try env (postRecipesTag "A Test Recipe" Nothing) `shouldReturn` APIResponse True [] it "Get the recipe differences" $ \env -> try env recipesDiffTest `shouldReturn` True it "Depsolve the test-fake recipe" $ \env -> try env (getRecipesDepsolve "test-fake" Nothing) `shouldReturn` recipesDepsolveResponse1 it "Depsolve an unknown recipe" $ \env -> try env (getRecipesDepsolve "unknown-recipe" Nothing) `shouldReturn` recipesDepsolveResponse2 it "Get a frozen test-fake recipe" $ \env -> try env (getRecipesFreeze "test-fake" Nothing) `shouldReturn` recipesFreezeResponse1 it "Freeze an unknown recipe" $ \env -> try env (getRecipesFreeze "unknown-recipe" Nothing) `shouldReturn` recipesFreezeResponse2 it "Depsolve a test package" $ \env -> try env (getProjectsDepsolve "bdcs-fake-lisa") `shouldReturn` projectsDepsolveResponse1 it "Depsolve an unknown package" $ \env -> try env (getProjectsDepsolve "unknown-recipe") `shouldReturn` projectsDepsolveResponse2 it "List the available projects" $ \env -> try env (getProjectsList Nothing Nothing) `shouldReturn` projectsListResponse1 it "List the first 2 projects" $ \env -> try env (getProjectsList Nothing (Just 2)) `shouldReturn` projectsListResponse2 it "List the last 2 projects" $ \env -> try env (getProjectsList (Just 2) Nothing) `shouldReturn` projectsListResponse3 it "Get info on one project" $ \env -> try env (getProjectsInfo "bdcs-fake-bart") `shouldReturn` projectsInfoResponse1 it "Get info on two projects" $ \env -> try env (getProjectsInfo "bdcs-fake-bart,bdcs-fake-sax") `shouldReturn` projectsInfoResponse2 it "Get list of modules" $ \env -> try env (getModulesList Nothing Nothing) `shouldReturn` modulesListResponse1 it "Get first 2 modules" $ \env -> try env (getModulesList Nothing (Just 2)) `shouldReturn` modulesListResponse2 it "Get last 2 modules" $ \env -> try env (getModulesList (Just 2) Nothing) `shouldReturn` modulesListResponse3 it "Get list of modules with 'bart' in them" $ \env -> try env (getModulesList' "*bart*" Nothing Nothing) `shouldReturn` modulesListResponse4 it "Get list of modules starting with 'bdcs' in them" $ \env -> try env (getModulesList' "bdcs*" Nothing Nothing) `shouldReturn` modulesListResponse1 it "Get a list of the available compose export types" $ \env -> try env getComposeTypes `shouldReturn` composeTypesResponse it "Get the (empty) compose queue" $ \env -> try env getComposeQueue `shouldReturn` composeEmptyQueueResponse it "Get the (empty) failed list of composes" $ \env -> try env getComposeQueueFailed `shouldReturn` composeEmptyFailedResponse it "Get the (empty)finished list of composes" $ \env -> try env getComposeQueueFinished `shouldReturn` composeEmptyFinishedResponse describe "cleanup" $ it "Remove the temporary directory" $ removeDirectoryRecursive "/var/tmp/bdcs-tmp-recipes/" withClient :: IO Application -> SpecWith ClientEnv -> SpecWith () withClient x innerSpec = beforeAll (newManager defaultManagerSettings) $ flip aroundWith innerSpec $ \action mgr -> testWithApplication x $ \port -> do let base = BaseUrl Http "localhost" port "" action (ClientEnv mgr base) type Host = (Manager, BaseUrl) try :: ClientEnv -> ClientM a -> IO a try clientEnv action = either throwIO return =<< runClientM action clientEnv