{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE FlexibleContexts   #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE GADTs              #-}
{-# LANGUAGE ImpredicativeTypes #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}
{-# LANGUAGE TypeFamilies       #-}
{-# LANGUAGE TypeOperators      #-}
{-# options_ghc -Wno-missing-signatures #-}

{-

Here we explicitly construct the database schema for the effects which we wish
to store:

- 'Pluts.PAB.Effects.Contract.ContractStore' effect
- 'Pluts.PAB.Effects.Contract.ContractDefinitionStore' effect

The schema we've opted for at present is a very simple one, with no ability to
track changes over time.

-}

module Plutus.PAB.Db.Schema where
import Data.Text (Text)
import Database.Beam
import Database.Beam.Migrate
import Database.Beam.Postgres (Postgres)
import Database.Beam.Sqlite (Sqlite)

data ContractInstanceT f
  = ContractInstance
    { ContractInstanceT f -> Columnar f Text
_contractInstanceId         :: Columnar f Text
    , ContractInstanceT f -> Columnar f Text
_contractInstanceContractId :: Columnar f Text
    , ContractInstanceT f -> Columnar f Text
_contractInstanceWallet     :: Columnar f Text -- Note: Sqlite doesn't have a integer type large enough.
    , ContractInstanceT f -> Columnar f (Maybe Text)
_contractInstanceState      :: Columnar f (Maybe Text)
    , ContractInstanceT f -> Columnar f Bool
_contractInstanceActive     :: Columnar f Bool
    } deriving ((forall x. ContractInstanceT f -> Rep (ContractInstanceT f) x)
-> (forall x. Rep (ContractInstanceT f) x -> ContractInstanceT f)
-> Generic (ContractInstanceT f)
forall x. Rep (ContractInstanceT f) x -> ContractInstanceT f
forall x. ContractInstanceT f -> Rep (ContractInstanceT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (ContractInstanceT f) x -> ContractInstanceT f
forall (f :: * -> *) x.
ContractInstanceT f -> Rep (ContractInstanceT f) x
$cto :: forall (f :: * -> *) x.
Rep (ContractInstanceT f) x -> ContractInstanceT f
$cfrom :: forall (f :: * -> *) x.
ContractInstanceT f -> Rep (ContractInstanceT f) x
Generic, TableSkeleton ContractInstanceT
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> ContractInstanceT f
 -> ContractInstanceT g
 -> m (ContractInstanceT h))
-> TableSkeleton ContractInstanceT -> Beamable ContractInstanceT
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> ContractInstanceT f
-> ContractInstanceT g
-> m (ContractInstanceT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
tblSkeleton :: TableSkeleton ContractInstanceT
$ctblSkeleton :: TableSkeleton ContractInstanceT
zipBeamFieldsM :: (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> ContractInstanceT f
-> ContractInstanceT g
-> m (ContractInstanceT h)
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> ContractInstanceT f
-> ContractInstanceT g
-> m (ContractInstanceT h)
Beamable)

ContractInstance
  (LensFor contractInstanceId)
  (LensFor contractInstanceContractId)
  (LensFor contractInstanceWallet)
  (LensFor contractInstanceState)
  (LensFor contractInstanceActive)
  = ContractInstanceT (Lenses ContractInstanceT f)
forall (lensType :: * -> *) (t :: (* -> *) -> *) (f :: * -> *).
(lensType ~ Lenses t f, Generic (t lensType), Generic (t f),
 GTableLenses t f (Rep (t f)) (Rep (t lensType))) =>
t (Lenses t f)
tableLenses

type ContractInstance   = ContractInstanceT Identity
type ContractInstanceId = PrimaryKey ContractInstanceT Identity

instance Table ContractInstanceT where
  data PrimaryKey ContractInstanceT f = ContractInstanceId (Columnar f Text) deriving ((forall x.
 PrimaryKey ContractInstanceT f
 -> Rep (PrimaryKey ContractInstanceT f) x)
-> (forall x.
    Rep (PrimaryKey ContractInstanceT f) x
    -> PrimaryKey ContractInstanceT f)
-> Generic (PrimaryKey ContractInstanceT f)
forall x.
Rep (PrimaryKey ContractInstanceT f) x
-> PrimaryKey ContractInstanceT f
forall x.
PrimaryKey ContractInstanceT f
-> Rep (PrimaryKey ContractInstanceT f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (PrimaryKey ContractInstanceT f) x
-> PrimaryKey ContractInstanceT f
forall (f :: * -> *) x.
PrimaryKey ContractInstanceT f
-> Rep (PrimaryKey ContractInstanceT f) x
$cto :: forall (f :: * -> *) x.
Rep (PrimaryKey ContractInstanceT f) x
-> PrimaryKey ContractInstanceT f
$cfrom :: forall (f :: * -> *) x.
PrimaryKey ContractInstanceT f
-> Rep (PrimaryKey ContractInstanceT f) x
Generic, TableSkeleton (PrimaryKey ContractInstanceT)
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> PrimaryKey ContractInstanceT f
 -> PrimaryKey ContractInstanceT g
 -> m (PrimaryKey ContractInstanceT h))
-> TableSkeleton (PrimaryKey ContractInstanceT)
-> Beamable (PrimaryKey ContractInstanceT)
forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey ContractInstanceT f
-> PrimaryKey ContractInstanceT g
-> m (PrimaryKey ContractInstanceT h)
forall (table :: (* -> *) -> *).
(forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
 Applicative m =>
 (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
 -> table f -> table g -> m (table h))
-> TableSkeleton table -> Beamable table
tblSkeleton :: TableSkeleton (PrimaryKey ContractInstanceT)
$ctblSkeleton :: TableSkeleton (PrimaryKey ContractInstanceT)
zipBeamFieldsM :: (forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey ContractInstanceT f
-> PrimaryKey ContractInstanceT g
-> m (PrimaryKey ContractInstanceT h)
$czipBeamFieldsM :: forall (m :: * -> *) (f :: * -> *) (g :: * -> *) (h :: * -> *).
Applicative m =>
(forall a. Columnar' f a -> Columnar' g a -> m (Columnar' h a))
-> PrimaryKey ContractInstanceT f
-> PrimaryKey ContractInstanceT g
-> m (PrimaryKey ContractInstanceT h)
Beamable)
  primaryKey :: ContractInstanceT column -> PrimaryKey ContractInstanceT column
primaryKey = Columnar column Text -> PrimaryKey ContractInstanceT column
forall (f :: * -> *).
Columnar f Text -> PrimaryKey ContractInstanceT f
ContractInstanceId (Columnar column Text -> PrimaryKey ContractInstanceT column)
-> (ContractInstanceT column -> Columnar column Text)
-> ContractInstanceT column
-> PrimaryKey ContractInstanceT column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractInstanceT column -> Columnar column Text
forall (f :: * -> *). ContractInstanceT f -> Columnar f Text
_contractInstanceId

data Db f = Db
    { Db f -> f (TableEntity ContractInstanceT)
_contractInstances :: f (TableEntity ContractInstanceT)
    }
    deriving ((forall x. Db f -> Rep (Db f) x)
-> (forall x. Rep (Db f) x -> Db f) -> Generic (Db f)
forall x. Rep (Db f) x -> Db f
forall x. Db f -> Rep (Db f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x. Rep (Db f) x -> Db f
forall (f :: * -> *) x. Db f -> Rep (Db f) x
$cto :: forall (f :: * -> *) x. Rep (Db f) x -> Db f
$cfrom :: forall (f :: * -> *) x. Db f -> Rep (Db f) x
Generic, Database be)

db :: DatabaseSettings be Db
db :: DatabaseSettings be Db
db = DatabaseSettings be Db
forall be (db :: (* -> *) -> *).
(Generic (DatabaseSettings be db),
 GAutoDbSettings (Rep (DatabaseSettings be db) ())) =>
DatabaseSettings be db
defaultDbSettings

checkedSqliteDb :: CheckedDatabaseSettings Sqlite Db
checkedSqliteDb :: CheckedDatabaseSettings Sqlite Db
checkedSqliteDb = CheckedDatabaseSettings Sqlite Db
forall be (db :: (* -> *) -> *).
(Generic (CheckedDatabaseSettings be db),
 GAutoMigratableDb be (Rep (CheckedDatabaseSettings be db))) =>
CheckedDatabaseSettings be db
defaultMigratableDbSettings

checkedPostgresDb :: CheckedDatabaseSettings Postgres Db
checkedPostgresDb :: CheckedDatabaseSettings Postgres Db
checkedPostgresDb = CheckedDatabaseSettings Postgres Db
forall be (db :: (* -> *) -> *).
(Generic (CheckedDatabaseSettings be db),
 GAutoMigratableDb be (Rep (CheckedDatabaseSettings be db))) =>
CheckedDatabaseSettings be db
defaultMigratableDbSettings