Skip to content

Commit 749d679

Browse files
encryptedcoinsencryptedcoins
authored
Merge pull request encryptedcoins#21 from encryptedcoins/development
Server setup fix, add cache to delegation server
2 parents cd89eb6 + 862ace5 commit 749d679

File tree

3 files changed

+20
-13
lines changed

3 files changed

+20
-13
lines changed

‎encoins-relay-apps/src/Encoins/Relay/Apps/Delegation/Server.hs‎

Lines changed: 10 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -25,8 +25,9 @@ import Control.Concurrent (forkIO)
2525
import Control.Concurrent.Async (async, wait)
2626
import Control.Monad (forever, void, when, (>=>))
2727
import Control.Monad.Catch (Exception, MonadCatch (catch), MonadThrow (..), SomeException, handle)
28+
import Control.Monad.Extra (fromMaybeM)
2829
import Control.Monad.IO.Class (MonadIO (..))
29-
import Control.Monad.Reader (MonadReader (ask, local), ReaderT (..))
30+
import Control.Monad.Reader (MonadReader (ask, local), ReaderT (..), asks)
3031
import Data.ByteString (ByteString)
3132
import Data.FileEmbed (embedFileIfExists)
3233
import Data.Fixed (Pico)
@@ -44,7 +45,7 @@ import qualified Data.Time as Time
4445
import Encoins.Relay.Apps.Delegation.Internal (DelegConfig (..), Delegation (..), DelegationEnv (..), DelegationM (..),
4546
Progress (..), delegAddress, getBalances, getIpsWithBalances,
4647
loadPastProgress, runDelegationM, updateProgress, writeResultFile)
47-
import Encoins.Relay.Apps.Internal (formatTime, janitorFiles)
48+
import Encoins.Relay.Apps.Internal (formatTime, janitorFiles, loadMostRecentFile)
4849
import qualified Network.Wai.Handler.Warp as Warp
4950
import qualified Network.Wai.Handler.WarpTLS as Warp
5051
import PlutusAppsExtra.Utils.Address (addressToBech32)
@@ -144,7 +145,7 @@ getServersHandler :: DelegationM (Map Text Integer)
144145
getServersHandler = delegationErrorH $ do
145146
Progress _ delegs <- getMostRecentProgressFile
146147
(retiredRelays :: [Text]) <- liftIO $ decodeOrErrorFromFile "retiredRelays.json"
147-
filterWithKey (\k _ -> k `notElem` retiredRelays) <$> getIpsWithBalances delegs
148+
filterWithKey (\k _ -> k `notElem` retiredRelays) <$> getResult delegs
148149

149150
-------------------------------------- Get current (more than 100k(MinTokenNumber) delegated tokens) servers endpoint --------------------------------------
150151

@@ -154,7 +155,7 @@ getCurrentServersHandler :: DelegationM [Text]
154155
getCurrentServersHandler = delegationErrorH $ do
155156
env <- ask
156157
Progress _ delegs <- getMostRecentProgressFile
157-
ipsWithBalances <- getIpsWithBalances delegs
158+
ipsWithBalances <- getResult delegs
158159
-- We are currently using proxies for each server. DelegationMap is a map of server IPs to their proxy IPs.
159160
delegationMap <- liftIO $ decodeOrErrorFromFile "delegationMap.json"
160161

@@ -223,6 +224,11 @@ getMostRecentProgressFile = do
223224
when (diff > fromIntegral dEnvMaxDelay) $ throwM $ StaleProgressFile diff (diff - fromIntegral dEnvMaxDelay)
224225
pure p
225226

227+
getResult :: [Delegation] -> DelegationM (Map Text Integer)
228+
getResult delegs = do
229+
delegFolder <- asks dEnvDelegationFolder
230+
fromMaybeM (getIpsWithBalances delegs) $ liftIO (fmap snd <$> loadMostRecentFile delegFolder "result_")
231+
226232
searchForDelegations :: DelegationM ()
227233
searchForDelegations = do
228234
DelegationEnv{..} <- ask

‎encoins-relay-apps/src/Encoins/Relay/Apps/Internal.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -124,7 +124,7 @@ janitorFiles dir prefix = liftIO $ do
124124
files <- listDirectory dir
125125
let mbLastTime = listToMaybe . reverse . sort $ mapMaybe (stripPrefix prefix >=> takeWhile (/= '.') >>> readTime) files
126126
mbLastFile = (\t -> dir </> prefix <> t <> ".json") . formatTime <$> mbLastTime
127-
toRemove = (`filterFiles` map (dir </>) files) <$> mbLastFile
127+
toRemove = drop 10 . reverse . (`filterFiles` map (dir </>) files) <$> mbLastFile
128128
sequence_ $ mapM_ removeFile <$> toRemove
129129
where
130130
filterFiles lastFile = filter $ uncurry (&&) <<< (/= lastFile) &&& isPrefixOf (dir </> prefix)

‎encoins-relay-server/src/Encoins/Relay/Server/Server.hs‎

Lines changed: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ import Cardano.Server.Config (Config (..))
2323
import Cardano.Server.Error (IsCardanoServerError (errMsg, errStatus))
2424
import Cardano.Server.Input (InputContext (..))
2525
import Cardano.Server.Internal (AuxillaryEnvOf, InputOf, InputWithContext, ServerHandle (..), ServerM,
26-
getAuxillaryEnv, mkServerClientEnv, mkServantClientEnv)
26+
getAuxillaryEnv, mkServantClientEnv, mkServerClientEnv)
2727
import Cardano.Server.Main (ServerApi)
2828
import Cardano.Server.Tx (mkTx)
2929
import Control.Arrow ((&&&))
@@ -115,18 +115,19 @@ instance IsCardanoServerError EncoinsTxApiError where
115115
serverSetup :: ServerM EncoinsApi ()
116116
serverSetup = void $ do
117117
encoinsProtocolParams@(_, refBeacon, _) <- getEncoinsProtocolParams
118+
addr <- getWalletAddr
118119
-- Mint the stake owner token
119120
utxos <- getWalletUtxos mempty
120121
let utxos' = Map.delete refBeacon utxos
121-
mkTx [] (InputContextServer utxos') [stakeOwnerTx encoinsProtocolParams]
122+
mkTx [] (InputContextClient utxos' utxos' (TxOutRef (TxId "") 1) addr) [stakeOwnerTx encoinsProtocolParams]
122123
-- Mint and send the beacon
123-
utxos'' <- getWalletUtxos mempty
124-
mkTx [] (InputContextServer utxos'') [beaconTx encoinsProtocolParams]
124+
utxos'' <- getWalletUtxos mempty
125+
mkTx [] (InputContextClient utxos'' utxos'' (TxOutRef (TxId "") 1) addr) [beaconTx encoinsProtocolParams]
125126
-- Post the ENCOINS minting policy
126-
mkTx [] def [postEncoinsPolicyTx encoinsProtocolParams referenceScriptSalt]
127+
mkTx [] (InputContextServer def) [postEncoinsPolicyTx encoinsProtocolParams referenceScriptSalt]
127128
-- Post the staking validator policy
128-
mkTx [] def [postLedgerValidatorTx encoinsProtocolParams referenceScriptSalt]
129-
mkTx [] def [encoinsSendTx encoinsProtocolParams (ledgerValidatorAddress encoinsProtocolParams) minMaxTxOutValueInLedger]
129+
mkTx [] (InputContextServer def) [postLedgerValidatorTx encoinsProtocolParams referenceScriptSalt]
130+
mkTx [] (InputContextServer def) [encoinsSendTx encoinsProtocolParams (ledgerValidatorAddress encoinsProtocolParams) minMaxTxOutValueInLedger]
130131

131132
processRequest :: (InputOf EncoinsApi, TransactionInputs) -> ServerM EncoinsApi (InputWithContext EncoinsApi)
132133
processRequest req = sequence $ case req of
@@ -171,4 +172,4 @@ checkStatusEndpoint :: ServerM EncoinsApi (Either Text ())
171172
checkStatusEndpoint = do
172173
env <- mkServerClientEnv
173174
res <- liftIO $ Servant.runClientM (statusC @EncoinsApi MaxAdaWithdraw) env
174-
either throwM (const $ pure $ Right ()) res
175+
either throwM (const $ pure $ Right ()) res

0 commit comments

Comments
 (0)