Currently, the ts-sdk hasn't implemented all the features available in the Runtime Rest API. This is the goal of 1-1 feature parity with marlowe-runtime-web
(runtime) v0.0.5.1. This issue only focus on the Open Roles Feature and not on having a feature complete Contract Creation.
-- | POST /contracts sub-API
type PostContractsAPI =
Summary "Create a new contract"
:> Description
"Build an unsigned (Cardano) transaction body which opens a new Marlowe contract. \
\This unsigned transaction must be signed by a wallet (such as a CIP-30 or CIP-45 wallet) before being submitted. \
\To submit the signed transaction, use the PUT /contracts/{contractId} endpoint."
:> OperationId "createContract"
:> RenameResponseSchema "CreateContractResponse"
:> Header'
'[Optional, Strict, Description "Where to send staking rewards for the Marlowe script outputs of this contract."]
"X-Stake-Address"
StakeAddress
:> ( ReqBody '[JSON] PostContractsRequest :> PostTxAPI (PostCreated '[JSON] (PostContractsResponse CardanoTxBody))
:<|> ReqBody '[JSON] PostContractsRequest :> PostTxAPI (PostCreated '[TxJSON ContractTx] (PostContractsResponse CardanoTx))
)
data PostContractsRequest = PostContractsRequest
{ tags :: Map Text Metadata
, metadata :: Map Word64 Metadata
, version :: MarloweVersion
, roles :: Maybe RolesConfig
, threadTokenName :: Maybe Text
, contract :: ContractOrSourceId
, minUTxODeposit :: Maybe Word64
}
deriving (Show, Eq, Ord, Generic)
newtype ContractOrSourceId = ContractOrSourceId (Either Semantics.Contract ContractSourceId)
deriving (Show, Eq, Ord, Generic)
newtype ContractSourceId = ContractSourceId {unContractSourceId :: ByteString}
deriving (Eq, Ord, Generic)
deriving (Show, ToHttpApiData, ToJSON) via Base16
data RolesConfig
= UsePolicy PolicyId
| UsePolicyWithOpenRoles PolicyId [Text]
| Mint (Map Text RoleTokenConfig)
deriving (Show, Eq, Ord, Generic)
instance FromJSON RolesConfig where
parseJSON (String s) = UsePolicy <$> parseJSON (String s)
parseJSON value =
withObject
"RolesConfig"
( \obj ->
let parseMint = Mint <$> parseJSON value
parseOpen =
do
script <- obj .: "script"
unless (script == ("OpenRole" :: String)) $ fail "AllowedValues: \"OpenRole\""
UsePolicyWithOpenRoles <$> obj .: "policyId" <*> obj .: "openRoleNames"
in parseOpen <|> parseMint
)
value
data RoleTokenConfig = RoleTokenConfig
{ recipients :: RoleTokenRecipients
, metadata :: Maybe TokenMetadata
}
deriving (Show, Eq, Ord, Generic)
type RoleTokenRecipients = Map RoleTokenRecipient Word64
data RoleTokenRecipient
= ClosedRole Address
| OpenRole
deriving (Show, Eq, Ord, Generic)
instance FromJSON RoleTokenConfig where
parseJSON (String "OpenRole") =
pure
. flip RoleTokenConfig Nothing
$ Map.singleton OpenRole 1
parseJSON (String s) =
pure
. flip RoleTokenConfig Nothing
. flip Map.singleton 1
. ClosedRole
$ Address s
parseJSON value =
withObject
"RoleTokenConfig"
( \obj -> do
mRecipients <- obj .:? "recipients"
mAddress <- obj .:? "address"
mScriptRole <- do
mScript :: Maybe String <- obj .:? "script"
for mScript \case
"OpenRole" -> pure OpenRole
_ -> fail "Expected \'OpenRole\""
metadata <- obj .:? "metadata"
recipients <- case (mRecipients, mAddress, mScriptRole) of
(Just recipients, _, _) -> pure recipients
(_, Just address, _) -> pure $ Map.singleton (ClosedRole address) 1
(_, _, Just scriptRole) -> pure $ Map.singleton scriptRole 1
_ -> fail "one of recipients, address, or script required"
pure RoleTokenConfig{..}
)
value
instance ToJSON RoleTokenConfig where
toJSON (RoleTokenConfig recipients metadata) =
object
[ "recipients" .= recipients
, "metadata" .= metadata
]
data TokenMetadata = TokenMetadata
{ name :: Text
, image :: URI
, mediaType :: Maybe Text
, description :: Maybe Text
, files :: Maybe [TokenMetadataFile]
}
deriving (Show, Eq, Ord, Generic)