wip wip

.vscode/settings.json

@@ -0,0 +1,7 @@
+{
+  "coverage-gutters.showLineCoverage": false,
+  "coverage-gutters.showRulerCoverage": false,
+  "coverage-gutters.showGutterCoverage": false,
+  "haskell.plugin.importLens.codeActionsOn": false,
+  "haskell.plugin.importLens.codeLensOn": false
+}

pact-request-api/Pact/Core/Command/RPC.hs

@@ -91,8 +91,6 @@ instance FromJSON ContMsg where
           StableEncoding msgData <- o .: "data"
           maybeProof <- o .:? "proof"
           pure $ ContMsg defPactId step rollback msgData maybeProof
-          -- ContMsg <$> o .: "pactId" <*> o .: "step" <*> o .: "rollback" <*> o .: "data"
-          -- <*> o .: "proof"
   {-# INLINE parseJSON #-}
 
 instance J.Encode ContMsg where

pact-request-api/Pact/Core/Command/Server.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveTraversable #-}
 
 module Pact.Core.Command.Server
   ( API
@@ -24,6 +25,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.IO.Class
 import Data.Default
+import Data.Foldable
 import qualified Data.HashMap.Strict as HM
 import Data.IORef
 import qualified Data.List as L
@@ -38,6 +40,8 @@ import qualified Data.Text.Encoding as E
 import Data.Version
 import Network.Wai.Handler.Warp
 import Network.Wai.Middleware.Cors
+import Network.Wai.Logger
+import System.Log.FastLogger.Date
 import Pact.Core.Builtin
 import Pact.Core.ChainData
 import Pact.Core.Command.Client
@@ -63,6 +67,8 @@ import qualified Pact.JSON.Encode as JE
 import qualified Pact.JSON.Legacy.Utils as JL
 import Servant.API
 import Servant.Server
+import System.Directory
+import Control.Exception.Safe hiding (Handler)
 
 
 -- | Temporarily pretend our Log type in CommandResult is unit.
@@ -73,6 +79,7 @@ data ServerRuntime
   = ServerRuntime
   { _srDbEnv :: PactDb CoreBuiltin Info
   , _srRequestCache :: LruHandle RequestKey (CommandResult Log (PactErrorCode Info))
+  , _srSPVSupport :: SPVSupport
   }
 
 newtype PollRequest
@@ -88,7 +95,7 @@ newtype PollResponse
   = PollResponse (HM.HashMap RequestKey (CommandResult Log (PactErrorCode Info)))
 
 instance JE.Encode PollResponse where
-  build (PollResponse pr) = JE.build $ JL.legacyHashMap requestKeyToB16Text (commandToStableEncoding <$> pr)
+  build (PollResponse pr) = JE.build $ JL.legacyHashMap requestKeyToB64Text (commandToStableEncoding <$> pr)
 
 instance JD.FromJSON PollResponse where
   parseJSON v = do
@@ -185,22 +192,35 @@ type API = ("api" :> "v1" :>
        :<|> ("local" :> ReqBody '[PactJson] LocalRequest :> Post '[PactJson] LocalResponse)))
            :<|> "version" :> Get '[PlainText] Text
 
-runServer :: Config -> IO ()
-runServer (Config port persistDir _logDir) = do
+runServer :: Config -> SPVSupport -> IO ()
+runServer (Config port persistDir logDir _verbose _gl) spv = do
+  (traverse_.traverse_) (createDirectoryIfMissing True) [persistDir, logDir]
   emptyCache <- newLruHandle 100
   case persistDir of
     Nothing -> withSqlitePactDb serialisePact_raw_spaninfo ":memory:" $ \pdb -> do
-      runServer_ (ServerRuntime pdb emptyCache) port
-    Just pdir -> withSqlitePactDb serialisePact_raw_spaninfo (T.pack pdir) $ \pdb -> do
-      runServer_ (ServerRuntime pdb emptyCache) port
+      runServer_ (ServerRuntime pdb emptyCache spv) port logDir
+    Just pdir -> withSqlitePactDb serialisePact_raw_spaninfo (T.pack pdir <> "pactdb.sqlite") $ \pdb -> do
+      runServer_ (ServerRuntime pdb emptyCache spv) port logDir
+
+runServer_ :: ServerRuntime -> Port -> Maybe FilePath -> IO ()
+runServer_ env port logDir = bracket setupLogger teardownLogger runServer'
 
-runServer_ :: ServerRuntime -> Port -> IO ()
-runServer_ env port = runSettings settings $ cors (const corsPolicy) app
   where
+  runServer' (logger, _) =
+    runSettings (settings logger) $ cors (const corsPolicy) app
+  teardownLogger (_, remover) = void remover
+  setupLogger = do
+    lt <- case logDir of
+      Just ld -> pure (LogFileNoRotate ld 4096)
+      Nothing -> pure (LogStdout 4096)
+    apf <- initLogger FromFallback lt =<< newTimeCache simpleTimeFormat
+    let remover = logRemover apf
+    pure (apacheLogger apf, remover)
   app = serve (Proxy @API) (server env)
-  settings = defaultSettings
+  settings logger = defaultSettings
     & setPort port
     & setHost "127.0.0.1"
+    & setLogger logger
   corsPolicy = Just CorsResourcePolicy
     { corsOrigins = Nothing
     , corsMethods = ["GET", "POST"]

pact-request-api/Pact/Core/Command/Server/Config.hs

@@ -1,10 +1,12 @@
--- | 
+{-# LANGUAGE InstanceSigs #-}
+-- |
 
 module Pact.Core.Command.Server.Config where
 
 import qualified Data.Yaml as Y
---import Data.Word
-import Data.Text (Text)
+import Control.Exception.Safe
+import Data.Foldable
+import System.Directory
 import qualified Pact.JSON.Decode as JD
 
 import GHC.Generics
@@ -13,31 +15,42 @@ import GHC.Generics
 data Config = Config
   { _port :: Int
   , _persistDir :: Maybe FilePath
-  , _logDir :: FilePath
-  -- , _pragmas :: [Pragma]
-  -- , _verbose :: Bool
-  -- , _gasLimit :: Maybe Int
-  -- , _gasRate :: Maybe Int
+  , _logDir :: Maybe FilePath
+  , _verbose :: Bool
+  , _gasLimit :: Maybe Int
   } deriving (Eq,Show,Generic)
 
--- | Pragma for configuring a SQLite database.
-newtype Pragma = Pragma Text
-  deriving (Eq, Show, Generic)
-
 
 instance JD.FromJSON Config where
+  parseJSON :: JD.Value -> Y.Parser Config
   parseJSON = JD.withObject "Config" $ \o ->
     Config <$> o JD..: "port"
     <*> o JD..:? "persistDir"
-    <*> o JD..: "logDir"
-  --  <*> o 
-
--- validateConfigFile :: FilePath -> IO Config
--- validateConfigFile fp = Y.decodeFileEither fp >>= \case
---   Left pe -> do
---     putStrLn usage
---     throwIO $ userError $ "Error loading config file: " ++ show pe
---   Right v -> do
---     traverse_ (createDirectoryIfMissing True) $ _persistDir v
---     createDirectoryIfMissing True $ _logDir vX2
---     pure v
+    <*> o JD..:? "logDir"
+    <*> o JD..: "verbose"
+    <*> o JD..:? "gasLimit"
+
+usage :: String
+usage = unlines
+  [ "Config file is YAML format with the following properties:"
+  , "port       - HTTP server port"
+  , "persistDir - Directory for database files."
+  , "             If omitted, runs in-memory only."
+  , "logDir     - Directory for HTTP logs, defaults to no log dir"
+  , "pragmas    - SQLite pragmas to use with persistence DBs"
+  , "entity     - Entity name for simulating privacy, defaults to \"entity\""
+  , "gasLimit   - Gas limit for each transaction, defaults to 0"
+  , "gasRate    - Gas price per action, defaults to 0"
+  , "execConfig - Pact runtime execution flags"
+  , "verbose    - Output additional information"
+  , "\n"
+  ]
+
+validateConfigFile :: FilePath -> IO Config
+validateConfigFile fp = Y.decodeFileEither fp >>= \case
+  Left pe -> do
+    putStrLn usage
+    throwIO $ userError $ "Error loading config file: " ++ show pe
+  Right v -> do
+    (traverse_.traverse_) (createDirectoryIfMissing True) [_persistDir v, _logDir v]
+    pure v

pact-request-api/Pact/Core/Command/Types.hs

@@ -49,7 +49,7 @@ module Pact.Core.Command.Types
   , RequestKey(..)
   , RequestKeys(..)
   , cmdToRequestKey
-  , requestKeyToB16Text
+  , requestKeyToB64Text
   , parsePact
 
   , DynKeyPair (DynEd25519KeyPair, DynWebAuthnKeyPair)
@@ -347,9 +347,8 @@ data DynKeyPair
   | DynWebAuthnKeyPair WebAuthnPubKeyPrefixed WebAuthnPublicKey WebauthnPrivateKey
   deriving (Eq, Show, Generic)
 
-requestKeyToB16Text :: RequestKey -> Text
-requestKeyToB16Text (RequestKey (PactHash.Hash h)) =
-  T.decodeUtf8 $ B16.encode (ShortByteString.fromShort h)
+requestKeyToB64Text :: RequestKey -> Text
+requestKeyToB64Text (RequestKey h) = PactHash.hashToText h
 
 newtype RequestKey = RequestKey { unRequestKey :: PactHash.Hash}
   deriving (Eq, Ord, Generic)