CommandResult golden coverage

golden/accounts-module-failureCR/golden

@@ -0,0 +1 @@
+{"gas":0,"result":{"status":"failure","error":{"callStack":["golden/golden.accounts.repl:45:4: (with-read (deftable accounts:(defschema account \"Row type fo... \"a\" ({g:<c> \"rowguard\"} [(native `enforce-guard`  Exec...)","golden/golden.accounts.repl:151:21: (USER_GUARD \"a\")","golden/golden.accounts.repl:151:4: (with-capability ((defcap accounts.USER_GUARD:<a> (id:<b>)) \"a\") [(native `with-read`  Special form to read row fro...)","golden/golden.accounts.repl:85:6: (debit \"a\" 1.0 true {\"transfer-to\": \"b\"})","golden/golden.accounts.repl:84:4: (with-capability ((defcap accounts.TRANSFER:<d> ())) [((defun accounts.debit:<as> (acct:<at> amount:<au...)","<interactive>:0:0: (transfer \"a\" \"b\" 1.0 true)"],"type":"TxFailure","message":"with-read: row not found: a","info":"golden/golden.accounts.repl:45:4"}},"reqKey":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","logs":null,"metaData":null,"continuation":null,"txId":null}

golden/accounts-module-successCR/golden

@@ -0,0 +1 @@
+{"gas":0,"result":{"status":"success","data":1},"reqKey":"DldRwCblQ7Loqy6wYJnaodHl30d3j3eH-qtFzfEv46g","logs":"wsATyGqckuIvlm89hhd2j4t6RMkCrcwJe_oeCYr7Th8","metaData":null,"continuation":null,"txId":null}

tests/GoldenSpec.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
@@ -8,30 +9,45 @@ module GoldenSpec
   where
 
 import Control.Exception
+import Control.Lens
 import Data.Aeson
 import qualified Data.ByteString.Lazy as BL
+import Data.Default
 import Data.Either
+import Data.Text (Text)
 import System.Directory
 
 import Test.Hspec
 import Test.Hspec.Golden
 
 
+import Pact.Gas
+import Pact.Interpreter
+import Pact.Parse
 import Pact.Repl
 import Pact.Repl.Types
+import Pact.Server.PactService
+import Pact.Types.Command
+import Pact.Types.Logger
 import Pact.Types.Names
 import Pact.Types.Persistence
+import Pact.Types.RPC
+import Pact.Types.Runtime
+import Pact.Types.SPV
 
 spec :: Spec
 spec = do
   describe "goldenAccounts" $
     goldenModule "accounts-module" "golden/golden.accounts.repl" "accounts"
+    [("successCR",acctsSuccessCR)
+    ,("failureCR",acctsFailureCR)
+    ]
   describe "goldenAutoCap" $
-    goldenModule "autocap-module" "golden/golden.autocap.repl" "auto-caps-mod"
+    goldenModule "autocap-module" "golden/golden.autocap.repl" "auto-caps-mod" []
 
 goldenModule
-  :: String -> FilePath -> ModuleName -> Spec
-goldenModule tn fp mn = after_ (cleanupActual tn) $ do
+  :: String -> FilePath -> ModuleName -> [(String, String -> ReplState -> Spec)] -> Spec
+goldenModule tn fp mn tests = after_ (cleanupActual tn (map fst tests)) $ do
   (r,s) <- runIO $ execScript' Quiet fp
   it ("loads " ++ fp) $ r `shouldSatisfy` isRight
   mr <- runIO $ replLookupModule s mn
@@ -41,13 +57,48 @@ goldenModule tn fp mn = after_ (cleanupActual tn) $ do
       Left e -> it "failed to convert to PersistDirect" $ expectationFailure (show e)
       Right m' -> do
         it "matches golden" $ golden tn m'
+        (`mapM_` tests) $ \(n,f) -> do
+          describe n $ f (subTestName tn n) s
 
+subTestName :: String -> String -> String
+subTestName tn n = tn ++ "-" ++ n
 
-cleanupActual :: String -> IO ()
-cleanupActual testname =
-  catch (removeFile $ "golden/" ++ testname ++ "/actual")
-  (\(_ :: SomeException) -> return ())
+acctsSuccessCR :: String -> ReplState -> Spec
+acctsSuccessCR tn s = doCRTest tn s "1"
 
+acctsFailureCR :: String -> ReplState -> Spec
+acctsFailureCR tn s = doCRTest tn s "(accounts.transfer \"a\" \"b\" 1.0 true)"
+
+doCRTest :: String -> ReplState -> Text -> Spec
+doCRTest tn s code = do
+  let dbEnv = PactDbEnv (view (rEnv . eePactDb) s) (view (rEnv . eePactDbVar) s)
+      cmd = Command payload [] initialHash
+      payload = Payload exec "" pubMeta [] Nothing
+      pubMeta = def
+      parsedCode = either error id $ parsePact code
+      exec = Exec $ ExecMsg parsedCode Null
+  r <- runIO $ applyCmd (newLogger neverLog "") Nothing dbEnv (constGasModel 0) 0 0 ""
+       noSPVSupport Local cmd (ProcSucc cmd)
+  -- due to weird StackTrace encoding, we are only interested in ToJSON, so we'll
+  -- golden on the encoded LBS only
+  let encoded = encode r
+  it "matches golden encoded" $ Golden
+    { output = encoded
+    , encodePretty = show
+    , writeToFile = BL.writeFile
+    , readFromFile = BL.readFile
+    , testName = tn
+    , directory = "golden"
+    }
+
+
+cleanupActual :: String -> [String] -> IO ()
+cleanupActual testname subs = do
+  go testname
+  mapM_ (\n -> go (subTestName testname n)) subs
+  where
+    go tn = catch (removeFile $ "golden/" ++ tn ++ "/actual")
+            (\(_ :: SomeException) -> return ())
 
 golden :: (Show a,FromJSON a,ToJSON a) => String -> a -> Golden a
 golden name obj = Golden