Skip to content
This repository was archived by the owner on Aug 18, 2020. It is now read-only.

Commit f28315d

Browse files
author
Ben Ford
committed
Get faucet working
1 parent de44e50 commit f28315d

File tree

6 files changed

+144
-50
lines changed

6 files changed

+144
-50
lines changed

‎faucet/cardano-sl-faucet.cabal‎

Lines changed: 13 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -20,20 +20,29 @@ extra-source-files:
2020
library
2121
hs-source-dirs:
2222
src
23-
build-depends: base
23+
build-depends: QuickCheck
2424
, aeson
25+
, base
26+
, base16-bytestring
27+
, bytestring
2528
, cardano-sl-core
29+
, cardano-sl-crypto
2630
, cardano-sl-wallet
2731
, cardano-sl-wallet-new
32+
, connection
33+
, cryptonite
34+
, data-default
2835
, ekg-core
2936
, ekg-statsd
3037
, exceptions
3138
, http-client
39+
, http-client-tls
3240
, lens
3341
, log-warper
42+
, memory
3443
, mmorph
3544
, mtl
36-
, QuickCheck
45+
, serokell-util
3746
, servant
3847
, servant-client
3948
, servant-client-core
@@ -42,6 +51,8 @@ library
4251
, servant-swagger-ui
4352
, swagger2
4453
, text
54+
, text-format
55+
, tls
4556
exposed-modules:
4657
Cardano.Faucet
4758
, Cardano.Faucet.Types

‎faucet/default.nix‎

Lines changed: 15 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,9 +1,12 @@
1-
{ mkDerivation, aeson, base, cardano-sl-core, cardano-sl-wallet
2-
, cardano-sl-wallet-new, ekg, ekg-core, ekg-statsd, exceptions
3-
, http-client, lens, log-warper, mmorph, mtl, optparse-applicative
4-
, QuickCheck, servant, servant-client, servant-client-core
5-
, servant-server, servant-swagger, servant-swagger-ui, stdenv
6-
, swagger2, text, wai, wai-cors, wai-extra, warp
1+
{ mkDerivation, aeson, base, base16-bytestring, bytestring
2+
, cardano-sl-core, cardano-sl-crypto, cardano-sl-wallet
3+
, cardano-sl-wallet-new, connection, cryptonite, data-default, ekg
4+
, ekg-core, ekg-statsd, exceptions, http-client, http-client-tls
5+
, lens, log-warper, memory, mmorph, mtl, optparse-applicative
6+
, QuickCheck, serokell-util, servant, servant-client
7+
, servant-client-core, servant-server, servant-swagger
8+
, servant-swagger-ui, stdenv, swagger2, text, text-format, tls, wai
9+
, wai-cors, wai-extra, warp
710
}:
811
mkDerivation {
912
pname = "cardano-sl-faucet";
@@ -12,10 +15,13 @@ mkDerivation {
1215
isLibrary = true;
1316
isExecutable = true;
1417
libraryHaskellDepends = [
15-
aeson base cardano-sl-core cardano-sl-wallet cardano-sl-wallet-new
16-
ekg-core ekg-statsd exceptions http-client lens log-warper mmorph
17-
mtl QuickCheck servant servant-client servant-client-core
18+
aeson base base16-bytestring bytestring cardano-sl-core
19+
cardano-sl-crypto cardano-sl-wallet cardano-sl-wallet-new
20+
connection cryptonite data-default ekg-core ekg-statsd exceptions
21+
http-client http-client-tls lens log-warper memory mmorph mtl
22+
QuickCheck serokell-util servant servant-client servant-client-core
1823
servant-server servant-swagger servant-swagger-ui swagger2 text
24+
text-format tls
1925
];
2026
executableHaskellDepends = [
2127
base cardano-sl-core cardano-sl-wallet cardano-sl-wallet-new ekg

‎faucet/server/Main.hs‎

Lines changed: 3 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -8,17 +8,15 @@ import Network.Wai.Handler.Warp (run)
88
import Servant
99

1010
import Control.Monad.Except
11-
import Cardano.Wallet.API.V1.Types (PaymentSource (..), WalletId(..), AccountIndex)
11+
-- import Cardano.Wallet.API.V1.Types (PaymentSource (..), WalletId(..), AccountIndex)
1212
import Cardano.Faucet
1313
import System.Remote.Monitoring (forkServer, serverMetricStore)
14-
import System.Remote.Monitoring.Statsd (defaultStatsdOptions, forkStatsd)
14+
import System.Remote.Monitoring.Statsd (forkStatsd)
1515

1616
main :: IO ()
1717
main = do
1818
ekg <- forkServer "localhost" 8001
19-
let w = WalletId "test"
20-
idx = 0
21-
c = mkFaucetConfig "wallet-url" 8000 (PaymentSource w idx) defaultStatsdOptions "./logging.cfg"
19+
let c = testFC -- mkFaucetConfig "wallet-url" 8000 (PaymentSource w idx) defaultStatsdOptions "./logging.cfg"
2220
fEnv <- initEnv c (serverMetricStore ekg)
2321
_statsd <- forkStatsd (c ^. fcStatsdOpts) (fEnv ^. feStore)
2422
run 8081 (serve serverAPI $ s fEnv)

‎faucet/src/Cardano/Faucet.hs‎

Lines changed: 15 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,8 @@ import System.Wlog (HasLoggerName, LoggerName (..), WithLogger, logErr
1818
withSublogger)
1919

2020
import Pos.Core (Address (..))
21-
import Cardano.Wallet.API.V1.Types (V1(..))
21+
import Cardano.Wallet.API.V1.Types (V1(..), unV1)
22+
import Cardano.Wallet.API.Response (WalletResponse(..))
2223
import Cardano.Faucet.Types
2324
import qualified Cardano.WalletClient as Client
2425
-- import Client.Cardano.Wallet.Web.Run (runEndpointClient)
@@ -28,14 +29,19 @@ type API = "withdraw" :> ReqBody '[JSON] WithDrawlRequest :> Post '[JSON] WithDr
2829

2930
withdraw :: (MonadFaucet c m) => WithDrawlRequest -> m WithDrawlResult
3031
withdraw wd = withSublogger (LoggerName "withdraw") $ do
31-
resp <- Client.withdraw addr (wd ^. wAmount . to V1)
32-
incWithDrawn (wd ^. wAmount)
33-
logInfo ((wd ^. to show . packed) <> " withdrawn")
34-
return WithDrawlResult
35-
where
36-
addr :: V1 Address
37-
-- TODO: What goes here?
38-
addr = _
32+
resp <- Client.withdraw (wd ^. wAddress) (wd ^. wAmount)
33+
case resp of
34+
Left err -> do
35+
logError ("Error withdrawing " <> (wd ^. to show . packed)
36+
<> " error: "
37+
<> (err ^. to show . packed))
38+
return $ WithdrawlError err
39+
Right wr -> do
40+
let txn = wrData wr
41+
logInfo ((wd ^. to show . packed) <> " withdrawn. txn: "
42+
<> (txn ^. to show . packed))
43+
incWithDrawn (wd ^. wAmount . to unV1)
44+
return $ WithdrawlSuccess txn
3945

4046
deposit :: (MonadFaucet c m) => DepositRequest -> m DepositResult
4147
deposit dr = withSublogger (LoggerName "deposit") $ do

‎faucet/src/Cardano/Faucet/Types.hs‎

Lines changed: 76 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,20 @@
1+
{-# LANGUAGE ConstraintKinds #-}
12
{-# LANGUAGE DeriveGeneric #-}
2-
{-# LANGUAGE ConstraintKinds #-}
33
{-# LANGUAGE DuplicateRecordFields #-}
44
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
55
{-# LANGUAGE OverloadedStrings #-}
66
{-# LANGUAGE TemplateHaskell #-}
77
{-# LANGUAGE ViewPatterns #-}
88
{-# OPTIONS_GHC -Wall #-}
99
module Cardano.Faucet.Types (
10-
FaucetConfig(..), mkFaucetConfig
10+
FaucetConfig(..), mkFaucetConfig, testFC
1111
, HasFaucetConfig(..)
1212
, FaucetEnv(..), initEnv
1313
, HasFaucetEnv(..)
1414
, incWithDrawn
1515
, decrWithDrawn
1616
, setWalletBalance
17-
, WithDrawlRequest(..), wWalletId, wAmount
17+
, WithDrawlRequest(..), wAddress, wAmount
1818
, WithDrawlResult(..)
1919
, DepositRequest(..), dWalletId, dAmount
2020
, DepositResult(..)
@@ -26,47 +26,64 @@ import Control.Lens hiding ((.=))
2626
import Control.Monad.Except
2727
import Control.Monad.Reader
2828
import Data.Aeson (FromJSON (..), ToJSON (..), object, withObject, (.:), (.=))
29-
import Data.Text (Text)
29+
import qualified Data.ByteString as BS
30+
import Data.Default (def)
31+
import Data.Monoid ((<>))
32+
import Data.Text (Text)
33+
import Data.Text.Lens (packed)
3034
import Data.Typeable (Typeable)
3135
import GHC.Generics (Generic)
36+
import Network.Connection (TLSSettings (..))
37+
import Network.HTTP.Client (Manager, newManager)
38+
import Network.HTTP.Client.TLS (mkManagerSettings)
39+
import Network.TLS (ClientParams (..), credentialLoadX509FromMemory, defaultParamsClient,
40+
onCertificateRequest, onServerCertificate, supportedCiphers)
41+
import Network.TLS.Extra.Cipher (ciphersuite_all)
3242
import Servant (ServantErr)
3343
import Servant.Client.Core (BaseUrl (..), Scheme (..))
3444
import System.Metrics (Store, createCounter, createGauge)
3545
import System.Metrics.Counter (Counter)
3646
import qualified System.Metrics.Counter as Counter
3747
import System.Metrics.Gauge (Gauge)
3848
import qualified System.Metrics.Gauge as Gauge
39-
import System.Remote.Monitoring.Statsd (StatsdOptions)
40-
import System.Wlog (CanLog, WithLogger, HasLoggerName, LoggerName (..), LoggerNameBox (..),
41-
launchFromFile)
49+
import System.Remote.Monitoring.Statsd (StatsdOptions, defaultStatsdOptions)
50+
import System.Wlog (CanLog, HasLoggerName, LoggerName (..), LoggerNameBox (..),
51+
WithLogger, launchFromFile)
4252

43-
import Cardano.Wallet.API.V1.Types (PaymentSource (..))
44-
import Cardano.Wallet.Client (WalletClient)
45-
import Cardano.Wallet.Client.Http (defaultManagerSettings, mkHttpClient, newManager)
46-
import Pos.Core (Coin (..))
47-
import Pos.Wallet.Web.ClientTypes.Types (Addr (..), CAccountId (..), CId (..))
53+
import Cardano.Wallet.API.V1.Types (PaymentSource (..), Transaction,
54+
V1, WalletId (..))
55+
import Cardano.Wallet.Client (ClientError (..), WalletClient)
56+
import Cardano.Wallet.Client.Http (mkHttpClient)
57+
import Pos.Core (Address (..), Coin (..))
58+
--
4859

4960
--------------------------------------------------------------------------------
5061
data WithDrawlRequest = WithDrawlRequest {
51-
_wWalletId :: Text -- Pos.Wallet.Web.ClientTypes.Types.CAccountId
52-
, _wAmount :: Coin -- Pos.Core.Common.Types.Coin
62+
_wAddress :: V1 Address -- Pos.Wallet.Web.ClientTypes.Types.CAccountId
63+
, _wAmount :: V1 Coin -- Pos.Core.Common.Types.Coin
5364
} deriving (Show, Typeable, Generic)
5465

5566
makeLenses ''WithDrawlRequest
5667

5768
instance FromJSON WithDrawlRequest where
5869
parseJSON = withObject "WithDrawlRequest" $ \v -> WithDrawlRequest
59-
<$> v .: "wallet"
60-
<*> (Coin <$> v .: "amount")
70+
<$> v .: "address"
71+
<*> v .: "amount"
6172

6273
instance ToJSON WithDrawlRequest where
63-
toJSON (WithDrawlRequest w (Coin a)) =
64-
object ["wallet" .= w, "amount" .= a]
74+
toJSON (WithDrawlRequest w a) =
75+
object ["address" .= w, "amount" .= a]
6576

66-
data WithDrawlResult = WithDrawlResult
77+
data WithDrawlResult =
78+
WithdrawlError ClientError
79+
| WithdrawlSuccess Transaction
6780
deriving (Show, Typeable, Generic)
6881

69-
instance ToJSON WithDrawlResult
82+
instance ToJSON WithDrawlResult where
83+
toJSON (WithdrawlSuccess txn) =
84+
object ["success" .= txn]
85+
toJSON (WithdrawlError err) =
86+
object ["error" .= show err]
7087

7188

7289
--------------------------------------------------------------------------------
@@ -94,13 +111,28 @@ data FaucetConfig = FaucetConfig {
94111
, _fcFaucetPaymentSource :: PaymentSource
95112
, _fcStatsdOpts :: StatsdOptions
96113
, _fcLoggerConfigFile :: FilePath
114+
, _fcPubCertFile :: FilePath
115+
, _fcPrivKeyFile :: FilePath
97116
}
98117

99118
makeClassy ''FaucetConfig
100119

101-
mkFaucetConfig :: String -> Int -> PaymentSource -> StatsdOptions -> String -> FaucetConfig
120+
mkFaucetConfig
121+
:: String
122+
-> Int
123+
-> PaymentSource
124+
-> StatsdOptions
125+
-> FilePath
126+
-> FilePath
127+
-> FilePath
128+
-> FaucetConfig
102129
mkFaucetConfig = FaucetConfig
103130

131+
testFC :: FaucetConfig
132+
testFC = FaucetConfig "127.0.0.1" 8090 ps defaultStatsdOptions "./logging.cfg" "./tls/ca.crt" "./tls/server.key"
133+
where
134+
ps = PaymentSource (WalletId "Ae2tdPwUPEZLBG2sEmiv8Y6DqD4LoZKQ5wosXucbLnYoacg2YZSPhMn4ETi") 2147483648
135+
104136
--------------------------------------------------------------------------------
105137
data FaucetEnv = FaucetEnv {
106138
_feWithdrawn :: Counter
@@ -119,13 +151,34 @@ initEnv fc store = do
119151
withdrawn <- createCounter "total-withdrawn" store
120152
withdrawCount <- createCounter "num-withdrawals" store
121153
balance <- createGauge "wallet-balance" store
122-
manager <- newManager defaultManagerSettings
123-
let url = BaseUrl Http (fc ^. fcWalletApiHost) (fc ^. fcWalletApiPort) ""
154+
manager <- createManager fc
155+
let url = BaseUrl Https (fc ^. fcWalletApiHost) (fc ^. fcWalletApiPort) ""
124156
return $ FaucetEnv withdrawn withdrawCount balance
125157
store
126158
fc
127159
(mkHttpClient url manager)
128160

161+
createManager :: FaucetConfig -> IO Manager
162+
createManager fc = do
163+
pubCert <- BS.readFile (fc ^. fcPubCertFile)
164+
privKey <- BS.readFile (fc ^. fcPrivKeyFile)
165+
case credentialLoadX509FromMemory pubCert privKey of
166+
Left problem -> error $ "Unable to load credentials: " <> (problem ^. packed)
167+
Right credential ->
168+
let hooks = def {
169+
onCertificateRequest = \_ -> return $ Just credential,
170+
onServerCertificate = \_ _ _ _ -> return []
171+
}
172+
clientParams = (defaultParamsClient "localhost" "") {
173+
clientHooks = hooks,
174+
clientSupported = def {
175+
supportedCiphers = ciphersuite_all
176+
}
177+
}
178+
tlsSettings = TLSSettings clientParams
179+
in
180+
newManager $ mkManagerSettings tlsSettings Nothing
181+
129182
incWithDrawn :: (MonadReader e m, HasFaucetEnv e, MonadIO m) => Coin -> m ()
130183
incWithDrawn (Coin (fromIntegral -> c)) = do
131184
wd <- view feWithdrawn

‎faucet/src/Cardano/WalletClient.hs‎

Lines changed: 22 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,31 @@
1+
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE OverloadedStrings #-}
3+
{-# LANGUAGE ScopedTypeVariables #-}
14
module Cardano.WalletClient where
25
-- ( export
36
-- , export
47
-- ) where
58

9+
import Crypto.Hash (Blake2b, Blake2b_224, Blake2b_256, Digest)
10+
import Data.ByteString (ByteString)
11+
import qualified Data.ByteString.Base16 as Base16
12+
import qualified Data.ByteArray as BA
13+
-- import qualified Serokell.Util.Base16 as Base16
14+
import qualified Crypto.Hash as CryptoHash
615
import Control.Lens
716
import Control.Monad.Reader
17+
import Data.Text (Text)
818
import Data.List.NonEmpty (NonEmpty(..))
19+
import Data.Text.Buildable (build)
920
import Cardano.Faucet.Types
1021
import Cardano.Wallet.API.V1.Types (Payment (..), PaymentDistribution (..),
11-
PaymentSource (..), V1(..))
22+
PaymentSource (..), V1(..), mkPassPhrase)
1223
-- import Cardano.Wallet.API.V1.Types.V1 (Coin (..), Address(..))
1324
import Cardano.Wallet.Client (Resp, Transaction, WalletClient (..), WalletResponse (..),
1425
liftClient)
1526
import Pos.Wallet.Web.Methods.Payment (newPayment)
1627
import Pos.Core (Coin (..), Address(..))
28+
import Pos.Crypto.Signing (PassPhrase(..))
1729
import Pos.Wallet.Web.ClientTypes.Types (Addr (..), CId (..))
1830

1931

@@ -22,5 +34,13 @@ withdraw addr coin = do
2234
paymentSource <- view (feFaucetConfig . fcFaucetPaymentSource)
2335
client <- liftClient <$> view feWalletClient
2436
let paymentDist = (PaymentDistribution addr coin :| [])
25-
payment = Payment paymentSource paymentDist Nothing Nothing
37+
payment = Payment paymentSource paymentDist Nothing sp
2638
postTransaction client payment
39+
where
40+
sp :: Maybe (V1 PassPhrase)
41+
sp = Just $ V1 $ hashPwd "XXX" -- TODO: get from config
42+
43+
hashPwd :: ByteString -> PassPhrase
44+
hashPwd bs =
45+
let blake = CryptoHash.hash bs :: Digest (Blake2b_256)
46+
in BA.convert blake

0 commit comments

Comments
 (0)