Pact swagger api, REST API refactor (#510)

* API refactor for Swagger support, better client export

* make timeouts part of Listen api

* use GasLimit, GasPrice in API

* swagger liftoff!

* compat fix for swagger 2.2, plus remove weeder dep from nix builds

* problem with base-compat-batteries tests

* disable static build; try artifacts for linux build

* disable linux artifacts

* artifacts stuff

* artifacts paths

* fix binary names

* typo

* try to fix pages deploy using https://gitlab.com/gitlab-org/gitlab-ee/issues/1719#note_60888099

* duh, nix builds aren't portable

.gitlab-ci.yml

@@ -9,17 +9,21 @@ pact-macos:
   script:
     - nix-build
     - nix-build -A ghc.pact.doc
-    - ./collectArtifacts.sh
+    - ./collectArtifacts.sh macos
   artifacts:
     paths:
-    - public/
+    - public-macos/
 
 pact-linux:
   stage: build
   tags:
     - linux
   script:
     - nix-build
+#    - ./collectArtifacts.sh linux
+#  artifacts:
+#    paths:
+#    - public-linux/
 
 # deploy-nix-cache:
 #   stage: deploy
@@ -31,14 +35,16 @@ pact-linux:
 pages:
   stage: deploy
   script:
-  - echo 'Nothing to do...'
+    - mkdir public
+    - mv public-macos public/
+#    - mv public-linux public/
   artifacts:
     paths:
     - public/
 
-pact-linux-static:
-  stage: build
-  script:
-    - nix-build static.nix --argstr system x86_64-linux
-  tags:
-    - linux
+# pact-linux-static:
+#   stage: build
+#   script:
+#     - nix-build static.nix --argstr system x86_64-linux
+#   tags:
+#     - linux

collectArtifacts.sh

@@ -5,11 +5,14 @@
 if [ ! -d result ] ; then nix-build ; fi
 if [ ! -d result-doc ] ; then nix-build -A ghc.pact.doc ; fi
 
-rm -fr public
-mkdir -p public
-cp -LR result/ghc/pact/share/hpc/vanilla/html public/code-coverage
-mkdir -p public/docs
-cp -LR `find result-doc/share -name html`/* public/docs
-mkdir -p public/binaries
-cp -LR result/ghc/pact/bin/pact public/binaries/pact-macos
-chmod -R u+w public
+pubdir="public-$1"
+binary="pact-$1"
+
+rm -fr $pubdir
+mkdir -p $pubdir
+cp -LR result/ghc/pact/share/hpc/vanilla/html $pubdir/code-coverage
+mkdir -p $pubdir/docs
+cp -LR `find result-doc/share -name html`/* $pubdir/docs
+mkdir -p $pubdir/binaries
+cp -LR result/ghc/pact/bin/pact $pubdir/binaries/$binary
+chmod -R u+w $pubdir

default.nix

@@ -35,6 +35,9 @@ in
 
             # tests for extra were failing due to an import clash (`isWindows`)
             extra = dontCheck super.extra;
+
+            base-compat-batteries = dontCheck super.base-compat-batteries;
+
             # tests try to use ghc-pkg and cabal (https://github.com/sol/doctest/issues/213)
             doctest = guardGhcjs (dontCheck (self.callHackage "doctest" "0.16.0" {}));
             # these want to use doctest, which doesn't work on ghcjs
@@ -58,6 +61,8 @@ in
             servant = whenGhcjs dontCheck super.servant;
             servant-client = whenGhcjs dontCheck super.servant-client;
             servant-server = whenGhcjs dontCheck super.servant-server;
+            servant-swagger = whenGhcjs dontCheck super.servant-swagger;
+            swagger2 = whenGhcjs dontCheck super.swagger2;
             unix-time = whenGhcjs dontCheck super.unix-time;
             wai-app-static = whenGhcjs dontCheck super.wai-app-static;
             wai-extra = whenGhcjs dontCheck super.wai-extra;
@@ -112,14 +117,6 @@ in
               sha256 = "09fcf896bs6i71qhj5w6qbwllkv3gywnn5wfsdrcm0w1y6h8i88f";
             }) {});
 
-            # weeder = self.callHackage "weeder" "1.0.5" {};
-            weeder = self.callCabal2nix "weeder" (pkgs.fetchFromGitHub {
-              owner = "ndmitchell";
-              repo = "weeder";
-              rev = "56b46fe97782e86198f31c574ac73c8c966fee05";
-              sha256 = "005ks2xjkbypq318jd0s4896b9wa5qg3jf8a1qgd4imb4fkm3yh7";
-            }) {};
-
             # aeson 1.4.2
             aeson = (if self.ghc.isGhcjs or false
               then (pkgs.lib.flip addBuildDepend self.hashable-time)

pact.cabal

@@ -43,7 +43,6 @@ library
                      , Pact.Repl.Lib
                      , Pact.Repl.Types
                      , Pact.Server.API
-                     , Pact.Server.Client
                      , Pact.Types.API
                      , Pact.Types.ChainMeta
                      , Pact.Types.Codec
@@ -64,6 +63,7 @@ library
                      , Pact.Types.RPC
                      , Pact.Types.Runtime
                      , Pact.Types.Orphans
+                     , Pact.Types.Swagger
                      , Pact.Types.Term
                      , Pact.Types.Type
                      , Pact.Types.Util
@@ -185,6 +185,8 @@ library
                      , servant
                      , servant-client
                      , servant-client-core
+                     , servant-swagger
+                     , swagger2 >= 2.2
 
   if impl(ghcjs)
     build-depends:

src-ghc/Pact/Server/ApiServer.hs

@@ -33,7 +33,6 @@ import Control.Monad.Trans.Except
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy.Char8 as BSL8
 import qualified Data.Text as T
-import Data.Proxy
 import Data.Text.Encoding
 
 import Data.HashSet (HashSet)
@@ -90,7 +89,6 @@ apiV1Server :: ApiEnv -> Server ApiV1API
 apiV1Server conf = hoistServer apiV1API nt
   (sendHandler :<|> pollHandler :<|> listenHandler :<|> localHandler)
   where
-    apiV1API = Proxy :: Proxy ApiV1API
     nt :: forall a. Api a -> Handler a
     nt s = Handler $ runReaderT s conf
 
@@ -110,7 +108,7 @@ pollHandler (Poll rks) = do
   when (HM.null possiblyIncompleteResults) $ log $ "No results found for poll!" ++ show rks
   pure $ pollResultToReponse possiblyIncompleteResults
 
-listenHandler :: ListenerRequest -> Api (CommandResult Hash)
+listenHandler :: ListenerRequest -> Api ListenResponse
 listenHandler (ListenerRequest rk) = do
   hChan <- view aiHistoryChan
   m <- liftIO newEmptyMVar
@@ -123,7 +121,7 @@ listenHandler (ListenerRequest rk) = do
       die' msg
     ListenerResult cr -> do
       log $ "Listener Serviced for: " ++ show rk
-      pure cr
+      pure (ListenResponse cr)
 
 localHandler :: Command T.Text -> Api (CommandResult Hash)
 localHandler commandText = do

src-ghc/Pact/Server/PactService.hs

@@ -26,7 +26,6 @@ import qualified Data.ByteString.Lazy  as BSL
 
 import Pact.Gas
 import Pact.Interpreter
-import Pact.Parse (ParsedDecimal(..))
 import Pact.Types.Command
 import Pact.Types.Gas
 import Pact.Types.Logger
@@ -81,8 +80,7 @@ applyCmd _ _ _ _ _ _ _ cmd (ProcFail s) =
            (PactError TxFailure def def . viaShow $ s)
 applyCmd logger conf dbv gasModel bh bt exMode _ (ProcSucc cmd) = do
   let pubMeta = _pMeta $ _cmdPayload cmd
-      (ParsedDecimal gasPrice) = _pmGasPrice pubMeta
-      gasEnv = GasEnv (fromIntegral $ _pmGasLimit pubMeta) (GasPrice gasPrice) gasModel
+      gasEnv = GasEnv (_pmGasLimit pubMeta) (_pmGasPrice pubMeta) gasModel
       pd = PublicData pubMeta bh bt
 
   res <- catchesPactError $ runCommand

src/Pact/Analyze/Remote/Types.hs

@@ -1,18 +1,20 @@
 {-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell   #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 -- | Types for remote verification of pact programs from GHCJS in the browser.
 module Pact.Analyze.Remote.Types where
 
 import           Control.Lens       (makeLenses)
 import qualified Data.Aeson         as A
 import           Data.Text          (Text)
+import           GHC.Generics
 
 import           Pact.Types.Term    (ModuleDef, ModuleName, Name)
 
 data Request
   = Request [ModuleDef Name] ModuleName -- ^ verify one of the modules, by name
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
 
 instance A.FromJSON Request where
   parseJSON = A.withObject "Request" $ \o ->
@@ -29,7 +31,7 @@ newtype Response
   = Response
     { _responseLines :: [Text] -- ^ REPL output from the server, whether
                                -- verification has failed or succeeded.
-    } deriving (Eq, Show)
+    } deriving (Eq, Show, Generic)
 
 instance A.FromJSON Response where
   parseJSON = A.withObject "Response" $ \o ->

src/Pact/Native.hs

@@ -302,16 +302,13 @@ chainDataDef = defRNative "chain-data" chainData (funType obj [])
 
       let PublicMeta{..} = _pdPublicMeta
 
-      let (ParsedInteger gl) = _pmGasLimit
-          (ParsedDecimal gp) = _pmGasPrice
-
       pure $ toTObject TyAny def
         [ ("chain-id"    , toTerm _pmChainId    )
         , ("block-height", toTerm _pdBlockHeight)
         , ("block-time"  , toTerm _pdBlockTime  )
         , ("sender"      , toTerm _pmSender     )
-        , ("gas-limit"   , toTerm gl            )
-        , ("gas-price"   , toTerm gp            )
+        , ("gas-limit"   , toTerm _pmGasLimit   )
+        , ("gas-price"   , toTerm _pmGasPrice   )
         ]
     chainData i as = argsError i as
 

src/Pact/Repl/Lib.hs

@@ -53,7 +53,6 @@ import qualified Pact.Types.Crypto as Crypto
 import Pact.Types.Util (fromText')
 #endif
 
-import Pact.Parse
 import Pact.Typechecker
 import qualified Pact.Types.Typecheck as TC
 -- intentionally hidden unused functions to prevent lib functions from consuming gas
@@ -546,13 +545,13 @@ envChainDataDef = defZRNative "env-chain-data" envChainData
       _ -> argsError i as
 
     go i pd ((FieldKey k), (TLiteral (LInteger l) _)) = case Text.unpack k of
-      "gas-limit"    -> pure $ set (pdPublicMeta . pmGasLimit) (ParsedInteger . fromIntegral $ l) pd
+      "gas-limit"    -> pure $ set (pdPublicMeta . pmGasLimit) (GasLimit . fromIntegral $ l) pd
       "block-height" -> pure $ set pdBlockHeight (fromIntegral l) pd
       "block-time"   -> pure $ set pdBlockTime (fromIntegral l) pd
       t              -> evalError i $ "envChainData: bad public metadata key: " <> prettyString t
 
     go i pd ((FieldKey k), (TLiteral (LDecimal l) _)) = case Text.unpack k of
-      "gas-price" -> pure $ set (pdPublicMeta . pmGasPrice) (ParsedDecimal l) pd
+      "gas-price" -> pure $ set (pdPublicMeta . pmGasPrice) (GasPrice l) pd
       t           -> evalError i $ "envChainData: bad public metadata key: " <> prettyString t
 
     go i pd ((FieldKey k), (TLiteral (LString l) _)) = case Text.unpack k of