wip beam support

IntersectMBO · Jun 8, 2021 · 3446a4e · 3446a4e
1 parent c3e820f
commit 3446a4e
Show file tree

Hide file tree

Showing 11 changed files with 511 additions and 23 deletions.
diff --git a/cabal.project b/cabal.project
@@ -38,7 +38,7 @@ benchmarks: true
 -- newer version of persistent. See stack.yaml for the mirrored
 -- configuration.
 package eventful-sql-common
-  ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances
+  ghc-options: -XDerivingStrategies -XStandaloneDeriving -XUndecidableInstances -XDataKinds -XFlexibleInstances -XMultiParamTypeClasses
 
 allow-newer:
            -- Has a commit to allow newer aeson, not on Hackage yet
@@ -49,6 +49,12 @@ allow-newer:
            -- The following two dependencies are needed by plutus.
            , eventful-sql-common:persistent
            , eventful-sql-common:persistent-template
+
+           --
+           , beam-core:aeson
+           , beam-sqlite:aeson
+           , beam-sqlite:dlist
+           , beam-migrate:aeson
 
 constraints:
   -- aws-lambda-haskell-runtime-wai doesn't compile with newer versions
@@ -151,3 +157,5 @@ source-repository-package
   type: git
   location: https://github.com/input-output-hk/goblins
   tag: cde90a2b27f79187ca8310b6549331e59595e7ba
+
+
diff --git a/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-pab.nix b/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-pab.nix
diff --git a/nix/pkgs/haskell/materialized-unix/default.nix b/nix/pkgs/haskell/materialized-unix/default.nix
diff --git a/plutus-pab/app/Cli.hs b/plutus-pab/app/Cli.hs
@@ -86,18 +86,19 @@ import           Plutus.PAB.Effects.EventLog             (EventLogBackend (..))
 
 import           Cardano.Node.Types                      (MockServerConfig (..))
 import qualified PSGenerator
-import           Plutus.Contract.Resumable               (responses)
-import           Plutus.Contract.State                   (State (..))
-import qualified Plutus.Contract.State                   as State
-import qualified Plutus.PAB.App                          as App
-import qualified Plutus.PAB.Core                         as Core
-import qualified Plutus.PAB.Db.Eventful                  as Eventful
-import           Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
-import qualified Plutus.PAB.Monitoring.Monitoring        as LM
-import           Plutus.PAB.Types                        (Config (..), DbConfig (..), chainIndexConfig,
-                                                          metadataServerConfig, nodeServerConfig, walletServerConfig)
-import qualified Plutus.PAB.Webserver.Server             as PABServer
-import           Plutus.PAB.Webserver.Types              (ContractActivationArgs (..))
+import           Plutus.Contract.Resumable                (responses)
+import           Plutus.Contract.State                    (State (..))
+import qualified Plutus.Contract.State                    as State
+import qualified Plutus.PAB.App                           as App
+import qualified Plutus.PAB.Core                          as Core
+import qualified Plutus.PAB.Db.Beam                       as Beam
+import qualified Plutus.PAB.Db.Eventful                   as Eventful
+import           Plutus.PAB.Effects.Contract.ContractExe  (ContractExe)
+import qualified Plutus.PAB.Monitoring.Monitoring         as LM
+import           Plutus.PAB.Types                         (Config (..), DbConfig (..), chainIndexConfig,
+                                                           metadataServerConfig, nodeServerConfig, walletServerConfig)
+import qualified Plutus.PAB.Webserver.Server              as PABServer
+import           Plutus.PAB.Webserver.Types               (ContractActivationArgs (..))
 
 runNoConfigCommand ::
     Trace IO (LM.AppMsg ContractExe)  -- ^ PAB Tracer logging instance
@@ -108,7 +109,9 @@ runNoConfigCommand trace = \case
     -- Run database migration
     Migrate{dbPath} ->
         let conf = DbConfig{dbConfigPoolSize=10, dbConfigFile=Text.pack dbPath} in
-        App.migrate (LM.convertLog LM.PABMsg trace) conf
+        App.beamMigrate (LM.convertLog LM.PABMsg trace) conf
+        -- TODO: Restore or delete
+        -- App.migrate (LM.convertLog LM.PABMsg trace) conf
 
     -- Generate PureScript bridge code
     PSGenerator {outputDir} -> PSGenerator.generate outputDir
@@ -191,10 +194,16 @@ runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config {nodeServerConf
 
 -- Install a contract
 runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (InstallContract contractExe) = do
-    connection <- Sqlite <$> App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
+    connection <- App.beamDbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
     fmap (either (error . show) id)
-        $ Eventful.runEventfulStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+        $ Beam.runBeamStoreAction connection
         $ Contract.addDefinition @ContractExe contractExe
+-- TODO: Restore or delete!
+-- runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (InstallContract contractExe) = do
+--     connection <- Sqlite <$> App.dbConnect (LM.convertLog LM.PABMsg ccaTrace) dbConfig
+--     fmap (either (error . show) id)
+--         $ Eventful.runEventfulStoreAction connection (LM.convertLog (LM.PABMsg . LM.SLoggerBridge) ccaTrace)
+--         $ Contract.addDefinition @ContractExe contractExe
 
 -- Get the state of a contract
 runConfigCommand ConfigCommandArgs{ccaTrace, ccaPABConfig=Config{dbConfig}} (ContractState contractInstanceId) = do

diff --git a/plutus-pab/plutus-pab.cabal b/plutus-pab/plutus-pab.cabal
@@ -77,6 +77,9 @@ library
         Plutus.PAB.Core.ContractInstance.BlockchainEnv
         Plutus.PAB.Core.ContractInstance.RequestHandlers
         Plutus.PAB.Core.ContractInstance.STM
+        Plutus.PAB.Db.Beam
+        Plutus.PAB.Db.Beam.ContractStore
+        Plutus.PAB.Db.Beam.ContractDefinitionStore
         Plutus.PAB.Db.Eventful
         Plutus.PAB.Db.Eventful.Command
         Plutus.PAB.Db.Eventful.ContractDefinitionStore
@@ -87,6 +90,7 @@ library
         Plutus.PAB.Effects.Contract.Builtin
         Plutus.PAB.Effects.Contract.ContractExe
         Plutus.PAB.Effects.ContractRuntime
+        Plutus.PAB.Effects.DbStore
         Plutus.PAB.Effects.EventLog
         Plutus.PAB.Effects.UUID
         Plutus.PAB.Effects.TimeEffect
@@ -194,7 +198,11 @@ library
         exceptions -any,
         data-default -any,
         time-units -any,
-        time -any
+        time -any,
+        beam-core -any,
+        beam-sqlite -any,
+        beam-migrate -any,
+        sqlite-simple -any
 
 executable plutus-pab
     main-is: Main.hs

diff --git a/plutus-pab/put-data-in-pab.sh b/plutus-pab/put-data-in-pab.sh
@@ -0,0 +1,13 @@
+#!/bin/bash
+
+set -ex
+
+killall plutus-pab || true
+
+rm -rf pab-core.db* 
+
+cabal exec -- plutus-pab --config plutus-pab.yaml migrate pab-core.db
+
+cabal exec -- plutus-pab --config plutus-pab.yaml contracts install --path "$(cabal exec -- which plutus-game)"
+
+cabal exec -- plutus-pab all-servers --config plutus-pab.yaml