feature: modulized selected orphans

sidan-lab · Nov 22, 2022 · eb4c50e · eb4c50e
1 parent 855ff4c
commit eb4c50e
Show file tree

Hide file tree

Showing 10 changed files with 253 additions and 87 deletions.
diff --git a/example/gimbalabs-example.cabal b/example/gimbalabs-example.cabal
@@ -20,7 +20,10 @@ library
                     , ContributorToken.ReferenceValidator
                     , ContributorToken.Compiler
                     , ContributorToken.Types
-                  --   , DevelopmentSourceCode
+
+                    , Dev.DevPlutusServer
+                    , Dev.DevInstances
+                    , Dev.DevDefaultOrphans
 
    build-depends:     aeson
                     , base ^>=4.14.1.0

diff --git a/example/src/ContributorToken/Types.hs b/example/src/ContributorToken/Types.hs
@@ -21,7 +21,7 @@ import              PlutusTx.Prelude    hiding  (Semigroup (..), unless)
 import              Prelude                     (Show (..))
 import  qualified   Prelude                 as  Pr
 import              Data.Aeson                  (FromJSON, ToJSON)
-import              SIDANPlutusServer
+import              Dev.DevDefaultOrphans()
 
 -- ReferenceParams
 data ReferenceParams = ReferenceParams

diff --git a/example/src/Dev/DevDefaultOrphans.hs b/example/src/Dev/DevDefaultOrphans.hs
@@ -0,0 +1,5 @@
+module Dev.DevDefaultOrphans where
+
+import           Ledger.Builtins.Orphans
+import           Ledger.Credential.Orphans
+import           Ledger.Value.Orphans
diff --git a/example/dev/DevelopmentSourceCode.hs → example/src/Dev/DevInstances.hs b/example/dev/DevelopmentSourceCode.hs → example/src/Dev/DevInstances.hs
@@ -1,85 +1,14 @@
-{-# LANGUAGE GADTs             #-}
-{-# LANGUAGE TypeApplications  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module DevelopmentSourceCode (
-  Api,
-  createServer,
-  createEndpoint,
-  mkV1Validator,
-  mkV2Validator,
-  mkV1MintingPolicy,
-  mkV2MintingPolicy
-) where
-
-import           Cardano.Api                       as API
-import qualified Cardano.Api.SerialiseTextEnvelope as SAPI
-import           Cardano.Api.Shelley               (PlutusScript (..))
-import           Codec.Serialise                   (serialise)
-import qualified Data.ByteString.Lazy              as LBS
-import qualified Data.ByteString.Short             as SBS
-import           Data.HVect                        hiding (pack)
-import           Data.Text                         (pack)
-import qualified Plutus.V1.Ledger.Scripts          as PlutusV1
-import qualified Plutus.V2.Ledger.Api              as PlutusV2
-import           Web.Spock
-import           Web.Spock.Config
+module Dev.DevInstances where
 
 -- Below import for JSON instances implementations
 import qualified Plutus.V1.Ledger.Value            as PlutusV1
+import qualified Plutus.V2.Ledger.Api              as PlutusV2
 import           Data.Aeson ((.:), (.:?), (.=), parseJSON, withObject, toJSON, toEncoding, object, pairs, ToJSON, FromJSON)
 import           Ledger.Builtins.Orphans
 import           Cardano.Ledger.Crypto
 
-type Api = SpockM () () () ()
-
-createServer :: Web.Spock.SpockM () () () () -> IO ()
-createServer app = do
-  spockCfg <- defaultSpockCfg () PCNoDatabase ()
-  runSpock 8080 (spock spockCfg app)
-
-createEndpoint :: Data.HVect.HasRep xs =>
-     Path xs ps
-     -> Data.HVect.HVectElim xs (SpockActionCtx ctx conn sess st ())
-     -> SpockCtxM ctx conn sess st ()
-createEndpoint path = do post path
-
--- Validator
-
-writeV1Validator :: PlutusV1.Validator -> LBS.ByteString
-writeV1Validator = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV1) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV1.unValidatorScript
-
-mkV1Validator :: (FromJSON a, ToJSON a) => (a -> PlutusV1.Validator) -> ActionCtxT () (WebStateM () () ()) b
-mkV1Validator val = do
-    scriptParam <- jsonBody'
-    json $ pack $ show $ writeV1Validator $ val scriptParam
-
-writeV2Validator :: PlutusV2.Validator -> LBS.ByteString
-writeV2Validator = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV2) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV2.unValidatorScript
-
-mkV2Validator :: (FromJSON a, ToJSON a) => (a -> PlutusV2.Validator) -> ActionCtxT () (WebStateM () () ()) b
-mkV2Validator val = do
-    scriptParam <- jsonBody'
-    json $ pack $ show $ writeV2Validator $ val scriptParam
-
--- Minting Policy
-
-writeV1MintingPolicy :: PlutusV1.MintingPolicy -> LBS.ByteString
-writeV1MintingPolicy  = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV1) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV1.getMintingPolicy
-
-mkV1MintingPolicy :: (FromJSON a, ToJSON a) => (a -> PlutusV2.MintingPolicy) -> ActionCtxT () (WebStateM () () ()) b
-mkV1MintingPolicy val = do
-    scriptParam <- jsonBody'
-    json $ pack $ show $ writeV1MintingPolicy $ val scriptParam
-
-writeV2MintingPolicy :: PlutusV2.MintingPolicy -> LBS.ByteString
-writeV2MintingPolicy  = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV2) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV2.getMintingPolicy
-
-mkV2MintingPolicy :: (FromJSON a, ToJSON a) => (a -> PlutusV2.MintingPolicy) -> ActionCtxT () (WebStateM () () ()) b
-mkV2MintingPolicy val = do
-    scriptParam <- jsonBody'
-    json $ pack $ show $ writeV2MintingPolicy $ val scriptParam
-
 -- JSON Instances
 
 instance FromJSON PlutusV2.CurrencySymbol where
@@ -209,5 +138,4 @@ instance ToJSON PlutusV2.StakingCredential where
     toEncoding (PlutusV2.StakingHash sh) =
         pairs ("StakingHash" .= sh)
     toEncoding (PlutusV2.StakingPtr int1 int2 int3) =
-        pairs ("StakingPtr" .= [int1, int2, int3])
-
+        pairs ("StakingPtr" .= [int1, int2, int3])
diff --git a/example/src/Dev/DevPlutusServer.hs b/example/src/Dev/DevPlutusServer.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE GADTs             #-}
+{-# LANGUAGE TypeApplications  #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Dev.DevPlutusServer (
+  Api,
+  createServer,
+  createEndpoint,
+  mkV1Validator,
+  mkV2Validator,
+  mkV1MintingPolicy,
+  mkV2MintingPolicy
+) where
+
+import           Cardano.Api                       as API
+import qualified Cardano.Api.SerialiseTextEnvelope as SAPI
+import           Cardano.Api.Shelley               (PlutusScript (..))
+import           Codec.Serialise                   (serialise)
+import qualified Data.ByteString.Lazy              as LBS
+import qualified Data.ByteString.Short             as SBS
+import           Data.HVect                        hiding (pack)
+import           Data.Text                         (pack)
+import qualified Plutus.V1.Ledger.Scripts          as PlutusV1
+import qualified Plutus.V2.Ledger.Api              as PlutusV2
+import           Web.Spock
+import           Web.Spock.Config
+
+type Api = SpockM () () () ()
+
+createServer :: Web.Spock.SpockM () () () () -> IO ()
+createServer app = do
+  spockCfg <- defaultSpockCfg () PCNoDatabase ()
+  runSpock 8080 (spock spockCfg app)
+
+createEndpoint :: Data.HVect.HasRep xs =>
+     Path xs ps
+     -> Data.HVect.HVectElim xs (SpockActionCtx ctx conn sess st ())
+     -> SpockCtxM ctx conn sess st ()
+createEndpoint path = do post path
+
+-- Validator
+
+writeV1Validator :: PlutusV1.Validator -> LBS.ByteString
+writeV1Validator = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV1) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV1.unValidatorScript
+
+mkV1Validator :: (FromJSON a, ToJSON a) => (a -> PlutusV1.Validator) -> ActionCtxT () (WebStateM () () ()) b
+mkV1Validator val = do
+    scriptParam <- jsonBody'
+    json $ pack $ show $ writeV1Validator $ val scriptParam
+
+writeV2Validator :: PlutusV2.Validator -> LBS.ByteString
+writeV2Validator = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV2) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV2.unValidatorScript
+
+mkV2Validator :: (FromJSON a, ToJSON a) => (a -> PlutusV2.Validator) -> ActionCtxT () (WebStateM () () ()) b
+mkV2Validator val = do
+    scriptParam <- jsonBody'
+    json $ pack $ show $ writeV2Validator $ val scriptParam
+
+-- Minting Policy
+
+writeV1MintingPolicy :: PlutusV1.MintingPolicy -> LBS.ByteString
+writeV1MintingPolicy  = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV1) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV1.getMintingPolicy
+
+mkV1MintingPolicy :: (FromJSON a, ToJSON a) => (a -> PlutusV2.MintingPolicy) -> ActionCtxT () (WebStateM () () ()) b
+mkV1MintingPolicy val = do
+    scriptParam <- jsonBody'
+    json $ pack $ show $ writeV1MintingPolicy $ val scriptParam
+
+writeV2MintingPolicy :: PlutusV2.MintingPolicy -> LBS.ByteString
+writeV2MintingPolicy  = SAPI.textEnvelopeToJSON @(PlutusScript PlutusScriptV2) Nothing . PlutusScriptSerialised . SBS.toShort . LBS.toStrict . serialise . PlutusV2.getMintingPolicy
+
+mkV2MintingPolicy :: (FromJSON a, ToJSON a) => (a -> PlutusV2.MintingPolicy) -> ActionCtxT () (WebStateM () () ()) b
+mkV2MintingPolicy val = do
+    scriptParam <- jsonBody'
+    json $ pack $ show $ writeV2MintingPolicy $ val scriptParam
diff --git a/example/src/ParamScriptAPI.hs b/example/src/ParamScriptAPI.hs
@@ -2,7 +2,8 @@
 
 module ParamScriptAPI where
 
--- import           TestingValidator
+import qualified TestingValidator    as TV
+
 import qualified SIDANPlutusServer   as SIDAN
 import qualified ContributorToken.ReferenceValidator as CTRV
 
@@ -11,6 +12,6 @@ main = SIDAN.createServer app
 
 app :: SIDAN.Api
 app = do
-  SIDAN.createEndpoint "validatorV1" $ SIDAN.mkV1Validator validator
+  SIDAN.createEndpoint "validatorV1" $ SIDAN.mkV1Validator TV.validator
   SIDAN.createEndpoint "contributor-token" $ SIDAN.mkV2Validator CTRV.validator
 
diff --git a/example/src/TestingValidator.hs b/example/src/TestingValidator.hs
@@ -27,7 +27,7 @@ import Prelude (IO, Semigroup (..), Show (..), String)
 import Ledger (POSIXTime, to, from, contains)
 import Ledger.Address (PaymentPubKeyHash, Address, unPaymentPubKeyHash)
 import Ledger.Ada as Ada
-import Ledger.Value
+-- import Ledger.Value
 import qualified Plutus.Script.Utils.V1.Typed.Scripts.Validators as Scripts
 import qualified Plutus.Script.Utils.V1.Scripts as Scripts
 import qualified Plutus.V1.Ledger.Scripts as Plutus
@@ -41,20 +41,26 @@ import Text.Printf (printf)
 import Data.Bool (Bool(True))
 import Playground.Contract (ToSchema)
 
+import qualified Plutus.V1.Ledger.Value            as PlutusV1
+import qualified Plutus.V2.Ledger.Api              as PlutusV2
+-- import DevelopmentSourceCode
+
 data TestParam = TestParam {
+  testTN     :: PlutusV2.TokenName,
+  testCS     :: PlutusV2.CurrencySymbol,
+  testAC     :: PlutusV1.AssetClass,
+  testTime   :: PlutusV2.POSIXTime,
+  testAddr   :: PlutusV2.Address,
+  testPkh    :: PlutusV2.PubKeyHash,
+  testVH     :: PlutusV2.ValidatorHash,
+  testSC     :: PlutusV2.StakingCredential,
   testNumber :: Integer,
   testPpkh   :: PaymentPubKeyHash
-  }
-  deriving (Show, Generic, FromJSON, ToJSON)
+} deriving (Show, Generic, FromJSON, ToJSON)
 
 PlutusTx.makeLift ''TestParam
 PlutusTx.makeIsDataIndexed ''TestParam [('TestParam,0)]
 
--- data TestDatum
---   = TestDatum Integer Integer Integer
---   deriving (Show, Generic, FromJSON, ToJSON)
-
--- PlutusTx.makeIsDataIndexed ''TestDatum [('TestDatum,0)]
 
 {-# INLINEABLE mkValidator #-}
 mkValidator :: TestParam -> Integer -> () -> Plutus.ScriptContext -> Bool

diff --git a/sidan-plutus-server.cabal b/sidan-plutus-server.cabal
@@ -21,6 +21,8 @@ common common-all
 library
    import:            common-all                   
    exposed-modules:   SIDANPlutusServer
+                    , SIDANDefaultOrphans
+                    , SIDANInstances
    hs-source-dirs:    src
    build-depends:     aeson
                     , base ^>=4.14.1.0

diff --git a/src/SIDANDefaultOrphans.hs b/src/SIDANDefaultOrphans.hs
@@ -0,0 +1,5 @@
+module SIDANDefaultOrphans where
+
+import           Ledger.Builtins.Orphans
+import           Ledger.Credential.Orphans
+import           Ledger.Value.Orphans