Merge b1644ff into cf77b28

bdcs-api.cabal

@@ -19,6 +19,7 @@ cabal-version:          >=1.10
 library
     exposed-modules:    BDCS.API.Compose,
                         BDCS.API.Config,
+                        BDCS.API.ComposeConfig,
                         BDCS.API.Customization,
                         BDCS.API.Depsolve,
                         BDCS.API.Error,

src/BDCS/API/ComposeConfig.hs

@@ -0,0 +1,69 @@
+-- Copyright (C) 2018 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 <http://www.gnu.org/licenses/>.
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards   #-}
+
+module BDCS.API.ComposeConfig(
+    ComposeConfig(..),
+
+    parseComposeConfig,
+    composeConfigTOML
+) where
+
+import           Data.Aeson
+import qualified Data.Text as T
+import           Text.Printf(printf)
+import           Text.Toml(parseTomlDoc)
+
+
+ -- | Information about the compose configuration not available in other results files
+data ComposeConfig = ComposeConfig {
+    ccCommit       :: T.Text,                                           -- ^ Commit hash for Blueprint
+    ccExportType   :: T.Text                                            -- ^ Export type
+} deriving (Show, Eq)
+
+instance ToJSON ComposeConfig where
+  toJSON ComposeConfig{..} = object
+    [ "commit"      .= ccCommit
+    , "export_type" .= ccExportType
+    ]
+
+instance FromJSON ComposeConfig where
+  parseJSON = withObject "Compose configuration data" $ \o -> do
+    ccCommit     <- o .: "commit"
+    ccExportType <- o .: "export_type"
+    return ComposeConfig{..}
+
+-- | Parse a TOML formatted compose config string and return a ComposeConfig
+--
+-- If there is an error the details will be returned in the Left
+parseComposeConfig :: T.Text -> Either String ComposeConfig
+parseComposeConfig xs =
+    case parseTomlDoc "" xs of
+        Left err    -> Left ("Parsing TOML document failed. " ++ show err)
+        Right table -> do
+            let jsonValue = toJSON table
+            case (fromJSON jsonValue :: Result ComposeConfig) of
+                Error err -> Left ("Converting from JSON to ComposeConfig failed. " ++ show err)
+                Success r -> Right r
+
+-- | Return a TOML string from a ComposeConfig record
+composeConfigTOML :: ComposeConfig -> T.Text
+composeConfigTOML ComposeConfig{..} = T.concat [commitText, exportTypeText]
+  where
+    commitText = T.pack $ printf "commit = \"%s\"\n" ccCommit
+    exportTypeText = T.pack $ printf "export_type = \"%s\"\n" ccExportType

src/BDCS/API/Recipes.hs

@@ -262,15 +262,18 @@ writeCommit repo branch filename message content = do
 -- [@commit@]: Commit hash to read, or Nothing to read the HEAD
 --
 -- TODO Return the commit message too
-readCommit :: Git.Repository -> T.Text -> T.Text -> Maybe T.Text -> IO BS.ByteString
+readCommit :: Git.Repository -> T.Text -> T.Text -> Maybe T.Text -> IO (T.Text, BS.ByteString)
 readCommit repo branch filename Nothing = do
-    let spec = T.pack $ printf "%s:%s" branch filename
-    readCommitSpec repo spec
-readCommit repo _ filename commit = do
-    let spec = T.pack $ printf "%s:%s" (fromJust commit) filename
-    readCommitSpec repo spec
+    commits <- listCommits repo branch filename
+    let spec = T.pack $ printf "%s:%s" (cdCommit $ head commits) filename
+    raw <- readCommitSpec repo spec
+    return (cdCommit $ head commits, raw)
+readCommit repo _ filename (Just commit) = do
+    let spec = T.pack $ printf "%s:%s" commit filename
+    raw <- readCommitSpec repo spec
+    return (commit, raw)
 
--- | Read a commit usinga revspec, return the ByteString content
+-- | Read a commit using a revspec, return the ByteString content
 --
 -- [@repo@]: Open git repository
 -- [@spec@]: revspec to read.
@@ -743,8 +746,8 @@ commitRecipe repo branch recipe = do
     getOldVersion recipe_name = do
         eold_recipe <- readRecipeCommit repo branch recipe_name Nothing
         case eold_recipe of
-            Left  _          -> return Nothing
-            Right old_recipe -> return $ rVersion old_recipe
+            Left  _               -> return Nothing
+            Right (_, old_recipe) -> return $ rVersion old_recipe
 
 -- | Commit recipes from a directory, if they don't already exist
 --
@@ -771,15 +774,19 @@ commitRecipeDirectory repo branch directory = do
 -- [@commit@]: The commit hash string to read
 --
 -- If the recipe isn't found it returns a Left
-readRecipeCommit :: Git.Repository -> T.Text -> T.Text -> Maybe T.Text -> IO (Either String Recipe)
+readRecipeCommit :: Git.Repository -> T.Text -> T.Text -> Maybe T.Text -> IO (Either String (T.Text, Recipe))
 readRecipeCommit repo branch recipe_name commit = do
     -- Is this file in the branch?
     branch_files <- listBranchFiles repo branch
-    let filename = recipeTomlFilename $ T.unpack recipe_name
     if filename `notElem` branch_files
         then return $ Left (printf "%s is not present on branch %s" filename branch)
-        else parseRecipe . decodeUtf8 <$> readCommit repo branch filename commit
-
+        else do
+            (commit_id, recipe_toml) <- readCommit repo branch filename commit
+            case (parseRecipe . decodeUtf8) recipe_toml of
+                Left err     -> return $ Left err
+                Right recipe -> return $ Right (commit_id, recipe)
+  where
+    filename = recipeTomlFilename $ T.unpack recipe_name
 
 -- | print the OId
 --
@@ -1039,7 +1046,7 @@ testGitRepo tmpdir = do
     -- Check that the testRecipe's version was not bumped on 1st save
     putStrLn "    - Checking Recipe Version"
     erecipe <- readRecipeCommit repo "master" "test-server" Nothing
-    let recipe = head $ rights [erecipe]
+    let recipe = snd $ head $ rights [erecipe]
     unless (testRecipe == recipe) (throwIO $ RecipeMismatchError [testRecipe, recipe])
 
     -- Check that saving a changed recipe, with the same version, bumps it.
@@ -1050,7 +1057,7 @@ testGitRepo tmpdir = do
     -- Check that the version was bumped on the 2nd save
     putStrLn "    - Checking Modified Recipe's Version"
     erecipe' <- readRecipeCommit repo "master" "test-server" Nothing
-    let recipe' = head $ rights [erecipe']
+    let recipe' = snd $ head $ rights [erecipe']
     unless (new_recipe1 {rVersion = Just "0.1.3"} == recipe') (throwIO $ RecipeMismatchError [new_recipe1, recipe'])
 
     -- Check that saving a changed recipe, with a completely different version, uses it without bumping.
@@ -1062,7 +1069,7 @@ testGitRepo tmpdir = do
     -- Check that the version was used as-is
     putStrLn "    - Checking Modified Recipe's Version"
     erecipe'' <- readRecipeCommit repo "master" "test-server" Nothing
-    let recipe'' = head $ rights [erecipe'']
+    let recipe'' = snd $ head $ rights [erecipe'']
     unless (new_recipe2 == recipe'') (throwIO $ RecipeMismatchError [new_recipe2, recipe''])
 
     -- List the files on master