Skip to content

Commit 15e9556

Browse files
palaspalas
committed
Expose functions using C FFI for it to work in pure WASI
1 parent c111ca2 commit 15e9556

File tree

7 files changed

+342
-2
lines changed

7 files changed

+342
-2
lines changed

‎cardano-wasm/cardano-wasm.cabal‎

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -77,13 +77,22 @@ executable cardano-wasi
7777
if arch(wasm32)
7878
ghc-options:
7979
-no-hs-main
80-
-optl-mexec-model=reactor
81-
"-optl-Wl,--strip-all"
80+
"-optl-Wl,--strip-all,--export=hs_init,--export=newTx,--export=newExperimentalEraTx,--export=newConwayTx,--export=addTxInput,--export=addSimpleTxOut,--export=setFee,--export=estimateMinFee,--export=signWithPaymentKey,--export=alsoSignWithPaymentKey,--export=toCbor,--export=generatePaymentWallet,--export=restorePaymentWalletFromSigningKeyBech32,--export=restoreTestnetPaymentWalletFromSigningKeyBech32,--export=getAddressBech32,--export=getBech32ForVerificationKey,--export=getBech32ForSigningKey,--export=getBase16ForVerificationKeyHash,--export=mallocNBytes,--export=getStrLen,--export=freeMemory"
8281
other-modules:
82+
Cardano.Wasi.Internal.Api.GRPC
83+
Cardano.Wasi.Internal.Api.Memory
84+
Cardano.Wasi.Internal.Api.Tx
85+
Cardano.Wasi.Internal.Api.Wallet
86+
Cardano.Wasi.Internal.Conversion
87+
8388
build-depends:
89+
aeson,
8490
base,
91+
cardano-api,
8592
cardano-wasm:cardano-wasi-lib,
8693
optparse-applicative,
94+
text,
95+
utf8-string,
8796

8897
executable cardano-wasm
8998
import: project-config

‎cardano-wasm/src-lib/Cardano/Wasm/Api/Tx.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -9,6 +9,7 @@
99

1010
module Cardano.Wasm.Api.Tx
1111
( UnsignedTxObject (..)
12+
, SignedTxObject (..)
1213
, ProtocolParamsJSON (..)
1314
, newTxImpl
1415
, newExperimentalEraTxImpl

‎cardano-wasm/src-wasi/Cardano/Wasi/Internal/Api/GRPC.hs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
module Cardano.Wasi.Internal.Api.GRPC (module GRPC) where
2+
3+
import Cardano.Wasm.Api.GRPC as GRPC

‎cardano-wasm/src-wasi/Cardano/Wasi/Internal/Api/Memory.hs‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
module Cardano.Wasi.Internal.Api.Memory
4+
( mallocNBytes
5+
, getStrLen
6+
, freeMemory
7+
)
8+
where
9+
10+
import Foreign.C (CChar (..), CString)
11+
import Foreign.Marshal (free, lengthArray0, mallocBytes)
12+
import Foreign.Ptr (Ptr)
13+
14+
-- * Memory
15+
16+
#if defined(wasm32_HOST_ARCH)
17+
18+
foreign export ccall "mallocNBytes"
19+
mallocBytes :: Int -> IO (Ptr a)
20+
21+
foreign export ccall "getStrLen"
22+
getStrLen :: CString -> IO Int
23+
24+
foreign export ccall "freeMemory"
25+
freeMemory :: Ptr a -> IO ()
26+
27+
#endif
28+
29+
mallocNBytes :: Int -> IO (Ptr a)
30+
mallocNBytes = mallocBytes
31+
32+
getStrLen :: CString -> IO Int
33+
getStrLen = lengthArray0 (CChar 0)
34+
35+
freeMemory :: Ptr a -> IO ()
36+
freeMemory = free

‎cardano-wasm/src-wasi/Cardano/Wasi/Internal/Api/Tx.hs‎

Lines changed: 147 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,147 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
module Cardano.Wasi.Internal.Api.Tx
4+
( newTx
5+
, newExperimentalEraTx
6+
, newConwayTx
7+
, addTxInput
8+
, addSimpleTxOut
9+
, setFee
10+
, estimateMinFee
11+
, signWithPaymentKey
12+
, alsoSignWithPaymentKey
13+
, toCbor
14+
)
15+
where
16+
17+
import Cardano.Api qualified as Api
18+
19+
import Cardano.Wasi.Internal.Conversion
20+
( cstrToInt
21+
, fromCJSON
22+
, intToCStr
23+
, stringTosigningKey
24+
, toCJSON
25+
, txIdToString
26+
)
27+
import Cardano.Wasm.Api.Tx
28+
29+
import Control.Monad (join)
30+
31+
import Foreign.C (CString)
32+
import Foreign.C.String (newCString, peekCString)
33+
34+
-- * UnsignedTxObject
35+
36+
#if defined(wasm32_HOST_ARCH)
37+
38+
foreign export ccall "newTx"
39+
newTx :: IO UnsignedTxObjectJSON
40+
41+
foreign export ccall "newExperimentalEraTx"
42+
newExperimentalEraTx :: IO UnsignedTxObjectJSON
43+
44+
foreign export ccall "newConwayTx"
45+
newConwayTx :: IO UnsignedTxObjectJSON
46+
47+
foreign export ccall "addTxInput"
48+
addTxInput :: UnsignedTxObjectJSON -> CString -> Int -> IO UnsignedTxObjectJSON
49+
50+
foreign export ccall "addSimpleTxOut"
51+
addSimpleTxOut :: UnsignedTxObjectJSON -> CString -> CString -> IO UnsignedTxObjectJSON
52+
53+
foreign export ccall "setFee"
54+
setFee :: UnsignedTxObjectJSON -> CString -> IO UnsignedTxObjectJSON
55+
56+
foreign export ccall "estimateMinFee"
57+
estimateMinFee :: UnsignedTxObjectJSON -> CString -> Int -> Int -> Int -> IO CString
58+
59+
foreign export ccall "signWithPaymentKey"
60+
signWithPaymentKey :: UnsignedTxObjectJSON -> CString -> IO SignedTxObjectJSON
61+
62+
#endif
63+
64+
type UnsignedTxObjectJSON = CString
65+
66+
newTx :: IO UnsignedTxObjectJSON
67+
newTx = toCJSON newTxImpl
68+
69+
newExperimentalEraTx :: IO UnsignedTxObjectJSON
70+
newExperimentalEraTx = toCJSON =<< newExperimentalEraTxImpl
71+
72+
newConwayTx :: IO UnsignedTxObjectJSON
73+
newConwayTx = toCJSON newConwayTxImpl
74+
75+
addTxInput :: UnsignedTxObjectJSON -> CString -> Int -> IO UnsignedTxObjectJSON
76+
addTxInput unsignedTxObject txId txIx =
77+
toCJSON
78+
=<< ( addTxInputImpl
79+
<$> fromCJSON True "UnsignedTx" unsignedTxObject
80+
<*> txIdToString txId
81+
<*> pure (Api.TxIx (fromIntegral txIx))
82+
)
83+
84+
addSimpleTxOut :: UnsignedTxObjectJSON -> CString -> CString -> IO UnsignedTxObjectJSON
85+
addSimpleTxOut unsignedTxObject destAddr lovelaceAmountStr =
86+
toCJSON
87+
=<< join
88+
( addSimpleTxOutImpl
89+
<$> fromCJSON True "UnsignedTx" unsignedTxObject
90+
<*> peekCString destAddr
91+
<*> (Api.Coin <$> cstrToInt "Lovelace amount" lovelaceAmountStr)
92+
)
93+
94+
setFee :: UnsignedTxObjectJSON -> CString -> IO UnsignedTxObjectJSON
95+
setFee unsignedTxObject feeStr =
96+
toCJSON
97+
=<< ( setFeeImpl
98+
<$> fromCJSON True "UnsignedTx" unsignedTxObject
99+
<*> (Api.Coin <$> cstrToInt "fee" feeStr)
100+
)
101+
102+
estimateMinFee :: UnsignedTxObjectJSON -> CString -> Int -> Int -> Int -> IO CString
103+
estimateMinFee ptrUnsignedTxObject pparams numInputs numOutputs numShelleyKeyWitnesses = do
104+
(intToCStr . Api.unCoin)
105+
=<< join
106+
( estimateMinFeeImpl
107+
<$> fromCJSON False "UnsignedTx" ptrUnsignedTxObject
108+
<*> (ProtocolParamsJSON <$> fromCJSON False "ProtocolParameters" pparams)
109+
<*> pure (fromIntegral numInputs)
110+
<*> pure (fromIntegral numOutputs)
111+
<*> pure (fromIntegral numShelleyKeyWitnesses)
112+
)
113+
114+
signWithPaymentKey :: UnsignedTxObjectJSON -> CString -> IO SignedTxObjectJSON
115+
signWithPaymentKey unsignedTxObject signingKeyBech32 =
116+
toCJSON
117+
=<< ( signWithPaymentKeyImpl
118+
<$> fromCJSON True "UnsignedTx" unsignedTxObject
119+
<*> stringTosigningKey signingKeyBech32
120+
)
121+
122+
-- * SignedTxObject
123+
124+
#if defined(wasm32_HOST_ARCH)
125+
126+
foreign export ccall "alsoSignWithPaymentKey"
127+
alsoSignWithPaymentKey :: SignedTxObjectJSON -> CString -> IO SignedTxObjectJSON
128+
129+
foreign export ccall "toCbor"
130+
toCbor :: SignedTxObjectJSON -> IO CString
131+
132+
#endif
133+
134+
type SignedTxObjectJSON = CString
135+
136+
alsoSignWithPaymentKey :: SignedTxObjectJSON -> CString -> IO SignedTxObjectJSON
137+
alsoSignWithPaymentKey signedTxObject signingKeyBech32 =
138+
toCJSON
139+
=<< ( alsoSignWithPaymentKeyImpl
140+
<$> fromCJSON True "SignedTx" signedTxObject
141+
<*> stringTosigningKey signingKeyBech32
142+
)
143+
144+
toCbor :: SignedTxObjectJSON -> IO CString
145+
toCbor signedTxObject =
146+
newCString . toCborImpl
147+
=<< fromCJSON False "SignedTx" signedTxObject

‎cardano-wasm/src-wasi/Cardano/Wasi/Internal/Api/Wallet.hs‎

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
module Cardano.Wasi.Internal.Api.Wallet
4+
( generatePaymentWallet
5+
, restorePaymentWalletFromSigningKeyBech32
6+
, restoreTestnetPaymentWalletFromSigningKeyBech32
7+
, getAddressBech32
8+
, getBech32ForVerificationKey
9+
, getBech32ForSigningKey
10+
, getBase16ForVerificationKeyHash
11+
)
12+
where
13+
14+
import Cardano.Wasi.Internal.Conversion (fromCJSON, toCJSON)
15+
import Cardano.Wasm.Api.Wallet qualified as Wallet
16+
17+
import Foreign.C (CString)
18+
import Foreign.C.String (newCString, peekCString)
19+
20+
-- * WalletObject
21+
22+
#if defined(wasm32_HOST_ARCH)
23+
24+
foreign export ccall "generatePaymentWallet"
25+
generatePaymentWallet :: IO WalletObjectJSON
26+
27+
foreign export ccall "restorePaymentWalletFromSigningKeyBech32"
28+
restorePaymentWalletFromSigningKeyBech32 :: CString -> IO WalletObjectJSON
29+
30+
foreign export ccall "restoreTestnetPaymentWalletFromSigningKeyBech32"
31+
restoreTestnetPaymentWalletFromSigningKeyBech32 :: Int -> CString -> IO WalletObjectJSON
32+
33+
foreign export ccall "getAddressBech32"
34+
getAddressBech32 :: WalletObjectJSON -> IO CString
35+
36+
foreign export ccall "getBech32ForVerificationKey"
37+
getBech32ForVerificationKey :: WalletObjectJSON -> IO CString
38+
39+
foreign export ccall "getBech32ForSigningKey"
40+
getBech32ForSigningKey :: WalletObjectJSON -> IO CString
41+
42+
foreign export ccall "getBase16ForVerificationKeyHash"
43+
getBase16ForVerificationKeyHash :: WalletObjectJSON -> IO CString
44+
45+
#endif
46+
47+
type WalletObjectJSON = CString
48+
49+
generatePaymentWallet :: IO WalletObjectJSON
50+
generatePaymentWallet = toCJSON =<< Wallet.generatePaymentWalletImpl
51+
52+
restorePaymentWalletFromSigningKeyBech32 :: CString -> IO WalletObjectJSON
53+
restorePaymentWalletFromSigningKeyBech32 signingKeyBech32CStr = do
54+
signingKeyBech32 <- peekCString signingKeyBech32CStr
55+
toCJSON =<< Wallet.restorePaymentWalletFromSigningKeyBech32Impl signingKeyBech32
56+
57+
restoreTestnetPaymentWalletFromSigningKeyBech32 :: Int -> CString -> IO WalletObjectJSON
58+
restoreTestnetPaymentWalletFromSigningKeyBech32 networkMagic signingKeyBech32CStr =
59+
toCJSON
60+
=<< ( Wallet.restoreTestnetPaymentWalletFromSigningKeyBech32Impl
61+
(fromIntegral networkMagic)
62+
=<< peekCString signingKeyBech32CStr
63+
)
64+
65+
getAddressBech32 :: WalletObjectJSON -> IO CString
66+
getAddressBech32 walletCStr =
67+
newCString . Wallet.getAddressBech32
68+
=<< fromCJSON False "WalletObject" walletCStr
69+
70+
getBech32ForVerificationKey :: WalletObjectJSON -> IO CString
71+
getBech32ForVerificationKey walletCStr =
72+
newCString . Wallet.getBech32ForVerificationKeyImpl
73+
=<< fromCJSON False "WalletObject" walletCStr
74+
75+
getBech32ForSigningKey :: WalletObjectJSON -> IO CString
76+
getBech32ForSigningKey walletCStr =
77+
newCString . Wallet.getBech32ForSigningKeyImpl
78+
=<< fromCJSON False "WalletObject" walletCStr
79+
80+
getBase16ForVerificationKeyHash :: WalletObjectJSON -> IO CString
81+
getBase16ForVerificationKeyHash walletCStr =
82+
newCString . Wallet.getBase16ForVerificationKeyHashImpl
83+
=<< fromCJSON False "WalletObject" walletCStr

‎cardano-wasm/src-wasi/Cardano/Wasi/Internal/Conversion.hs‎

Lines changed: 61 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,61 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
module Cardano.Wasi.Internal.Conversion
4+
( toCJSON
5+
, fromCJSON
6+
, intToCStr
7+
, cstrToInt
8+
, txIdToString
9+
, stringTosigningKey
10+
)
11+
where
12+
13+
import Cardano.Api qualified as Api
14+
15+
import Cardano.Wasm.ExceptionHandling (justOrError, rightOrError)
16+
17+
import Data.Aeson qualified as Aeson
18+
import Data.ByteString.UTF8 qualified as BS
19+
import Data.String (fromString)
20+
import Data.Text qualified as Text
21+
import GHC.Base (when)
22+
import Text.Read (readMaybe)
23+
24+
import Foreign.C (CString)
25+
import Foreign.C.String (newCString, peekCString)
26+
import Foreign.Marshal (free)
27+
28+
toCJSON :: Api.ToJSON a => a -> IO CString
29+
toCJSON x = newCString $ BS.toString $ Api.serialiseToJSON x
30+
31+
fromCJSON :: Api.FromJSON a => Bool -> String -> CString -> IO a
32+
fromCJSON shouldFree expectedType cstr = do
33+
str <- peekCString cstr
34+
when shouldFree $ free cstr
35+
case Aeson.eitherDecodeStrict' (BS.fromString str) of
36+
Left err ->
37+
error
38+
( "Wrong format for argument when decoding JSON for parameter of type "
39+
++ expectedType
40+
++ ": "
41+
++ show (Api.JsonDecodeError err)
42+
)
43+
Right a -> return a
44+
45+
intToCStr :: Integer -> IO CString
46+
intToCStr = newCString . show
47+
48+
cstrToInt :: String -> CString -> IO Integer
49+
cstrToInt paramName cstr = do
50+
str <- peekCString cstr
51+
justOrError ("Could not parse " ++ paramName ++ " as an integer number") $ readMaybe str
52+
53+
txIdToString :: CString -> IO Api.TxId
54+
txIdToString txIdCString = do
55+
txId <- peekCString txIdCString
56+
rightOrError $ Api.deserialiseFromRawBytesHex (fromString txId)
57+
58+
stringTosigningKey :: CString -> IO (Api.SigningKey Api.PaymentKey)
59+
stringTosigningKey signingKeyCString = do
60+
string <- peekCString signingKeyCString
61+
rightOrError $ Api.deserialiseFromBech32 (Text.pack string)

0 commit comments

Comments
 (0)