From 501330112152146d76675563bbd1dacadbf50168 Mon Sep 17 00:00:00 2001 From: "Andres G. Aragoneses" Date: Mon, 20 Jul 2020 18:44:12 +0800 Subject: [PATCH] Update fantomas to 4.3.0-alpha-002-alpha-043 dotnet tool install -g fantomas-tool --add-source https://www.myget.org/F/fantomas/api/v3/index.json --framework netcoreapp3.1 --version 4.3.0-alpha-002-alpha-043 New bugs: https://github.com/fsprojects/fantomas/issues/1223 https://github.com/fsprojects/fantomas/issues/1226 https://github.com/fsprojects/fantomas/issues/1220 https://github.com/fsprojects/fantomas/issues/1219 https://github.com/fsprojects/fantomas/issues/1222 --- src/GWallet.Backend/Account.fs | 296 ++++++----- src/GWallet.Backend/Caching.fs | 498 ++++++++++-------- src/GWallet.Backend/Currency.fs | 4 +- src/GWallet.Backend/Ether/EtherAccount.fs | 180 +++---- src/GWallet.Backend/Ether/EtherServer.fs | 238 +++++---- src/GWallet.Backend/FSharpUtil.fs | 1 + .../FaultTolerantParallelClient.fs | 469 +++++++++-------- src/GWallet.Backend/Infrastructure.fs | 18 +- src/GWallet.Backend/JsonRpcTcpClient.fs | 7 +- src/GWallet.Backend/Marshalling.fs | 22 +- .../Properties/AssemblyInfo.fs | 16 +- .../Properties/CommonAssemblyInfo.fs | 11 +- src/GWallet.Backend/Server.fs | 8 +- src/GWallet.Backend/ServerManager.fs | 8 +- .../UtxoCoin/ElectrumClient.fs | 29 +- .../UtxoCoin/ElectrumServer.fs | 30 +- src/GWallet.Backend/UtxoCoin/StratumClient.fs | 41 +- .../UtxoCoin/UtxoCoinAccount.fs | 238 +++++---- .../UtxoCoin/UtxoCoinServer.fs | 61 +-- src/GWallet.Backend/WarpKey.fs | 11 +- 20 files changed, 1179 insertions(+), 1007 deletions(-) diff --git a/src/GWallet.Backend/Account.fs b/src/GWallet.Backend/Account.fs index d2c977718..5aff455f6 100644 --- a/src/GWallet.Backend/Account.fs +++ b/src/GWallet.Backend/Account.fs @@ -9,12 +9,10 @@ open GWallet.Backend.FSharpUtil.UwpHacks module Account = - let private GetShowableBalanceInternal - (account: IAccount) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async> - = + let private GetShowableBalanceInternal (account: IAccount) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async> = match account with | :? UtxoCoin.IUtxoAccount as utxoAccount -> if not (account.Currency.IsUtxo ()) then @@ -27,15 +25,14 @@ module Account = failwith <| SPrintF1 "Currency %A not ether based and not UTXO either? not supported, report this bug (balance)" - account.Currency + account.Currency + Ether.Account.GetShowableBalance account mode cancelSourceOption - let GetShowableBalance - (account: IAccount) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async> - = + let GetShowableBalance (account: IAccount) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async> = async { if Config.NoNetworkBalanceForDebuggingPurposes then return Fresh 1m @@ -45,8 +42,8 @@ module Account = match maybeBalance with | None -> - return NotFresh - (Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency) + return + NotFresh (Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency) | Some balance -> let compoundBalance, _ = Caching.Instance.RetrieveAndUpdateLastCompoundBalance @@ -101,13 +98,15 @@ module Account = let utxoCoinPublicKey = UtxoCoin.Account.GetPublicKeyFromNormalAccountFile firstUtxoAccountFile let firstEtherAccountFile = etherCurrencyAccountFiles.First () let etherPublicAddress = Ether.Account.GetPublicAddressFromNormalAccountFile firstEtherAccountFile + Some { UtxoCoinPublicKey = utxoCoinPublicKey.ToString () EtherPublicAddress = etherPublicAddress } - let GetArchivedAccountsWithPositiveBalance (cancelSourceOption: Option): Async> = + let GetArchivedAccountsWithPositiveBalance (cancelSourceOption: Option) + : Async> = let asyncJobs = seq>> { let allCurrencies = Currency.GetAll () @@ -130,32 +129,36 @@ module Account = ArchivedAccount (currency, accountFile, fromConfigAccountFileToPublicAddressFunc) let maybeBalanceJob = GetShowableBalanceInternal account ServerSelectionMode.Fast - yield async { - let! maybeBalance = maybeBalanceJob cancelSourceOption - - let positiveBalance = - match maybeBalance with - | Some balance -> - if (balance > 0m) then - Some (balance) - else - None - | _ -> None - - return account, positiveBalance - } + + yield + async { + let! maybeBalance = maybeBalanceJob cancelSourceOption + + let positiveBalance = + match maybeBalance with + | Some balance -> + if (balance > 0m) then + Some (balance) + else + None + | _ -> None + + return account, positiveBalance + } } let executedBalances = Async.Parallel asyncJobs + async { let! accountAndPositiveBalances = executedBalances - return seq { - for account, maybePositiveBalance in accountAndPositiveBalances do - match maybePositiveBalance with - | Some positiveBalance -> yield account, positiveBalance - | _ -> () - } + return + seq { + for account, maybePositiveBalance in accountAndPositiveBalances do + match maybePositiveBalance with + | Some positiveBalance -> yield account, positiveBalance + | _ -> () + } } // TODO: add tests for these (just in case address validation breaks after upgrading our dependencies) @@ -178,7 +181,8 @@ module Account = failwith <| SPrintF1 "Currency %A not Utxo-type but account is? report this bug (estimatefee)" - account.Currency + account.Currency + let! fee = UtxoCoin.Account.EstimateFee utxoAccount amount destination return fee :> IBlockchainFeeInfo | _ -> @@ -186,7 +190,8 @@ module Account = failwith <| SPrintF1 "Currency %A not ether based and not UTXO either? not supported, report this bug (estimatefee)" - account.Currency + account.Currency + let! fee = Ether.Account.EstimateFee account amount destination return fee :> IBlockchainFeeInfo } @@ -220,12 +225,13 @@ module Account = if outOfGas then return failwith <| SPrintF1 "Transaction ran out of gas: %s" txHash with ex -> - return raise - <| Exception - (SPrintF1 - "An issue occurred while trying to check if the following transaction ran out of gas: %s" - txHash, - ex) + return + raise + <| Exception + (SPrintF1 + "An issue occurred while trying to check if the following transaction ran out of gas: %s" + txHash, + ex) | _ -> () } @@ -253,13 +259,12 @@ module Account = return uri } - let SignTransaction - (account: NormalAccount) - (destination: string) - (amount: TransferAmount) - (transactionMetadata: IBlockchainFeeInfo) - (password: string) - = + let SignTransaction (account: NormalAccount) + (destination: string) + (amount: TransferAmount) + (transactionMetadata: IBlockchainFeeInfo) + (password: string) + = match transactionMetadata with | :? Ether.TransactionMetadata as etherTxMetadata -> @@ -276,18 +281,19 @@ module Account = let checkJobs = seq { for account in GetAllActiveAccounts().OfType () do - yield async { - if (account :> IAccount).Currency.IsEtherBased() then - try - Ether.Account.CheckValidPassword account password - return true - with :? InvalidPassword -> return false - else - try - UtxoCoin.Account.CheckValidPassword account password - return true - with :? InvalidPassword -> return false - } + yield + async { + if (account :> IAccount).Currency.IsEtherBased() then + try + Ether.Account.CheckValidPassword account password + return true + with :? InvalidPassword -> return false + else + try + UtxoCoin.Account.CheckValidPassword account password + return true + with :? InvalidPassword -> return false + } } Async.Parallel checkJobs @@ -329,7 +335,10 @@ module Account = let privateKeyAsString = if currency.IsUtxo () then let privKey = UtxoCoin.Account.GetPrivateKey account password - privKey.GetWif(UtxoCoin.Account.GetNetwork currency).ToWif() + + privKey + .GetWif(UtxoCoin.Account.GetNetwork currency) + .ToWif() elif currency.IsEther () then let privKey = Ether.Account.GetPrivateKey account password privKey.GetPrivateKey () @@ -339,12 +348,11 @@ module Account = CreateArchivedAccount currency privateKeyAsString |> ignore Config.RemoveNormalAccount account - let SweepArchivedFunds - (account: ArchivedAccount) - (balance: decimal) - (destination: IAccount) - (txMetadata: IBlockchainFeeInfo) - = + let SweepArchivedFunds (account: ArchivedAccount) + (balance: decimal) + (destination: IAccount) + (txMetadata: IBlockchainFeeInfo) + = match txMetadata with | :? Ether.TransactionMetadata as etherTxMetadata -> Ether.Account.SweepArchivedFunds account balance destination etherTxMetadata @@ -355,15 +363,14 @@ module Account = | _ -> failwith "If tx metadata is UTXO type, archived account should be too" | _ -> failwith "tx metadata type unknown" - let SendPayment - (account: NormalAccount) - (txMetadata: IBlockchainFeeInfo) - (destination: string) - (amount: TransferAmount) - (password: string) - : Async - = + let SendPayment (account: NormalAccount) + (txMetadata: IBlockchainFeeInfo) + (destination: string) + (amount: TransferAmount) + (password: string) + : Async = let baseAccount = account :> IAccount + if (baseAccount.PublicAddress.Equals (destination, StringComparison.InvariantCultureIgnoreCase)) then raise DestinationEqualToOrigin @@ -379,7 +386,8 @@ module Account = failwith <| SPrintF1 "Currency %A not Utxo-type but tx metadata is? report this bug (sendpayment)" - currency + currency + match account with | :? UtxoCoin.NormalUtxoAccount as utxoAccount -> UtxoCoin.Account.SendPayment utxoAccount btcTxMetadata destination amount password @@ -388,6 +396,7 @@ module Account = | :? Ether.TransactionMetadata as etherTxMetadata -> if not (currency.IsEtherBased ()) then failwith "Account not ether-type but tx metadata is? report this bug (sendpayment)" + Ether.Account.SendPayment account etherTxMetadata destination amount password | _ -> failwith "Unknown tx metadata type" @@ -464,7 +473,9 @@ module Account = let CreateReadOnlyAccounts (watchWalletInfo: WatchWalletInfo): Async = async { - for etherCurrency in Currency.GetAll().Where(fun currency -> currency.IsEtherBased ()) do + for etherCurrency in Currency + .GetAll() + .Where(fun currency -> currency.IsEtherBased ()) do do! ValidateAddress etherCurrency watchWalletInfo.EtherPublicAddress let conceptAccountForReadOnlyAccount = @@ -481,7 +492,9 @@ module Account = Config.AddAccount conceptAccountForReadOnlyAccount AccountKind.ReadOnly |> ignore - for utxoCurrency in Currency.GetAll().Where(fun currency -> currency.IsUtxo ()) do + for utxoCurrency in Currency + .GetAll() + .Where(fun currency -> currency.IsUtxo ()) do let address = UtxoCoin.Account.GetPublicAddressFromPublicKey utxoCurrency @@ -507,22 +520,18 @@ module Account = let Remove (account: ReadOnlyAccount) = Config.RemoveReadOnlyAccount account - let private CreateConceptEtherAccountInternal - (password: string) - (seed: array) - : Async string)> - = + let private CreateConceptEtherAccountInternal (password: string) + (seed: array) + : Async string)> = async { let! virtualFile = Ether.Account.Create password seed return virtualFile, Ether.Account.GetPublicAddressFromNormalAccountFile } - let private CreateConceptAccountInternal - (currency: Currency) - (password: string) - (seed: array) - : Async string)> - = + let private CreateConceptAccountInternal (currency: Currency) + (password: string) + (seed: array) + : Async string)> = async { if currency.IsUtxo () then let! virtualFile = UtxoCoin.Account.Create currency password seed @@ -538,40 +547,44 @@ module Account = async { let! virtualFile, fromEncPrivKeyToPublicAddressFunc = CreateConceptAccountInternal currency password seed - return { - Currency = currency - FileRepresentation = virtualFile - ExtractPublicAddressFromConfigFileFunc = fromEncPrivKeyToPublicAddressFunc - } + return + { + Currency = currency + FileRepresentation = virtualFile + ExtractPublicAddressFromConfigFileFunc = fromEncPrivKeyToPublicAddressFunc + } } - let private CreateConceptAccountAux - (currency: Currency) - (password: string) - (seed: array) - : Async> - = + let private CreateConceptAccountAux (currency: Currency) + (password: string) + (seed: array) + : Async> = async { let! singleAccount = CreateConceptAccount currency password seed return singleAccount :: List.Empty } let CreateEtherNormalAccounts (password: string) (seed: array): Async> = - let supportedEtherCurrencies = Currency.GetAll().Where(fun currency -> currency.IsEtherBased ()) + let supportedEtherCurrencies = + Currency + .GetAll() + .Where(fun currency -> currency.IsEtherBased ()) let etherAccounts = async { let! virtualFile, fromEncPrivKeyToPublicAddressFunc = CreateConceptEtherAccountInternal password seed - return seq { - for etherCurrency in supportedEtherCurrencies do - yield { - Currency = etherCurrency - FileRepresentation = virtualFile - ExtractPublicAddressFromConfigFileFunc = fromEncPrivKeyToPublicAddressFunc - } - } - |> List.ofSeq + return + seq { + for etherCurrency in supportedEtherCurrencies do + yield + { + Currency = etherCurrency + FileRepresentation = virtualFile + ExtractPublicAddressFromConfigFileFunc = fromEncPrivKeyToPublicAddressFunc + } + } + |> List.ofSeq } etherAccounts @@ -580,12 +593,10 @@ module Account = let newAccountFile = Config.AddAccount conceptAccount AccountKind.Normal NormalAccount (conceptAccount.Currency, newAccountFile, conceptAccount.ExtractPublicAddressFromConfigFileFunc) - let GenerateMasterPrivateKey - (passphrase: string) - (dobPartOfSalt: DateTime) - (emailPartOfSalt: string) - : Async> - = + let GenerateMasterPrivateKey (passphrase: string) + (dobPartOfSalt: DateTime) + (emailPartOfSalt: string) + : Async> = async { let salt = SPrintF2 "%s+%s" (dobPartOfSalt.Date.ToString ("yyyyMMdd")) (emailPartOfSalt.ToLower ()) @@ -594,10 +605,16 @@ module Account = return privateKeyBytes } - let CreateAllConceptAccounts (privateKeyBytes: array) (encryptionPassword: string): Async> = + let CreateAllConceptAccounts (privateKeyBytes: array) + (encryptionPassword: string) + : Async> = async { let etherAccounts = CreateEtherNormalAccounts encryptionPassword privateKeyBytes - let nonEthCurrencies = Currency.GetAll().Where(fun currency -> not (currency.IsEtherBased ())) + + let nonEthCurrencies = + Currency + .GetAll() + .Where(fun currency -> not (currency.IsEtherBased ())) let nonEtherAccounts: List>> = seq { @@ -637,15 +654,17 @@ module Account = let! masterPrivateKey = GenerateMasterPrivateKey passphrase dobPartOfSalt emailPartOfSalt let! allConceptAccounts = CreateAllConceptAccounts masterPrivateKey (Guid.NewGuid().ToString()) - return allConceptAccounts.All (fun conceptAccount -> - GetAllActiveAccounts() - .Any(fun account -> - let publicAddressOfConceptAccount = - conceptAccount.ExtractPublicAddressFromConfigFileFunc - conceptAccount.FileRepresentation - - let publicAddressMatches = (account.PublicAddress = publicAddressOfConceptAccount) - publicAddressMatches)) + return + allConceptAccounts.All + (fun conceptAccount -> + GetAllActiveAccounts() + .Any(fun account -> + let publicAddressOfConceptAccount = + conceptAccount.ExtractPublicAddressFromConfigFileFunc + conceptAccount.FileRepresentation + + let publicAddressMatches = (account.PublicAddress = publicAddressOfConceptAccount) + publicAddressMatches)) } let WipeAll () = @@ -655,11 +674,9 @@ module Account = let public ExportUnsignedTransactionToJson trans = Marshalling.Serialize trans - let private SerializeUnsignedTransactionPlain - (transProposal: UnsignedTransactionProposal) - (txMetadata: IBlockchainFeeInfo) - : string - = + let private SerializeUnsignedTransactionPlain (transProposal: UnsignedTransactionProposal) + (txMetadata: IBlockchainFeeInfo) + : string = let readOnlyAccounts = GetAllActiveAccounts().OfType () match txMetadata with @@ -669,11 +686,10 @@ module Account = UtxoCoin.Account.SaveUnsignedTransaction transProposal btcTxMetadata readOnlyAccounts | _ -> failwith "fee type unknown" - let SaveUnsignedTransaction - (transProposal: UnsignedTransactionProposal) - (txMetadata: IBlockchainFeeInfo) - (filePath: string) - = + let SaveUnsignedTransaction (transProposal: UnsignedTransactionProposal) + (txMetadata: IBlockchainFeeInfo) + (filePath: string) + = let json = SerializeUnsignedTransactionPlain transProposal txMetadata File.WriteAllText (filePath, json) diff --git a/src/GWallet.Backend/Caching.fs b/src/GWallet.Backend/Caching.fs index d50ff4f93..99fe03d87 100644 --- a/src/GWallet.Backend/Caching.fs +++ b/src/GWallet.Backend/Caching.fs @@ -48,11 +48,9 @@ type CachedNetworkData = } member self.ToDietCache (readOnlyAccounts: seq) = - let rec extractAddressesFromAccounts - (acc: Map>) - (accounts: List) - : Map> - = + let rec extractAddressesFromAccounts (acc: Map>) + (accounts: List) + : Map> = match accounts with | [] -> acc | head :: tail -> @@ -103,8 +101,10 @@ module Caching = let private GetCacheDir () = let configPath = Config.GetConfigDirForThisProgram().FullName let configDir = DirectoryInfo (Path.Combine (configPath, "cache")) + if not configDir.Exists then configDir.Create () + configDir let private defaultCacheFiles = @@ -119,6 +119,7 @@ module Caching = let private LoadFromDiskInner (file: FileInfo): Option = let json = File.ReadAllText file.FullName + if String.IsNullOrWhiteSpace json then None else @@ -164,20 +165,21 @@ module Caching = false, networkData let maybeServerStats = LoadFromDiskInternal files.ServerStats + match maybeServerStats with | None -> maybeFirstRun, resultingNetworkData, Map.empty | Some serverStats -> false, resultingNetworkData, serverStats - let rec private MergeRatesInternal - (oldMap: Map<'K, CachedValue<'V>>) - (newMap: Map<'K, CachedValue<'V>>) - (currencyList: List<'K>) - (accumulator: Map<'K, CachedValue<'V>>) - = + let rec private MergeRatesInternal (oldMap: Map<'K, CachedValue<'V>>) + (newMap: Map<'K, CachedValue<'V>>) + (currencyList: List<'K>) + (accumulator: Map<'K, CachedValue<'V>>) + = match currencyList with | [] -> accumulator | address :: tail -> let maybeCachedBalance = Map.tryFind address oldMap + match maybeCachedBalance with | None -> let newCachedBalance = newMap.[address] @@ -198,17 +200,16 @@ module Caching = let currencyList = Map.toList newMap |> List.map fst MergeRatesInternal oldMap newMap currencyList oldMap - let rec private MergeBalancesInternal - (oldMap: Map>>) - (newMap: Map>>) - (addressList: List) - (accumulator: Map>>) - : Map>> - = + let rec private MergeBalancesInternal (oldMap: Map>>) + (newMap: Map>>) + (addressList: List) + (accumulator: Map>>) + : Map>> = match addressList with | [] -> accumulator | (currency, address) :: tail -> let maybeCachedBalances = Map.tryFind currency oldMap + match maybeCachedBalances with | None -> let newCachedBalance = newMap.[currency].[address] @@ -218,6 +219,7 @@ module Caching = | Some (balancesMapForCurrency) -> let accBalancesForThisCurrency = accumulator.[currency] let maybeCachedBalance = Map.tryFind address balancesMapForCurrency + match maybeCachedBalance with | None -> let newCachedBalance = newMap.[currency].[address] @@ -236,11 +238,9 @@ module Caching = MergeBalancesInternal oldMap newMap tail newAcc - let private MergeBalances - (oldMap: Map>>) - (newMap: Map>>) - : Map>> - = + let private MergeBalances (oldMap: Map>>) + (newMap: Map>>) + : Map>> = let addressList = seq { for currency, subMap in Map.toList newMap do @@ -293,14 +293,16 @@ module Caching = let InitServers (lastServerStats: ServerRanking) = let mergedServers = ServerRegistry.MergeWithBaseline lastServerStats let mergedAndSaved = SaveServerRankingsToDisk mergedServers + for KeyValue (currency, servers) in mergedAndSaved do for server in servers do if server.CommunicationHistory.IsNone then Infrastructure.LogError (SPrintF2 "WARNING: no history stats about %A server %s" - currency - server.ServerInfo.NetworkPath) + currency + server.ServerInfo.NetworkPath) + mergedServers let firstRun, initialSessionCachedNetworkData, lastServerStats = LoadFromDisk cacheFiles @@ -309,28 +311,29 @@ module Caching = let mutable sessionCachedNetworkData = initialSessionCachedNetworkData let mutable sessionServerRanking = initialServerStats - let GetSumOfAllTransactions - (trans: Map>>>) - currency - address - : decimal - = + let GetSumOfAllTransactions (trans: Map>>>) + currency + address + : decimal = let now = DateTime.UtcNow let currencyTrans = trans.TryFind currency + match currencyTrans with | None -> 0m | Some someMap -> let addressTrans = someMap.TryFind address + match addressTrans with | None -> 0m | Some someMap -> Map.toSeq someMap - |> Seq.sumBy (fun (_, (txAmount, txDate)) -> - // FIXME: develop some kind of cache cleanup to remove these expired txs? - if (now < txDate + unconfTxExpirationSpan) then - txAmount - else - 0m) + |> Seq.sumBy + (fun (_, (txAmount, txDate)) -> + // FIXME: develop some kind of cache cleanup to remove these expired txs? + if (now < txDate + unconfTxExpirationSpan) then + txAmount + else + 0m) let rec RemoveRangeFromMap (map: Map<'K, 'V>) (list: List<'K * 'V>) = match list with @@ -348,8 +351,8 @@ module Caching = Infrastructure.ReportError (SPrintF2 "Negative balance '%s'. Details: %s" - (negativeBalance.ToString ()) - (GatherDebuggingInfo previousBalance currency address newCache)) + (negativeBalance.ToString ()) + (GatherDebuggingInfo previousBalance currency address newCache)) member __.ClearAll () = SaveNetworkDataToDisk CachedNetworkData.Empty @@ -357,66 +360,74 @@ module Caching = member __.SaveSnapshot (newDietCachedData: DietCache) = let newCachedData = CachedNetworkData.FromDietCache newDietCachedData - lock cacheFiles.CachedNetworkData (fun _ -> - let newSessionCachedNetworkData = - let mergedBalances = MergeBalances sessionCachedNetworkData.Balances newCachedData.Balances - let mergedUsdPrices = MergeRates sessionCachedNetworkData.UsdPrice newCachedData.UsdPrice - { sessionCachedNetworkData with - UsdPrice = mergedUsdPrices - Balances = mergedBalances - } - sessionCachedNetworkData <- newSessionCachedNetworkData - SaveNetworkDataToDisk newSessionCachedNetworkData) + lock + cacheFiles.CachedNetworkData + (fun _ -> + let newSessionCachedNetworkData = + let mergedBalances = MergeBalances sessionCachedNetworkData.Balances newCachedData.Balances + let mergedUsdPrices = MergeRates sessionCachedNetworkData.UsdPrice newCachedData.UsdPrice + + { sessionCachedNetworkData with + UsdPrice = mergedUsdPrices + Balances = mergedBalances + } + + sessionCachedNetworkData <- newSessionCachedNetworkData + SaveNetworkDataToDisk newSessionCachedNetworkData) member __.GetLastCachedData (): CachedNetworkData = lock cacheFiles.CachedNetworkData (fun _ -> sessionCachedNetworkData) member __.RetrieveLastKnownUsdPrice currency: NotFresh = - lock cacheFiles.CachedNetworkData (fun _ -> - try - Cached (sessionCachedNetworkData.UsdPrice.Item currency) - with - // FIXME: rather use tryFind func instead of using a try-with block - :? System.Collections.Generic.KeyNotFoundException -> NotAvailable) + lock + cacheFiles.CachedNetworkData + (fun _ -> + try + Cached (sessionCachedNetworkData.UsdPrice.Item currency) + with :? System.Collections.Generic.KeyNotFoundException -> NotAvailable) member __.StoreLastFiatUsdPrice (currency, lastFiatUsdPrice: decimal): unit = - lock cacheFiles.CachedNetworkData (fun _ -> - let time = DateTime.UtcNow - - let newCachedValue = - { sessionCachedNetworkData with - UsdPrice = sessionCachedNetworkData.UsdPrice.Add (currency, (lastFiatUsdPrice, time)) - } + lock + cacheFiles.CachedNetworkData + (fun _ -> + let time = DateTime.UtcNow + + let newCachedValue = + { sessionCachedNetworkData with + UsdPrice = sessionCachedNetworkData.UsdPrice.Add (currency, (lastFiatUsdPrice, time)) + } - sessionCachedNetworkData <- newCachedValue + sessionCachedNetworkData <- newCachedValue - SaveNetworkDataToDisk newCachedValue) + SaveNetworkDataToDisk newCachedValue) member __.RetrieveLastCompoundBalance (address: PublicAddress) (currency: Currency): NotFresh = - lock cacheFiles.CachedNetworkData (fun _ -> - let balance = - try - Cached ((sessionCachedNetworkData.Balances.Item currency).Item address) - with - // FIXME: rather use tryFind func instead of using a try-with block - :? System.Collections.Generic.KeyNotFoundException -> NotAvailable - - match balance with - | NotAvailable -> NotAvailable - | Cached (balance, time) -> - let allTransSum = - GetSumOfAllTransactions sessionCachedNetworkData.OutgoingTransactions currency address - - let compoundBalance = balance - allTransSum - if (compoundBalance < 0.0m) then - ReportProblem compoundBalance None currency address sessionCachedNetworkData - Cached (0.0m, time) - else - Cached (compoundBalance, time)) + lock + cacheFiles.CachedNetworkData + (fun _ -> + let balance = + try + Cached ((sessionCachedNetworkData.Balances.Item currency).Item address) + with :? System.Collections.Generic.KeyNotFoundException -> NotAvailable + + match balance with + | NotAvailable -> NotAvailable + | Cached (balance, time) -> + let allTransSum = + GetSumOfAllTransactions sessionCachedNetworkData.OutgoingTransactions currency address + + let compoundBalance = balance - allTransSum + + if (compoundBalance < 0.0m) then + ReportProblem compoundBalance None currency address sessionCachedNetworkData + Cached (0.0m, time) + else + Cached (compoundBalance, time)) member self.TryRetrieveLastCompoundBalance (address: PublicAddress) (currency: Currency): Option = let maybeCachedBalance = self.RetrieveLastCompoundBalance address currency + match maybeCachedBalance with | NotAvailable -> None | Cached (cachedBalance, _) -> Some cachedBalance @@ -426,79 +437,90 @@ module Caching = (newBalance: decimal) : CachedValue = let time = DateTime.UtcNow - lock cacheFiles.CachedNetworkData (fun _ -> - let newCachedValueWithNewBalance, previousBalance = - let newCurrencyBalances, previousBalance = - match sessionCachedNetworkData.Balances.TryFind currency with - | None -> Map.empty, None - | Some currencyBalances -> - let maybePreviousBalance = currencyBalances.TryFind address - currencyBalances, maybePreviousBalance - - { sessionCachedNetworkData with - Balances = - sessionCachedNetworkData.Balances.Add - (currency, newCurrencyBalances.Add (address, (newBalance, time))) - }, - previousBalance - - let newCachedValueWithNewBalanceAndMaybeLessTransactions = - let maybeNewValue = - FSharpUtil.option { - let! previousCachedBalance, _ = previousBalance - - do! if newBalance <> previousCachedBalance && previousCachedBalance > newBalance then - Some () - else - None - - let! currencyAddresses = newCachedValueWithNewBalance.OutgoingTransactions.TryFind currency - - let! addressTransactions = currencyAddresses.TryFind address - let allCombinationsOfTransactions = MapCombinations addressTransactions - - let newAddressTransactions = - match List.tryFind (fun combination -> - let txSumAmount = List.sumBy (fun (_, (txAmount, _)) -> txAmount) combination - previousCachedBalance - txSumAmount = newBalance) - allCombinationsOfTransactions with - | None -> addressTransactions - | Some combination -> RemoveRangeFromMap addressTransactions combination - - let newOutgoingTransactions = - newCachedValueWithNewBalance.OutgoingTransactions.Add - (currency, currencyAddresses.Add (address, newAddressTransactions)) - - return { newCachedValueWithNewBalance with - OutgoingTransactions = newOutgoingTransactions - } - } - match maybeNewValue with - | None -> newCachedValueWithNewBalance - | Some x -> x + lock + cacheFiles.CachedNetworkData + (fun _ -> + let newCachedValueWithNewBalance, previousBalance = + let newCurrencyBalances, previousBalance = + match sessionCachedNetworkData.Balances.TryFind currency with + | None -> Map.empty, None + | Some currencyBalances -> + let maybePreviousBalance = currencyBalances.TryFind address + currencyBalances, maybePreviousBalance + + { sessionCachedNetworkData with + Balances = + sessionCachedNetworkData.Balances.Add + (currency, newCurrencyBalances.Add (address, (newBalance, time))) + }, + previousBalance - sessionCachedNetworkData <- newCachedValueWithNewBalanceAndMaybeLessTransactions + let newCachedValueWithNewBalanceAndMaybeLessTransactions = + let maybeNewValue = + FSharpUtil.option { + let! previousCachedBalance, _ = previousBalance - SaveNetworkDataToDisk newCachedValueWithNewBalanceAndMaybeLessTransactions + do! if newBalance <> previousCachedBalance && previousCachedBalance > newBalance then + Some () + else + None - let allTransSum = - GetSumOfAllTransactions - newCachedValueWithNewBalanceAndMaybeLessTransactions.OutgoingTransactions - currency - address + let! currencyAddresses = + newCachedValueWithNewBalance.OutgoingTransactions.TryFind currency - let compoundBalance = newBalance - allTransSum - if (compoundBalance < 0.0m) then - ReportProblem - compoundBalance - previousBalance - currency - address - newCachedValueWithNewBalanceAndMaybeLessTransactions - 0.0m, time - else - compoundBalance, time) + let! addressTransactions = currencyAddresses.TryFind address + + let allCombinationsOfTransactions = MapCombinations addressTransactions + + let newAddressTransactions = + match List.tryFind + (fun combination -> + let txSumAmount = + List.sumBy (fun (_, (txAmount, _)) -> txAmount) combination + + previousCachedBalance - txSumAmount = newBalance) + allCombinationsOfTransactions with + | None -> addressTransactions + | Some combination -> RemoveRangeFromMap addressTransactions combination + + let newOutgoingTransactions = + newCachedValueWithNewBalance.OutgoingTransactions.Add + (currency, currencyAddresses.Add (address, newAddressTransactions)) + + return + { newCachedValueWithNewBalance with + OutgoingTransactions = newOutgoingTransactions + } + } + + match maybeNewValue with + | None -> newCachedValueWithNewBalance + | Some x -> x + + sessionCachedNetworkData <- newCachedValueWithNewBalanceAndMaybeLessTransactions + + SaveNetworkDataToDisk newCachedValueWithNewBalanceAndMaybeLessTransactions + + let allTransSum = + GetSumOfAllTransactions + newCachedValueWithNewBalanceAndMaybeLessTransactions.OutgoingTransactions + currency + address + + let compoundBalance = newBalance - allTransSum + + if (compoundBalance < 0.0m) then + ReportProblem + compoundBalance + previousBalance + currency + address + newCachedValueWithNewBalanceAndMaybeLessTransactions + + 0.0m, time + else + compoundBalance, time) member private __.StoreTransactionRecord (address: PublicAddress) (currency: Currency) @@ -506,29 +528,32 @@ module Caching = (amount: decimal) : unit = let time = DateTime.UtcNow - lock cacheFiles.CachedNetworkData (fun _ -> - let newCurrencyAddresses = - match sessionCachedNetworkData.OutgoingTransactions.TryFind currency with - | None -> Map.empty - | Some currencyAddresses -> currencyAddresses - - let newAddressTransactions = - match newCurrencyAddresses.TryFind address with - | None -> Map.empty.Add (txId, (amount, time)) - | Some addressTransactions -> addressTransactions.Add (txId, (amount, time)) - - let newOutgoingTxs = - sessionCachedNetworkData.OutgoingTransactions.Add - (currency, newCurrencyAddresses.Add (address, newAddressTransactions)) - - let newCachedValue = - { sessionCachedNetworkData with - OutgoingTransactions = newOutgoingTxs - } - sessionCachedNetworkData <- newCachedValue + lock + cacheFiles.CachedNetworkData + (fun _ -> + let newCurrencyAddresses = + match sessionCachedNetworkData.OutgoingTransactions.TryFind currency with + | None -> Map.empty + | Some currencyAddresses -> currencyAddresses + + let newAddressTransactions = + match newCurrencyAddresses.TryFind address with + | None -> Map.empty.Add (txId, (amount, time)) + | Some addressTransactions -> addressTransactions.Add (txId, (amount, time)) + + let newOutgoingTxs = + sessionCachedNetworkData.OutgoingTransactions.Add + (currency, newCurrencyAddresses.Add (address, newAddressTransactions)) + + let newCachedValue = + { sessionCachedNetworkData with + OutgoingTransactions = newOutgoingTxs + } - SaveNetworkDataToDisk newCachedValue) + sessionCachedNetworkData <- newCachedValue + + SaveNetworkDataToDisk newCachedValue) member self.StoreOutgoingTransaction (address: PublicAddress) (transactionCurrency: Currency) @@ -539,71 +564,75 @@ module Caching = : unit = self.StoreTransactionRecord address transactionCurrency txId amount - if transactionCurrency - <> feeCurrency + + if transactionCurrency <> feeCurrency && (not Config.EthTokenEstimationCouldBeBuggyAsInNotAccurate) then self.StoreTransactionRecord address feeCurrency txId feeAmount member __.SaveServerLastStat (serverMatchFunc: ServerDetails -> bool) (stat: HistoryFact): unit = - lock cacheFiles.ServerStats (fun _ -> - let currency, serverInfo, previousLastSuccessfulCommunication = - match ServerRegistry.TryFindValue sessionServerRanking serverMatchFunc with - | None -> failwith "Merge&Save didn't happen before launching the FaultTolerantPClient?" - | Some (currency, server) -> - match server.CommunicationHistory with - | None -> currency, server.ServerInfo, None - | Some (prevHistoryInfo, lastComm) -> - match prevHistoryInfo.Status with - | Success -> currency, server.ServerInfo, Some lastComm - | Fault faultInfo -> currency, server.ServerInfo, faultInfo.LastSuccessfulCommunication - - let now = DateTime.Now - - let newHistoryInfo: CachedValue = - match stat.Fault with - | None -> - ({ - TimeSpan = stat.TimeSpan - Status = Success - }, - now) - | Some exInfo -> - ({ - TimeSpan = stat.TimeSpan - Status = - Fault - { - Exception = exInfo - LastSuccessfulCommunication = previousLastSuccessfulCommunication - } - }, - now) - - let newServerDetails = - { - ServerInfo = serverInfo - CommunicationHistory = Some newHistoryInfo - } + lock + cacheFiles.ServerStats + (fun _ -> + let currency, serverInfo, previousLastSuccessfulCommunication = + match ServerRegistry.TryFindValue sessionServerRanking serverMatchFunc with + | None -> failwith "Merge&Save didn't happen before launching the FaultTolerantPClient?" + | Some (currency, server) -> + match server.CommunicationHistory with + | None -> currency, server.ServerInfo, None + | Some (prevHistoryInfo, lastComm) -> + match prevHistoryInfo.Status with + | Success -> currency, server.ServerInfo, Some lastComm + | Fault faultInfo -> currency, server.ServerInfo, faultInfo.LastSuccessfulCommunication + + let now = DateTime.Now + + let newHistoryInfo: CachedValue = + match stat.Fault with + | None -> + ({ + TimeSpan = stat.TimeSpan + Status = Success + }, + now) + | Some exInfo -> + ({ + TimeSpan = stat.TimeSpan + Status = + Fault + { + Exception = exInfo + LastSuccessfulCommunication = previousLastSuccessfulCommunication + } + }, + now) + + let newServerDetails = + { + ServerInfo = serverInfo + CommunicationHistory = Some newHistoryInfo + } - let serversForCurrency = - match sessionServerRanking.TryFind currency with - | None -> Seq.empty - | Some servers -> servers + let serversForCurrency = + match sessionServerRanking.TryFind currency with + | None -> Seq.empty + | Some servers -> servers - let newServersForCurrency = Seq.append (seq { yield newServerDetails }) serversForCurrency + let newServersForCurrency = Seq.append (seq { yield newServerDetails }) serversForCurrency - let newServerList = sessionServerRanking.Add (currency, newServersForCurrency) + let newServerList = sessionServerRanking.Add (currency, newServersForCurrency) - let newCachedValue = SaveServerRankingsToDisk newServerList - sessionServerRanking <- newCachedValue) + let newCachedValue = SaveServerRankingsToDisk newServerList + sessionServerRanking <- newCachedValue) member __.GetServers (currency: Currency): seq = - lock cacheFiles.ServerStats (fun _ -> - match sessionServerRanking.TryFind currency with - | None -> - failwith - <| SPrintF1 "Initialization of servers' cache failed? currency %A not found" currency - | Some servers -> servers) + lock + cacheFiles.ServerStats + (fun _ -> + match sessionServerRanking.TryFind currency with + | None -> + failwith + <| SPrintF1 "Initialization of servers' cache failed? currency %A not found" currency + | Some servers -> servers) member __.ExportServers (): Option = lock cacheFiles.ServerStats (fun _ -> LoadFromDiskInner cacheFiles.ServerStats) @@ -631,9 +660,7 @@ module Caching = try let! content = tryDownloadFile url return Some content - with - // should we specify HttpRequestException? - ex -> + with ex -> Infrastructure.ReportWarning ex return None } @@ -668,9 +695,12 @@ module Caching = "WARNING: Couldn't reach a trusted server to retrieve server stats to bootstrap cache, running in offline mode?" | Some lastServerStatsInJson -> let lastServerStats = ImportFromJson lastServerStatsInJson - lock cacheFiles.ServerStats (fun _ -> - let savedServerStats = SaveServerRankingsToDisk lastServerStats - sessionServerRanking <- savedServerStats) + + lock + cacheFiles.ServerStats + (fun _ -> + let savedServerStats = SaveServerRankingsToDisk lastServerStats + sessionServerRanking <- savedServerStats) } member __.FirstRun = firstRun diff --git a/src/GWallet.Backend/Currency.fs b/src/GWallet.Backend/Currency.fs index 2cca5df30..16eb53a7f 100644 --- a/src/GWallet.Backend/Currency.fs +++ b/src/GWallet.Backend/Currency.fs @@ -38,7 +38,9 @@ type Currency = #endif static member Parse (currencyString: string): Currency = - Currency.GetAll().First(fun currency -> currencyString = currency.ToString ()) + Currency + .GetAll() + .First(fun currency -> currencyString = currency.ToString ()) member self.IsEther () = self = Currency.ETC || self = Currency.ETH diff --git a/src/GWallet.Backend/Ether/EtherAccount.fs b/src/GWallet.Backend/Ether/EtherAccount.fs index f44526b0e..f886ad7a8 100644 --- a/src/GWallet.Backend/Ether/EtherAccount.fs +++ b/src/GWallet.Backend/Ether/EtherAccount.fs @@ -41,18 +41,18 @@ module internal Account = if not (currency.IsEtherBased ()) then failwith <| SPrintF1 "Assertion failed: currency %A should be Ether-type" currency + match kind with | AccountKind.ReadOnly -> ReadOnlyAccount (currency, accountFile, (fun accountFile -> accountFile.Name)) :> IAccount | AccountKind.Normal -> NormalAccount (currency, accountFile, GetPublicAddressFromNormalAccountFile) :> IAccount | _ -> failwith <| SPrintF1 "Kind (%A) not supported for this API" kind - let private GetBalance - (account: IAccount) - (mode: ServerSelectionMode) - (balType: BalanceType) - (cancelSourceOption: Option) - = + let private GetBalance (account: IAccount) + (mode: ServerSelectionMode) + (balType: BalanceType) + (cancelSourceOption: Option) + = async { let! balance = if (account.Currency.IsEther ()) then @@ -66,27 +66,25 @@ module internal Account = return balance } - let private GetBalanceFromServer - (account: IAccount) - (balType: BalanceType) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async> - = + let private GetBalanceFromServer (account: IAccount) + (balType: BalanceType) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async> = async { try let! balance = GetBalance account mode balType cancelSourceOption return Some balance - with ex when (FSharpUtil.FindException ex).IsSome -> return None + with ex when (FSharpUtil.FindException ex) + .IsSome -> return None } - let internal GetShowableBalance - (account: IAccount) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async> - = - let getBalanceWithoutCaching (maybeUnconfirmedBalanceTaskAlreadyStarted: Option>>): Async> = + let internal GetShowableBalance (account: IAccount) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async> = + let getBalanceWithoutCaching (maybeUnconfirmedBalanceTaskAlreadyStarted: Option>>) + : Async> = async { let! confirmed = GetBalanceFromServer account BalanceType.Confirmed mode cancelSourceOption @@ -162,7 +160,7 @@ module internal Account = failwith <| SPrintF1 "Serialization doesn't support such a big integer (%s) for the nonce, please report this issue." - (result.ToString ()) + (result.ToString ()) let int64result: Int64 = BigInteger.op_Explicit value @@ -177,7 +175,7 @@ module internal Account = failwith <| SPrintF1 "Serialization doesn't support such a big integer (%s) for the gas, please report this issue." - (gasPrice.Value.ToString ()) + (gasPrice.Value.ToString ()) let gasPrice64: Int64 = BigInteger.op_Explicit gasPrice.Value @@ -197,15 +195,15 @@ module internal Account = let feeValue = ethMinerFee.CalculateAbsoluteValue () - if (amount.ValueToSend - <> amount.BalanceAtTheMomentOfSending + if (amount.ValueToSend <> amount.BalanceAtTheMomentOfSending && feeValue > (amount.BalanceAtTheMomentOfSending - amount.ValueToSend)) then raise <| InsufficientBalanceForFee (Some feeValue) - return { - Ether.Fee = ethMinerFee - Ether.TransactionCount = txCount - } + return + { + Ether.Fee = ethMinerFee + Ether.TransactionCount = txCount + } } // FIXME: this should raise InsufficientBalanceForFee @@ -225,7 +223,7 @@ module internal Account = failwith <| SPrintF1 "Serialization doesn't support such a big integer (%s) for the gas cost of the token transfer, please report this issue." - (tokenTransferFee.Value.ToString ()) + (tokenTransferFee.Value.ToString ()) let gasCost64: Int64 = BigInteger.op_Explicit tokenTransferFee.Value @@ -233,10 +231,11 @@ module internal Account = let! txCount = GetTransactionCount account.Currency account.PublicAddress - return { - Ether.Fee = ethMinerFee - Ether.TransactionCount = txCount - } + return + { + Ether.Fee = ethMinerFee + Ether.TransactionCount = txCount + } } let EstimateFee (account: IAccount) (amount: TransferAmount) destination: Async = @@ -246,8 +245,9 @@ module internal Account = elif account.Currency.IsEthToken () then return! EstimateTokenTransferFee account amount.ValueToSend destination else - return failwith - <| SPrintF1 "Assertion failed: currency %A should be Ether or Ether token" account.Currency + return + failwith + <| SPrintF1 "Assertion failed: currency %A should be Ether or Ether token" account.Currency } let private BroadcastRawTransaction (currency: Currency) trans = @@ -270,6 +270,7 @@ module internal Account = if not (currency.IsEtherBased ()) then failwith <| SPrintF1 "Assertion failed: currency %A should be Ether-type" currency + if currency.IsEthToken () || currency = ETH then Config.EthNet elif currency = ETC then @@ -278,22 +279,22 @@ module internal Account = failwith <| SPrintF1 "Assertion failed: Ether currency %A not supported?" currency - let private SignEtherTransaction - (currency: Currency) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (privateKey: EthECKey) - = + let private SignEtherTransaction (currency: Currency) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (privateKey: EthECKey) + = let chain = GetNetwork currency + if (GetNetwork txMetadata.Fee.Currency <> chain) then invalidArg "chain" (SPrintF2 "Assertion failed: fee currency (%A) chain doesn't match with passed chain (%A)" - txMetadata.Fee.Currency - chain) + txMetadata.Fee.Currency + chain) let amountToSendConsideringMinerFee = if (amount.ValueToSend = amount.BalanceAtTheMomentOfSending) then @@ -323,14 +324,13 @@ module internal Account = trans - let private SignEtherTokenTransaction - (currency: Currency) - (txMetadata: TransactionMetadata) - (origin: string) - (destination: string) - (amount: TransferAmount) - (privateKey: EthECKey) - = + let private SignEtherTokenTransaction (currency: Currency) + (txMetadata: TransactionMetadata) + (origin: string) + (destination: string) + (amount: TransferAmount) + (privateKey: EthECKey) + = let chain = GetNetwork currency let privKeyInBytes = privateKey.GetPrivateKeyAsBytes () @@ -349,13 +349,12 @@ module internal Account = signer.SignTransaction (privKeyInBytes, chain, contractAddress, etherValue, nonce, gasPrice, gasLimit, data) - let private SignTransactionWithPrivateKey - (account: IAccount) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (privateKey: EthECKey) - = + let private SignTransactionWithPrivateKey (account: IAccount) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (privateKey: EthECKey) + = let trans = if account.Currency.IsEthToken () then @@ -371,25 +370,27 @@ module internal Account = failwith <| SPrintF2 "Assertion failed: fee currency (%A) doesn't match with passed chain (%A)" - txMetadata.Fee.Currency - account.Currency + txMetadata.Fee.Currency + account.Currency + SignEtherTransaction account.Currency txMetadata destination amount privateKey else failwith <| SPrintF1 "Assertion failed: Ether currency %A not supported?" account.Currency let chain = GetNetwork account.Currency + if not (signer.VerifyTransaction (trans, chain)) then failwith "Transaction could not be verified?" + trans - let SignTransaction - (account: NormalAccount) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (password: string) - = + let SignTransaction (account: NormalAccount) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (password: string) + = let privateKey = GetPrivateKey account password SignTransactionWithPrivateKey account txMetadata destination amount privateKey @@ -397,12 +398,11 @@ module internal Account = let CheckValidPassword (account: NormalAccount) (password: string) = GetPrivateKey account password |> ignore - let SweepArchivedFunds - (account: ArchivedAccount) - (balance: decimal) - (destination: IAccount) - (txMetadata: TransactionMetadata) - = + let SweepArchivedFunds (account: ArchivedAccount) + (balance: decimal) + (destination: IAccount) + (txMetadata: TransactionMetadata) + = let accountFrom = (account :> IAccount) let amount = TransferAmount (balance, balance, accountFrom.Currency) let ecPrivKey = EthECKey (account.GetUnencryptedPrivateKey ()) @@ -412,14 +412,14 @@ module internal Account = BroadcastRawTransaction accountFrom.Currency signedTrans - let SendPayment - (account: NormalAccount) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (password: string) - = + let SendPayment (account: NormalAccount) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (password: string) + = let baseAccount = account :> IAccount + if (baseAccount.PublicAddress.Equals (destination, StringComparison.InvariantCultureIgnoreCase)) then raise DestinationEqualToOrigin @@ -432,6 +432,7 @@ module internal Account = let private CreateInternal (password: string) (seed: array): FileRepresentation = let privateKey = EthECKey (seed, true) let publicAddress = privateKey.GetPublicAddress () + if not (addressUtil.IsChecksumAddress (publicAddress)) then failwith ("Nethereum's GetPublicAddress gave a non-checksum address: " + publicAddress) @@ -451,17 +452,18 @@ module internal Account = let public ExportUnsignedTransactionToJson trans = Marshalling.Serialize trans - let SaveUnsignedTransaction - (transProposal: UnsignedTransactionProposal) - (txMetadata: TransactionMetadata) - (readOnlyAccounts: seq) - : string - = + let SaveUnsignedTransaction (transProposal: UnsignedTransactionProposal) + (txMetadata: TransactionMetadata) + (readOnlyAccounts: seq) + : string = let unsignedTransaction = { Proposal = transProposal - Cache = Caching.Instance.GetLastCachedData().ToDietCache readOnlyAccounts + Cache = + Caching + .Instance + .GetLastCachedData().ToDietCache readOnlyAccounts Metadata = txMetadata } diff --git a/src/GWallet.Backend/Ether/EtherServer.fs b/src/GWallet.Backend/Ether/EtherServer.fs index 4a6808f26..32f5af32d 100644 --- a/src/GWallet.Backend/Ether/EtherServer.fs +++ b/src/GWallet.Backend/Ether/EtherServer.fs @@ -70,10 +70,12 @@ module Server = let private Web3Server (serverDetails: ServerDetails) = match serverDetails.ServerInfo.ConnectionType with - | { Protocol = Tcp _; Encrypted = _ } -> + | { Protocol = Tcp _ + Encrypted = _ } -> failwith <| SPrintF1 "Ether server of TCP connection type?: %s" serverDetails.ServerInfo.NetworkPath - | { Protocol = Http; Encrypted = encrypted } -> + | { Protocol = Http + Encrypted = encrypted } -> let protocol = if encrypted then "https" @@ -95,13 +97,15 @@ module Server = match maybeResult with | None -> - return raise - <| ServerTimedOutException ("Timeout when trying to communicate with Ether server") + return + raise + <| ServerTimedOutException ("Timeout when trying to communicate with Ether server") | Some result -> return result } let MaybeRethrowWebException (ex: Exception): unit = let maybeWebEx = FSharpUtil.FindException ex + match maybeWebEx with | Some webEx -> @@ -111,15 +115,19 @@ module Server = if webEx.Status = WebExceptionStatus.NameResolutionFailure then raise <| ServerCannotBeResolvedException (exMsg, webEx) + if webEx.Status = WebExceptionStatus.ReceiveFailure then raise <| ServerTimedOutException (exMsg, webEx) + if webEx.Status = WebExceptionStatus.ConnectFailure then raise <| ServerUnreachableException (exMsg, webEx) if webEx.Status = WebExceptionStatus.SecureChannelFailure then raise <| ServerChannelNegotiationException (exMsg, webEx.Status, webEx) + if webEx.Status = WebExceptionStatus.RequestCanceled then raise <| ServerChannelNegotiationException (exMsg, webEx.Status, webEx) + if webEx.Status = WebExceptionStatus.TrustFailure then raise <| ServerChannelNegotiationException (exMsg, webEx.Status, webEx) @@ -129,10 +137,12 @@ module Server = let MaybeRethrowHttpRequestException (ex: Exception): unit = let maybeHttpReqEx = FSharpUtil.FindException ex + match maybeHttpReqEx with | Some httpReqEx -> if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.ConnectionTimeOut) then raise <| ServerTimedOutException (exMsg, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.OriginUnreachable) then raise <| ServerTimedOutException (exMsg, httpReqEx) @@ -143,9 +153,11 @@ module Server = if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.WebServerDown) then raise <| ServerUnreachableException (exMsg, CloudFlareError.WebServerDown, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.BadGateway) then raise <| ServerUnreachableException (exMsg, HttpStatusCode.BadGateway, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.GatewayTimeout) then raise <| ServerUnreachableException (exMsg, HttpStatusCode.GatewayTimeout, httpReqEx) @@ -156,27 +168,34 @@ module Server = // TODO: maybe in these cases below, blacklist the server somehow if it keeps giving this error: if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.Forbidden) then raise <| ServerMisconfiguredException (exMsg, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.Unauthorized) then raise <| ServerMisconfiguredException (exMsg, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.MethodNotAllowed) then raise <| ServerMisconfiguredException (exMsg, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.InternalServerError) then raise <| ServerUnavailableException (exMsg, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.NotFound) then raise <| ServerUnavailableException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCodeNotPresentInTheBcl.TooManyRequests) then raise <| ServerRestrictiveException (exMsg, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCodeNotPresentInTheBcl.FrozenSite) then raise <| ServerUnavailableException (exMsg, httpReqEx) // weird "IOException: The server returned an invalid or unrecognized response." since Mono 6.4.x (vs16.3) - if (FSharpUtil.FindException httpReqEx).IsSome then + if (FSharpUtil.FindException httpReqEx) + .IsSome then raise <| ServerMisconfiguredException (exMsg, httpReqEx) | _ -> () let MaybeRethrowRpcResponseException (ex: Exception): unit = let maybeRpcResponseEx = FSharpUtil.FindException ex + match maybeRpcResponseEx with | Some rpcResponseEx -> if rpcResponseEx.RpcError <> null then @@ -188,35 +207,41 @@ module Server = <| Exception (SPrintF2 "Expecting 'pruning=archive' or 'missing trie node' or 'header not found' in message of a %d code, but got '%s'" - (int RpcErrorCode.StatePruningNodeOrMissingTrieNodeOrHeaderNotFound) - rpcResponseEx.RpcError.Message, + (int RpcErrorCode.StatePruningNodeOrMissingTrieNodeOrHeaderNotFound) + rpcResponseEx.RpcError.Message, rpcResponseEx) else raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) + if (rpcResponseEx.RpcError.Code = int RpcErrorCode.UnknownBlockNumber) then raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) + if rpcResponseEx.RpcError.Code = int RpcErrorCode.GatewayTimeout then raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) + if rpcResponseEx.RpcError.Code = int RpcErrorCode.EmptyResponse then raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) + raise <| Exception (SPrintF3 "RpcResponseException with RpcError Code <%i> and Message '%s' (%s)" - rpcResponseEx.RpcError.Code - rpcResponseEx.RpcError.Message - rpcResponseEx.Message, + rpcResponseEx.RpcError.Code + rpcResponseEx.RpcError.Message + rpcResponseEx.Message, rpcResponseEx) | None -> () let MaybeRethrowRpcClientTimeoutException (ex: Exception): unit = let maybeRpcTimeoutException = FSharpUtil.FindException ex + match maybeRpcTimeoutException with | Some rpcTimeoutEx -> raise <| ServerTimedOutException (exMsg, rpcTimeoutEx) | None -> () let MaybeRethrowNetworkingException (ex: Exception): unit = let maybeSocketRewrappedException = Networking.FindExceptionToRethrow ex exMsg + match maybeSocketRewrappedException with | Some socketRewrappedException -> raise socketRewrappedException | None -> () @@ -224,9 +249,11 @@ module Server = // this could be a Xamarin.Android bug (see https://gitlab.gnome.org/World/geewallet/issues/119) let MaybeRethrowObjectDisposedException (ex: Exception): unit = let maybeRpcUnknownEx = FSharpUtil.FindException ex + match maybeRpcUnknownEx with | Some _ -> let maybeObjectDisposedEx = FSharpUtil.FindException ex + match maybeObjectDisposedEx with | Some objectDisposedEx -> if objectDisposedEx.Message.Contains "MobileAuthenticatedStream" then @@ -236,6 +263,7 @@ module Server = let MaybeRethrowInnerRpcException (ex: Exception): unit = let maybeRpcUnknownEx = FSharpUtil.FindException ex + match maybeRpcUnknownEx with | Some rpcUnknownEx -> @@ -248,10 +276,12 @@ module Server = // this SSL exception could be a mono 6.0.x bug (see https://gitlab.com/knocte/geewallet/issues/121) let maybeHttpReqEx = FSharpUtil.FindException ex + match maybeHttpReqEx with | Some httpReqEx -> if httpReqEx.Message.Contains "SSL" then let maybeIOEx = FSharpUtil.FindException ex + match maybeIOEx with | Some ioEx -> raise <| ProtocolGlitchException (ioEx.Message, ex) | None -> @@ -286,11 +316,10 @@ module Server = | ServerSelectionMode.Fast -> 3u | ServerSelectionMode.Analysis -> 2u - let private FaultTolerantParallelClientInnerSettings - (numberOfConsistentResponsesRequired: uint32) - (mode: ServerSelectionMode) - maybeConsistencyConfig - = + let private FaultTolerantParallelClientInnerSettings (numberOfConsistentResponsesRequired: uint32) + (mode: ServerSelectionMode) + maybeConsistencyConfig + = let consistencyConfig = match maybeConsistencyConfig with @@ -322,11 +351,10 @@ module Server = FaultTolerantParallelClientInnerSettings numberOfConsistentResponsesRequired mode - let private FaultTolerantParallelClientSettingsForBalanceCheck - (mode: ServerSelectionMode) - (currency: Currency) - (cacheOrInitialBalanceMatchFunc: decimal -> bool) - = + let private FaultTolerantParallelClientSettingsForBalanceCheck (mode: ServerSelectionMode) + (currency: Currency) + (cacheOrInitialBalanceMatchFunc: decimal -> bool) + = let consistencyConfig = if etcEcosystemIsMomentarilyCentralized && currency = Currency.ETC then None @@ -360,6 +388,7 @@ module Server = async { let web3Server = Web3Server server + try return! HandlePossibleEtherFailures (web3ClientFunc web3Server) @@ -369,23 +398,19 @@ module Server = let msg = SPrintF2 "%s: %s" (ex.GetType().FullName) ex.Message return raise <| ServerDiscardedException (msg, ex) | ex -> - return raise - <| Exception - (SPrintF1 "Some problem when connecting to '%s'" server.ServerInfo.NetworkPath, ex) + return + raise + <| Exception (SPrintF1 "Some problem when connecting to '%s'" server.ServerInfo.NetworkPath, ex) } // FIXME: seems there's some code duplication between this function and UtxoCoinAccount.fs's GetServerFuncs function // and room for simplification to not pass a new ad-hoc delegate? - let GetServerFuncs<'R> - (web3Func: SomeWeb3 -> Async<'R>) - (etherServers: seq) - : seq> - = - let Web3ServerToGenericServer - (web3ClientFunc: SomeWeb3 -> Async<'R>) - (etherServer: ServerDetails) - : Server - = + let GetServerFuncs<'R> (web3Func: SomeWeb3 -> Async<'R>) + (etherServers: seq) + : seq> = + let Web3ServerToGenericServer (web3ClientFunc: SomeWeb3 -> Async<'R>) + (etherServer: ServerDetails) + : Server = { Details = etherServer Retrieval = Web3ServerToRetrievalFunc etherServer web3ClientFunc @@ -394,11 +419,9 @@ module Server = let serverFuncs = Seq.map (Web3ServerToGenericServer web3Func) etherServers serverFuncs - let private GetRandomizedFuncs<'R> - (currency: Currency) - (web3Func: SomeWeb3 -> Async<'R>) - : List> - = + let private GetRandomizedFuncs<'R> (currency: Currency) + (web3Func: SomeWeb3 -> Async<'R>) + : List> = let etherServers = Web3ServerSeedList.Randomize currency GetServerFuncs web3Func etherServers |> List.ofSeq @@ -417,9 +440,10 @@ module Server = GetRandomizedFuncs currency web3Func - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) + web3Funcs } let private NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED = BigInteger (45) @@ -479,14 +503,12 @@ module Server = | None -> false | Some balance -> someRetrievedBalance = balance - let GetEtherBalance - (currency: Currency) - (address: string) - (balType: BalanceType) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async - = + let GetEtherBalance (currency: Currency) + (address: string) + (balType: BalanceType) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async = async { let web3Funcs = let web3Func (web3: Web3): Async = @@ -514,15 +536,19 @@ module Server = | None -> faultTolerantEtherClient.Query | Some cancelSource -> faultTolerantEtherClient.QueryWithCancellation cancelSource - return! query - (FaultTolerantParallelClientSettingsForBalanceCheck - mode - currency - (BalanceMatchWithCacheOrInitialBalance address currency)) - web3Funcs + return! + query + (FaultTolerantParallelClientSettingsForBalanceCheck + mode + currency + (BalanceMatchWithCacheOrInitialBalance address currency)) + web3Funcs } - let private GetConfirmedTokenBalanceInternal (web3: Web3) (publicAddress: string) (currency: Currency): Async = + let private GetConfirmedTokenBalanceInternal (web3: Web3) + (publicAddress: string) + (currency: Currency) + : Async = if (web3 = null) then invalidArg "web3" "web3 argument should not be null" @@ -549,14 +575,12 @@ module Server = } - let GetTokenBalance - (currency: Currency) - (address: string) - (balType: BalanceType) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async - = + let GetTokenBalance (currency: Currency) + (address: string) + (balType: BalanceType) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async = async { let web3Funcs = let web3Func (web3: Web3): Async = @@ -564,6 +588,7 @@ module Server = | BalanceType.Confirmed -> GetConfirmedTokenBalanceInternal web3 address currency | BalanceType.Unconfirmed -> let tokenService = TokenManager.TokenServiceWrapper (web3, currency) + async { let! cancelToken = Async.CancellationToken let task = tokenService.BalanceOfQueryAsync (address, null, cancelToken) @@ -578,12 +603,13 @@ module Server = | None -> faultTolerantEtherClient.Query | Some cancelSource -> faultTolerantEtherClient.QueryWithCancellation cancelSource - return! query - (FaultTolerantParallelClientSettingsForBalanceCheck - mode - currency - (BalanceMatchWithCacheOrInitialBalance address currency)) - web3Funcs + return! + query + (FaultTolerantParallelClientSettingsForBalanceCheck + mode + currency + (BalanceMatchWithCacheOrInitialBalance address currency)) + web3Funcs } let EstimateTokenTransferFee (account: IAccount) (amount: decimal) destination: Async = @@ -608,15 +634,17 @@ module Server = GetRandomizedFuncs account.Currency web3Func - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast account.Currency None) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast account.Currency None) + web3Funcs } let private AverageGasPrice (gasPricesFromDifferentServers: List): HexBigInteger = let sum = - gasPricesFromDifferentServers.Select(fun hbi -> hbi.Value) - .Aggregate(fun bi1 bi2 -> BigInteger.Add (bi1, bi2)) + gasPricesFromDifferentServers + .Select(fun hbi -> hbi.Value) + .Aggregate(fun bi1 bi2 -> BigInteger.Add (bi1, bi2)) let avg = BigInteger.Divide (sum, BigInteger (gasPricesFromDifferentServers.Length)) HexBigInteger (avg) @@ -639,12 +667,13 @@ module Server = else 2u - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings - ServerSelectionMode.Fast - currency - (Some (AverageBetweenResponses (minResponsesRequired, AverageGasPrice)))) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings + ServerSelectionMode.Fast + currency + (Some (AverageBetweenResponses (minResponsesRequired, AverageGasPrice)))) + web3Funcs } let BroadcastTransaction (currency: Currency) (transaction: string): Async = @@ -678,11 +707,9 @@ module Server = return raise (FSharpUtil.ReRaise ex) } - let private GetTransactionDetailsFromTransactionReceipt - (currency: Currency) - (txHash: string) - : Async - = + let private GetTransactionDetailsFromTransactionReceipt (currency: Currency) + (txHash: string) + : Async = async { let web3Funcs = let web3Func (web3: Web3): Async = @@ -694,17 +721,19 @@ module Server = let! transactionReceipt = Async.AwaitTask task - return { - GasUsed = transactionReceipt.GasUsed.Value - Status = transactionReceipt.Status.Value - } + return + { + GasUsed = transactionReceipt.GasUsed.Value + Status = transactionReceipt.Status.Value + } } GetRandomizedFuncs currency web3Func - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) + web3Funcs } let IsOutOfGas (currency: Currency) (txHash: string) (spentGas: int64): Async = @@ -712,8 +741,9 @@ module Server = let! transactionStatusDetails = GetTransactionDetailsFromTransactionReceipt currency txHash let failureStatus = BigInteger.Zero - return transactionStatusDetails.Status = failureStatus - && transactionStatusDetails.GasUsed = BigInteger (spentGas) + return + transactionStatusDetails.Status = failureStatus + && transactionStatusDetails.GasUsed = BigInteger (spentGas) } let private GetContractCode (baseCurrency: Currency) (address: string): Async = @@ -728,9 +758,10 @@ module Server = GetRandomizedFuncs baseCurrency web3Func - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast baseCurrency None) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast baseCurrency None) + web3Funcs } let CheckIfAddressIsAValidPaymentDestination (currency: Currency) (address: string): Async = @@ -742,11 +773,12 @@ module Server = failwith <| SPrintF2 "GetCode API should always return a string starting with %s, but got: %s" - emptyContract - contractCode + emptyContract + contractCode elif contractCode <> emptyContract then - return raise - <| InvalidDestinationAddress - "Sending to contract addresses is not supported yet. Supply a normal address please." + return + raise + <| InvalidDestinationAddress + "Sending to contract addresses is not supported yet. Supply a normal address please." } diff --git a/src/GWallet.Backend/FSharpUtil.fs b/src/GWallet.Backend/FSharpUtil.fs index 7082440d5..2f18a361d 100644 --- a/src/GWallet.Backend/FSharpUtil.fs +++ b/src/GWallet.Backend/FSharpUtil.fs @@ -182,6 +182,7 @@ module FSharpUtil = let! allJobsStarted = allJobsInParallel let! _ = Async.AwaitTask taskSource.Task + return allJobsStarted } diff --git a/src/GWallet.Backend/FaultTolerantParallelClient.fs b/src/GWallet.Backend/FaultTolerantParallelClient.fs index 9973f8e82..7e81c8694 100644 --- a/src/GWallet.Backend/FaultTolerantParallelClient.fs +++ b/src/GWallet.Backend/FaultTolerantParallelClient.fs @@ -29,9 +29,9 @@ type ResultInconsistencyException (totalNumberOfSuccesfulResultsObtained: int, inherit Exception("Results obtained were not enough to be considered consistent" + SPrintF3 " (received: %i, consistent: %i, required: %i)" - totalNumberOfSuccesfulResultsObtained - maxNumberOfConsistentResultsObtained - numberOfConsistentResultsRequired) + totalNumberOfSuccesfulResultsObtained + maxNumberOfConsistentResultsObtained + numberOfConsistentResultsRequired) type UnsuccessfulServer<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = { @@ -96,7 +96,9 @@ type MutableStateUnsafeAccessor<'T> (initialState: 'T) = type MutableStateCapsule<'T> (initialState: 'T) = let state = MutableStateUnsafeAccessor initialState let lockObject = Object () - member __.SafeDo (func: MutableStateUnsafeAccessor<'T> -> 'R): 'R = lock lockObject (fun _ -> func state) + + member __.SafeDo (func: MutableStateUnsafeAccessor<'T> -> 'R): 'R = + lock lockObject (fun _ -> func state) type ServerJob<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = { @@ -154,6 +156,7 @@ type internal Runner<'Resource when 'Resource: equality> = && cancelState.SafeDo (fun state -> isLateEnoughToReportProblem state.Value) let maybeSpecificEx = FSharpUtil.FindException<'Ex> ex + match maybeSpecificEx with | Some specificInnerEx -> if report then @@ -208,11 +211,12 @@ type internal Runner<'Resource when 'Resource: equality> = updateServer (fun srv -> srv = server.Details) historyFact - return Failure - { - Server = server - Failure = ex - } + return + Failure + { + Server = server + Failure = ex + } } { @@ -235,6 +239,7 @@ type internal Runner<'Resource when 'Resource: equality> = updateServerFunc let jobs = funcs |> Seq.map launchFunc |> List.ofSeq + if parallelJobs < uint32 jobs.Length then List.splitAt (int parallelJobs) jobs else @@ -250,18 +255,25 @@ type CustomCancelSource () = let lockObj = Object () member __.Cancel () = - lock lockObj (fun _ -> - if canceledAlready then - raise <| ObjectDisposedException "Already canceled/disposed" - canceledAlready <- true) + lock + lockObj + (fun _ -> + if canceledAlready then + raise <| ObjectDisposedException "Already canceled/disposed" + + canceledAlready <- true) + canceled.Trigger () [] member __.Canceled = - lock lockObj (fun _ -> - if canceledAlready then - raise <| AlreadyCanceled - canceled.Publish) + lock + lockObj + (fun _ -> + if canceledAlready then + raise <| AlreadyCanceled + + canceled.Publish) interface IDisposable with member self.Dispose () = @@ -303,24 +315,23 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati serverTask - let rec WhenSomeInternal - (consistencySettings: Option>) - (initialServerCount: uint32) - (startedTasks: List>) - (jobsToLaunchLater: List>) - (resultsSoFar: List<'R>) - (failedFuncsSoFar: List>) - (cancellationSource: Option) - (cancelState: ClientCancelState) - : Async> - = + let rec WhenSomeInternal (consistencySettings: Option>) + (initialServerCount: uint32) + (startedTasks: List>) + (jobsToLaunchLater: List>) + (resultsSoFar: List<'R>) + (failedFuncsSoFar: List>) + (cancellationSource: Option) + (cancelState: ClientCancelState) + : Async> = async { if startedTasks = List.Empty then - return InconsistentOrNotEnoughResults - { - SuccessfulResults = resultsSoFar - UnsuccessfulServers = failedFuncsSoFar - } + return + InconsistentOrNotEnoughResults + { + SuccessfulResults = resultsSoFar + UnsuccessfulServers = failedFuncsSoFar + } else let jobToWaitForFirstFinishedTask = ServerTask.WhenAny startedTasks let! fastestTask = jobToWaitForFirstFinishedTask @@ -339,16 +350,17 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati | [] -> restOfTasks, List.Empty | head :: tail -> let maybeNewTask = - cancelState.SafeDo (fun state -> - let resultingTask = - match state.Value with - | Alive cancelSources -> - let newTask = LaunchAsyncJob head - state.Value <- Alive (newTask.CancellationTokenSource :: cancelSources) - Some newTask - | Canceled _ -> None - - resultingTask) + cancelState.SafeDo + (fun state -> + let resultingTask = + match state.Value with + | Alive cancelSources -> + let newTask = LaunchAsyncJob head + state.Value <- Alive (newTask.CancellationTokenSource :: cancelSources) + Some newTask + | Canceled _ -> None + + resultingTask) match maybeNewTask with | Some newTask -> newTask :: restOfTasks, tail @@ -357,17 +369,19 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati let returnWithConsistencyOf (minNumberOfConsistentResultsRequired: Option) cacheMatchFunc = async { let resultsSortedByCount = MeasureConsistency newResults + match resultsSortedByCount with | [] -> - return! WhenSomeInternal - consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState + return! + WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState | (mostConsistentResult, maxNumberOfConsistentResultsObtained) :: _ -> match minNumberOfConsistentResultsRequired, cacheMatchFunc with | None, None -> return ConsistentResult mostConsistentResult @@ -376,15 +390,16 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati || (maxNumberOfConsistentResultsObtained = int number) then return ConsistentResult mostConsistentResult else - return! WhenSomeInternal - consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState + return! + WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState | _ -> return failwith "should be either both None or both Some!" } @@ -393,15 +408,16 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati if (newResults.Length >= int minimumNumberOfResponses) then return AverageResult (averageFunc newResults) else - return! WhenSomeInternal - consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState + return! + WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState | Some (SpecificNumberOfConsistentResponsesRequired number) -> return! returnWithConsistencyOf (Some number) ((fun _ -> false) |> Some) | Some (OneServerConsistentWithCertainValueOrTwoServers cacheMatchFunc) -> @@ -416,47 +432,46 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati Infrastructure.LogDebug (SPrintF1 "%f%% done (for this currency)" - (100. - * (float (newFailedFuncs.Length + newResults.Length)) - / (float initialServerCount))) - - return! WhenSomeInternal - consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState + (100. * (float (newFailedFuncs.Length + newResults.Length)) + / (float initialServerCount))) + + return! + WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState } let CancelAndDispose (cancelState: ClientCancelState) = - cancelState.SafeDo (fun state -> - match state.Value with - | Canceled _ -> () - | Alive cancelSources -> - for cancelSource in cancelSources do - try - cancelSource.Cancel () - cancelSource.Dispose () - with :? ObjectDisposedException -> () + cancelState.SafeDo + (fun state -> + match state.Value with + | Canceled _ -> () + | Alive cancelSources -> + for cancelSource in cancelSources do + try + cancelSource.Cancel () + cancelSource.Dispose () + with :? ObjectDisposedException -> () - state.Value <- Canceled DateTime.UtcNow) + state.Value <- Canceled DateTime.UtcNow) // at the time of writing this, I only found a Task.WhenAny() equivalent function in the asyncF# world, called // "Async.WhenAny" in TomasP's tryJoinads source code, however it seemed a bit complex for me to wrap my head around // it (and I couldn't just consume it and call it a day, I had to modify it to be "WhenSome" instead of "WhenAny", // as in when N>1), so I decided to write my own, using Tasks to make sure I would not spawn duplicate jobs - let WhenSome - (settings: FaultTolerantParallelClientSettings<'R>) - consistencyConfig - (funcs: List>) - (resultsSoFar: List<'R>) - (failedFuncsSoFar: List>) - (cancellationSource: Option) - : Async> - = + let WhenSome (settings: FaultTolerantParallelClientSettings<'R>) + consistencyConfig + (funcs: List>) + (resultsSoFar: List<'R>) + (failedFuncsSoFar: List>) + (cancellationSource: Option) + : Async> = let initialServerCount = funcs.Length |> uint32 @@ -468,18 +483,19 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati let cancelState = ClientCancelState (Alive List.empty) let maybeJobs = - cancelState.SafeDo (fun state -> - match state.Value with - | Canceled _ -> None - | Alive _ -> - Some - <| Runner<'R>.CreateJobs<'K, 'E> - shouldReportUncanceledJobs - settings.NumberOfParallelJobsAllowed - settings.ExceptionHandler - updateServer - funcs - cancelState) + cancelState.SafeDo + (fun state -> + match state.Value with + | Canceled _ -> None + | Alive _ -> + Some + <| Runner<'R>.CreateJobs<'K, 'E> + shouldReportUncanceledJobs + settings.NumberOfParallelJobsAllowed + settings.ExceptionHandler + updateServer + funcs + cancelState) let startedTasks, jobsToLaunchLater = match maybeJobs with @@ -493,16 +509,18 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati with AlreadyCanceled -> raise <| TaskCanceledException ("Found canceled when about to subscribe to cancellation") - cancelState.SafeDo (fun state -> - match state.Value with - | Canceled _ -> raise <| TaskCanceledException "Found canceled when about to launch more tasks" - | Alive currentList -> - let startedTasks = firstJobsToLaunch |> List.map (fun job -> LaunchAsyncJob job) - let newCancelSources = startedTasks |> List.map (fun task -> task.CancellationTokenSource) + cancelState.SafeDo + (fun state -> + match state.Value with + | Canceled _ -> raise <| TaskCanceledException "Found canceled when about to launch more tasks" + | Alive currentList -> + let startedTasks = firstJobsToLaunch |> List.map (fun job -> LaunchAsyncJob job) + + let newCancelSources = startedTasks |> List.map (fun task -> task.CancellationTokenSource) - state.Value <- Alive (List.append currentList newCancelSources) - startedTasks, jobsToLaunchLater) + state.Value <- Alive (List.append currentList newCancelSources) + startedTasks, jobsToLaunchLater) let job = WhenSomeInternal @@ -526,20 +544,19 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati jobWithCancellation - let rec QueryInternalImplementation - (settings: FaultTolerantParallelClientSettings<'R>) - (initialFuncCount: uint32) - (funcs: List>) - (resultsSoFar: List<'R>) - (failedFuncsSoFar: List>) - (retries: uint32) - (retriesForInconsistency: uint32) - (cancellationSource: Option) - : Async<'R> - = + let rec QueryInternalImplementation (settings: FaultTolerantParallelClientSettings<'R>) + (initialFuncCount: uint32) + (funcs: List>) + (resultsSoFar: List<'R>) + (failedFuncsSoFar: List>) + (retries: uint32) + (retriesForInconsistency: uint32) + (cancellationSource: Option) + : Async<'R> = async { if not (funcs.Any ()) then return raise (ArgumentException ("number of funcs must be higher than zero", "funcs")) + let howManyFuncs = uint32 funcs.Length let numberOfParallelJobsAllowed = int settings.NumberOfParallelJobsAllowed @@ -548,19 +565,23 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati match resultSelectionSettings.ConsistencyConfig with | SpecificNumberOfConsistentResponsesRequired numberOfConsistentResponsesRequired -> if numberOfConsistentResponsesRequired < 1u then - return raise - <| ArgumentException ("must be higher than zero", "numberOfConsistentResponsesRequired") + return + raise + <| ArgumentException ("must be higher than zero", "numberOfConsistentResponsesRequired") + if (howManyFuncs < numberOfConsistentResponsesRequired) then - return raise - (ArgumentException - ("number of funcs must be equal or higher than numberOfConsistentResponsesRequired", - "funcs")) + return + raise + (ArgumentException + ("number of funcs must be equal or higher than numberOfConsistentResponsesRequired", + "funcs")) | AverageBetweenResponses (minimumNumberOfResponses, _) -> if (int minimumNumberOfResponses > numberOfParallelJobsAllowed) then - return raise - (ArgumentException - ("numberOfParallelJobsAllowed should be equal or higher than minimumNumberOfResponses for the averageFunc", - "settings")) + return + raise + (ArgumentException + ("numberOfParallelJobsAllowed should be equal or higher than minimumNumberOfResponses for the averageFunc", + "settings")) | OneServerConsistentWithCertainValueOrTwoServers _ -> () | _ -> () @@ -584,18 +605,24 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati if executedServers.SuccessfulResults.Length = 0 then if (retries = settings.NumberOfRetries) then - let firstEx = executedServers.UnsuccessfulServers.First().Failure + let firstEx = + executedServers + .UnsuccessfulServers + .First() + .Failure + return raise (NoneAvailableException ("Not available", firstEx)) else - return! QueryInternalImplementation - settings - initialFuncCount - failedFuncs - executedServers.SuccessfulResults - List.Empty - (retries + 1u) - retriesForInconsistency - cancellationSource + return! + QueryInternalImplementation + settings + initialFuncCount + failedFuncs + executedServers.SuccessfulResults + List.Empty + (retries + 1u) + retriesForInconsistency + cancellationSource else let totalNumberOfSuccesfulResultsObtained = executedServers.SuccessfulResults.Length @@ -610,85 +637,105 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati match wrappedSettings with | Some (SpecificNumberOfConsistentResponsesRequired numberOfConsistentResponsesRequired) -> let resultsOrderedByCount = MeasureConsistency executedServers.SuccessfulResults + match resultsOrderedByCount with | [] -> - return failwith - "resultsSoFar.Length != 0 but MeasureConsistency returns None, please report this bug" + return + failwith + "resultsSoFar.Length != 0 but MeasureConsistency returns None, please report this bug" | (_, maxNumberOfConsistentResultsObtained) :: _ -> if (retriesForInconsistency = settings.NumberOfRetriesForInconsistency) then - return raise - (ResultInconsistencyException - (totalNumberOfSuccesfulResultsObtained, - maxNumberOfConsistentResultsObtained, - numberOfConsistentResponsesRequired)) + return + raise + (ResultInconsistencyException + (totalNumberOfSuccesfulResultsObtained, + maxNumberOfConsistentResultsObtained, + numberOfConsistentResponsesRequired)) else - return! QueryInternalImplementation - settings - initialFuncCount - funcs - List.Empty - List.Empty - retries - (retriesForInconsistency + 1u) - cancellationSource - | Some (AverageBetweenResponses _) -> - if (retries = settings.NumberOfRetries) then - let firstEx = executedServers.UnsuccessfulServers.First().Failure - return raise - (NotEnoughAvailableException - ("resultsSoFar.Length != 0 but not enough to satisfy minimum number of results for averaging func", - firstEx)) - else - return! QueryInternalImplementation + return! + QueryInternalImplementation settings initialFuncCount - failedFuncs - executedServers.SuccessfulResults - executedServers.UnsuccessfulServers - (retries + 1u) - retriesForInconsistency + funcs + List.Empty + List.Empty + retries + (retriesForInconsistency + 1u) cancellationSource + | Some (AverageBetweenResponses _) -> + if (retries = settings.NumberOfRetries) then + let firstEx = + executedServers + .UnsuccessfulServers + .First() + .Failure + + return + raise + (NotEnoughAvailableException + ("resultsSoFar.Length != 0 but not enough to satisfy minimum number of results for averaging func", + firstEx)) + else + return! + QueryInternalImplementation + settings + initialFuncCount + failedFuncs + executedServers.SuccessfulResults + executedServers.UnsuccessfulServers + (retries + 1u) + retriesForInconsistency + cancellationSource | _ -> return failwith "wrapping settings didn't work?" } let SortServers (servers: List>) (mode: ServerSelectionMode): List> = let workingServers = - List.filter (fun server -> - match server.Details.CommunicationHistory with - | None -> false - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> false - | _ -> true) servers + List.filter + (fun server -> + match server.Details.CommunicationHistory with + | None -> false + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> false + | _ -> true) + servers let sortedWorkingServers = - List.sortBy (fun server -> - match server.Details.CommunicationHistory with - | None -> failwith "previous filter didn't work? should get working servers only, not lacking history" - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> failwith "previous filter didn't work? should get working servers only, not faulty" - | _ -> historyInfo.TimeSpan) workingServers + List.sortBy + (fun server -> + match server.Details.CommunicationHistory with + | None -> + failwith "previous filter didn't work? should get working servers only, not lacking history" + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> failwith "previous filter didn't work? should get working servers only, not faulty" + | _ -> historyInfo.TimeSpan) + workingServers let serversWithNoHistoryServers = List.filter (fun server -> server.Details.CommunicationHistory.IsNone) servers let faultyServers = - List.filter (fun server -> - match server.Details.CommunicationHistory with - | None -> false - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> true - | _ -> false) servers + List.filter + (fun server -> + match server.Details.CommunicationHistory with + | None -> false + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> true + | _ -> false) + servers let sortedFaultyServers = - List.sortBy (fun server -> - match server.Details.CommunicationHistory with - | None -> failwith "previous filter didn't work? should get working servers only, not lacking history" - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> historyInfo.TimeSpan - | _ -> failwith "previous filter didn't work? should get faulty servers only, not working ones") + List.sortBy + (fun server -> + match server.Details.CommunicationHistory with + | None -> + failwith "previous filter didn't work? should get working servers only, not lacking history" + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> historyInfo.TimeSpan + | _ -> failwith "previous filter didn't work? should get faulty servers only, not working ones") faultyServers if mode = ServerSelectionMode.Fast then diff --git a/src/GWallet.Backend/Infrastructure.fs b/src/GWallet.Backend/Infrastructure.fs index 404ea3871..1714039aa 100644 --- a/src/GWallet.Backend/Infrastructure.fs +++ b/src/GWallet.Backend/Infrastructure.fs @@ -37,14 +37,13 @@ module Infrastructure = if Config.DebugLog then LogInfo <| SPrintF1 "DEBUG: %s" log - let internal ReportMessage - (message: string) + let internal ReportMessage (message: string) #if DEBUG - (_: ErrorLevel) + (_: ErrorLevel) #else - (errorLevel: ErrorLevel) + (errorLevel: ErrorLevel) #endif - = + = #if DEBUG failwith message #else @@ -55,14 +54,13 @@ module Infrastructure = let internal ReportError (errorMessage: string) = ReportMessage errorMessage ErrorLevel.Error - let private Report - (ex: Exception) + let private Report (ex: Exception) #if DEBUG - (_: ErrorLevel) + (_: ErrorLevel) #else - (errorLevel: ErrorLevel) + (errorLevel: ErrorLevel) #endif - = + = // TODO: log this in a file (log4net?), as well as printing to the console, before sending to sentry Console.Error.WriteLine ex diff --git a/src/GWallet.Backend/JsonRpcTcpClient.fs b/src/GWallet.Backend/JsonRpcTcpClient.fs index 4b209ea44..1f4281e8b 100644 --- a/src/GWallet.Backend/JsonRpcTcpClient.fs +++ b/src/GWallet.Backend/JsonRpcTcpClient.fs @@ -54,9 +54,10 @@ type JsonRpcTcpClient (host: string, port: uint32) = else return ipAddress | None -> - return raise - <| ServerCannotBeResolvedException - (SPrintF1 "DNS host entry lookup resulted in no records for %s" host) + return + raise + <| ServerCannotBeResolvedException + (SPrintF1 "DNS host entry lookup resulted in no records for %s" host) | None -> return raise <| TimeoutException (SPrintF2 "Timed out connecting to %s:%i" host port) with | :? TimeoutException -> return raise (ServerCannotBeResolvedException (exceptionMsg)) diff --git a/src/GWallet.Backend/Marshalling.fs b/src/GWallet.Backend/Marshalling.fs index 370fb568e..c25375136 100644 --- a/src/GWallet.Backend/Marshalling.fs +++ b/src/GWallet.Backend/Marshalling.fs @@ -22,7 +22,11 @@ type VersionMismatchDuringDeserializationException (message: string, innerExcept inherit DeserializationException(message, innerException) module internal VersionHelper = - let internal CURRENT_VERSION = Assembly.GetExecutingAssembly().GetName().Version.ToString() + let internal CURRENT_VERSION = + Assembly + .GetExecutingAssembly() + .GetName() + .Version.ToString() type MarshallingWrapper<'T> = { @@ -46,7 +50,9 @@ type private PascalCase2LowercasePlusUnderscoreContractResolver () = let pascalToUnderScoreReplacementExpression = "_$1$2" override __.ResolvePropertyName (propertyName: string) = - pascalToUnderScoreRegex.Replace(propertyName, pascalToUnderScoreReplacementExpression).ToLower() + pascalToUnderScoreRegex + .Replace(propertyName, pascalToUnderScoreReplacementExpression) + .ToLower() // combine https://stackoverflow.com/a/48330214/544947 with https://stackoverflow.com/a/29660550/544947 // (because null values should map to None values in the case of Option<> types, otherwise tests fail) @@ -67,6 +73,7 @@ type RequireAllPropertiesContractResolver () = if isOption then property.Required <- Required.AllowNull + property module Marshalling = @@ -90,12 +97,16 @@ module Marshalling = let private currentVersion = VersionHelper.CURRENT_VERSION let ExtractType (json: string): Type = - let fullTypeName = (JsonConvert.DeserializeObject> json).TypeName + let fullTypeName = + (JsonConvert.DeserializeObject> json) + .TypeName + Type.GetType (fullTypeName) let DeserializeCustom<'T> (json: string, settings: JsonSerializerSettings): 'T = if (json = null) then raise (ArgumentNullException ("json")) + if (String.IsNullOrWhiteSpace (json)) then raise (ArgumentException ("empty or whitespace json", "json")) @@ -104,11 +115,13 @@ module Marshalling = JsonConvert.DeserializeObject> (json, settings) with ex -> let versionJsonTag = "\"Version\":\"" + if (json.Contains (versionJsonTag)) then let jsonSinceVersion = json.Substring (json.IndexOf (versionJsonTag) + versionJsonTag.Length) let endVersionIndex = jsonSinceVersion.IndexOf ("\"") let version = jsonSinceVersion.Substring (0, endVersionIndex) + if (version <> currentVersion) then let msg = SPrintF2 @@ -117,6 +130,7 @@ module Marshalling = currentVersion raise <| VersionMismatchDuringDeserializationException (msg, ex) + raise <| DeserializationException (SPrintF1 "Exception when trying to deserialize '%s'" json, ex) @@ -125,10 +139,12 @@ module Marshalling = raise <| DeserializationException (SPrintF1 "JsonConvert.DeserializeObject returned null when trying to deserialize '%s'" json) + if Object.ReferenceEquals (deserialized.Value, null) then raise <| DeserializationException (SPrintF1 "JsonConvert.DeserializeObject could not deserialize the Value member of '%s'" json) + deserialized.Value let Deserialize<'T> (json: string): 'T = diff --git a/src/GWallet.Backend/Properties/AssemblyInfo.fs b/src/GWallet.Backend/Properties/AssemblyInfo.fs index 6aad0ab41..9be1284a7 100644 --- a/src/GWallet.Backend/Properties/AssemblyInfo.fs +++ b/src/GWallet.Backend/Properties/AssemblyInfo.fs @@ -6,18 +6,20 @@ open System.Runtime.InteropServices // General Information about an assembly is controlled through the following // set of attributes. Change these attribute values to modify the information // associated with an assembly. -[] -[] -[] -[] -[] +[] +[] +[] +[] +[] // Setting ComVisible to false makes the types in this assembly not visible // to COM components. If you need to access a type in this assembly from // COM, set the ComVisible attribute to true on that type. -[] + +[] // The following GUID is for the ID of the typelib if this project is exposed to COM -[] + +[] do () diff --git a/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs b/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs index 059059c91..f4e90c1fb 100644 --- a/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs +++ b/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs @@ -2,9 +2,9 @@ namespace GWallet open System.Reflection -[] -[] -[] +[] +[] +[] // Version information for an assembly consists of the following four values: @@ -17,7 +17,8 @@ open System.Reflection // You can specify all the values or you can default the Build and Revision Numbers // by using the '*' as shown below: // [] -[] -[] + +[] +[] do () diff --git a/src/GWallet.Backend/Server.fs b/src/GWallet.Backend/Server.fs index 8b629922e..4e0693b4c 100644 --- a/src/GWallet.Backend/Server.fs +++ b/src/GWallet.Backend/Server.fs @@ -79,11 +79,9 @@ module ServerRegistry = let ServersEmbeddedResourceFileName = "servers.json" - let internal TryFindValue - (map: ServerRanking) - (serverPredicate: ServerDetails -> bool) - : Option - = + let internal TryFindValue (map: ServerRanking) + (serverPredicate: ServerDetails -> bool) + : Option = let rec tryFind currencyAndServers server = match currencyAndServers with | [] -> None diff --git a/src/GWallet.Backend/ServerManager.fs b/src/GWallet.Backend/ServerManager.fs index a71fdccc9..58f392a8d 100644 --- a/src/GWallet.Backend/ServerManager.fs +++ b/src/GWallet.Backend/ServerManager.fs @@ -67,21 +67,26 @@ module ServerManager = | Currency.BTC -> Infrastructure.LogInfo (SPrintF1 "%i BTC servers from electrum repository" (electrumBtcServers.Count ())) + Infrastructure.LogInfo (SPrintF1 "%i BTC servers from bitcoin-eye" (eyeBtcServers.Count ())) | Currency.LTC -> Infrastructure.LogInfo (SPrintF1 "%i LTC servers from electrum repository" (electrumLtcServers.Count ())) + Infrastructure.LogInfo (SPrintF1 "%i LTC servers from bitcoin-eye" (eyeLtcServers.Count ())) | _ -> () let allCurrenciesServers = - baseLineServers.Add(Currency.BTC, allBtcServers).Add(Currency.LTC, allLtcServers) + baseLineServers + .Add(Currency.BTC, allBtcServers) + .Add(Currency.LTC, allLtcServers) let allServersJson = ServerRegistry.Serialize allCurrenciesServers File.WriteAllText (ServerRegistry.ServersEmbeddedResourceFileName, allServersJson) Infrastructure.LogInfo "OUTPUT:" let filteredOutServers = ServerRegistry.Deserialize allServersJson + for KeyValue (currency, servers) in filteredOutServers do Infrastructure.LogInfo (SPrintF2 "%i %A servers total" (servers.Count ()) currency) @@ -165,6 +170,7 @@ module ServerManager = // because ETH tokens use ETH servers if not (currency.IsEthToken ()) then let serversForSpecificCurrency = Caching.Instance.GetServers currency + match GetDummyBalanceAction currency serversForSpecificCurrency with | None -> () | Some job -> yield job diff --git a/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs b/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs index 381d5573e..972bdf4b9 100644 --- a/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs +++ b/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs @@ -37,7 +37,7 @@ module ElectrumClient = <| ServerTooNewException (SPrintF1 "Version of server rejects our client version (%s)" - (PROTOCOL_VERSION_SUPPORTED.ToString ())) + (PROTOCOL_VERSION_SUPPORTED.ToString ())) else reraise () @@ -46,17 +46,20 @@ module ElectrumClient = (ServerTooOldException (SPrintF2 "Version of server is older (%s) than the client (%s)" - (versionSupportedByServer.ToString ()) - (PROTOCOL_VERSION_SUPPORTED.ToString ()))) + (versionSupportedByServer.ToString ()) + (PROTOCOL_VERSION_SUPPORTED.ToString ()))) return stratumClient } let StratumServer (electrumServer: ServerDetails): Async = match electrumServer.ServerInfo.ConnectionType with - | { Encrypted = true; Protocol = _ } -> failwith "Incompatibility filter for non-encryption didn't work?" - | { Encrypted = false; Protocol = Http } -> failwith "HTTP server for UtxoCoin?" - | { Encrypted = false; Protocol = Tcp port } -> Init electrumServer.ServerInfo.NetworkPath port + | { Encrypted = true + Protocol = _ } -> failwith "Incompatibility filter for non-encryption didn't work?" + | { Encrypted = false + Protocol = Http } -> failwith "HTTP server for UtxoCoin?" + | { Encrypted = false + Protocol = Tcp port } -> Init electrumServer.ServerInfo.NetworkPath port let GetBalance (scriptHash: string) (stratumServer: Async) = async { @@ -99,12 +102,16 @@ module ElectrumClient = let! estimateFeeResult = stratumClient.BlockchainEstimateFee numBlocksTarget if estimateFeeResult.Result = -1m then - return raise - <| ServerMisconfiguredException ("Fee estimation returned a -1 error code") + return + raise + <| ServerMisconfiguredException ("Fee estimation returned a -1 error code") elif estimateFeeResult.Result <= 0m then - return raise - <| ServerMisconfiguredException - (SPrintF1 "Fee estimation returned an invalid non-positive value %M" estimateFeeResult.Result) + return + raise + <| ServerMisconfiguredException + (SPrintF1 "Fee estimation returned an invalid non-positive value %M" estimateFeeResult.Result) + + return estimateFeeResult.Result diff --git a/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs b/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs index 4906ef131..806119d06 100644 --- a/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs +++ b/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs @@ -38,6 +38,7 @@ type ElectrumServer = member self.CheckCompatibility (): unit = if self.UnencryptedPort.IsNone then raise (TlsNotSupportedYetInGWalletException ("TLS not yet supported")) + if self.Fqdn.EndsWith ".onion" then raise (TorNotSupportedYetInGWalletException ("Tor(onion) not yet supported")) @@ -62,9 +63,10 @@ module ElectrumServerSeedList = let url = SPrintF1 "https://1209k.com/bitcoin-eye/ele.php?chain=%s" currencyMnemonic let web = HtmlWeb () let doc = web.Load url - let firstTable = (doc.DocumentNode.SelectNodes "//table").[0] + let firstTable = (doc.DocumentNode.SelectNodes"//table").[0] let tableBody = firstTable.SelectSingleNode "tbody" let servers = tableBody.SelectNodes "tr" + seq { for i in 0 .. (servers.Count - 1) do let server = servers.[i] @@ -72,16 +74,19 @@ module ElectrumServerSeedList = if serverProperties.Count = 0 then failwith "Unexpected property count: 0" + let fqdn = serverProperties.[0].InnerText if serverProperties.Count < 2 then failwith <| SPrintF2 "Unexpected property count in server %s: %i" fqdn serverProperties.Count + let port = UInt32.Parse serverProperties.[1].InnerText if serverProperties.Count < 3 then failwith <| SPrintF3 "Unexpected property count in server %s:%i: %i" fqdn port serverProperties.Count + let portType = serverProperties.[2].InnerText let encrypted = @@ -102,11 +107,12 @@ module ElectrumServerSeedList = else Some port - yield { - Fqdn = fqdn - PrivatePort = privatePort - UnencryptedPort = unencryptedPort - } + yield + { + Fqdn = fqdn + PrivatePort = privatePort + UnencryptedPort = unencryptedPort + } } |> Seq.filter FilterCompatibleServer @@ -130,11 +136,12 @@ module ElectrumServerSeedList = | None -> None | Some portAsString -> Some (UInt32.Parse (portAsString.AsString ())) - yield { - Fqdn = key - PrivatePort = encryptedPort - UnencryptedPort = unencryptedPort - } + yield + { + Fqdn = key + PrivatePort = encryptedPort + UnencryptedPort = unencryptedPort + } } servers |> List.ofSeq @@ -151,6 +158,7 @@ module ElectrumServerSeedList = use webClient = new WebClient() let serverListInJson = webClient.DownloadString urlToElectrumJsonFile + ExtractServerListFromElectrumJsonFile serverListInJson |> Seq.filter FilterCompatibleServer diff --git a/src/GWallet.Backend/UtxoCoin/StratumClient.fs b/src/GWallet.Backend/UtxoCoin/StratumClient.fs index e15c85e5c..37deea1d9 100644 --- a/src/GWallet.Backend/UtxoCoin/StratumClient.fs +++ b/src/GWallet.Backend/UtxoCoin/StratumClient.fs @@ -124,29 +124,34 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = // FIXME: we should actually fix this bug in JsonRpcSharp (https://github.com/nblockchain/JsonRpcSharp/issues/9) if String.IsNullOrEmpty rawResponse then - return raise - <| ProtocolGlitchException - (SPrintF2 - "Server '%s' returned a null/empty JSON response to the request '%s'??" - jsonRpcClient.Host - jsonRequest) + return + raise + <| ProtocolGlitchException + (SPrintF2 + "Server '%s' returned a null/empty JSON response to the request '%s'??" + jsonRpcClient.Host + jsonRequest) try return (StratumClient.Deserialize<'R> rawResponse, rawResponse) with :? ElectrumServerReturningErrorInJsonResponseException as ex -> if ex.ErrorCode = int RpcErrorCode.InternalError then - return raise - (ElectrumServerReturningInternalErrorException - (ex.Message, ex.ErrorCode, jsonRequest, rawResponse)) + return + raise + (ElectrumServerReturningInternalErrorException + (ex.Message, ex.ErrorCode, jsonRequest, rawResponse)) + if ex.ErrorCode = int RpcErrorCode.UnknownMethod then return raise <| ServerMisconfiguredException (ex.Message, ex) + if ex.ErrorCode = int RpcErrorCode.ServerBusy then return raise <| ServerUnavailabilityException (ex.Message, ex) + if ex.ErrorCode = int RpcErrorCode.ExcessiveResourceUsage then return raise <| ServerUnavailabilityException (ex.Message, ex) - return raise - (ElectrumServerReturningErrorException (ex.Message, ex.ErrorCode, jsonRequest, rawResponse)) + return + raise (ElectrumServerReturningErrorException (ex.Message, ex.ErrorCode, jsonRequest, rawResponse)) } static member public Deserialize<'T> (result: string): 'T = @@ -161,8 +166,8 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = <| Exception (SPrintF2 "Failed deserializing JSON response (to check for error) '%s' to type '%s'" - resultTrimmed - typedefof<'T>.FullName, + resultTrimmed + typedefof<'T>.FullName, ex) if (not (Object.ReferenceEquals (maybeError, null))) @@ -179,16 +184,16 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = <| Exception (SPrintF2 "Failed deserializing JSON response '%s' to type '%s'" - resultTrimmed - typedefof<'T>.FullName, + resultTrimmed + typedefof<'T>.FullName, ex) if Object.ReferenceEquals (deserializedValue, null) then failwith <| SPrintF2 "Failed deserializing JSON response '%s' to type '%s' (result was null)" - resultTrimmed - typedefof<'T>.FullName + resultTrimmed + typedefof<'T>.FullName deserializedValue @@ -258,6 +263,7 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = } let json = Serialize obj + async { let! resObj, _ = self.Request json return resObj @@ -272,6 +278,7 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = } let json = Serialize obj + async { let! resObj, _ = self.Request json return resObj diff --git a/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs b/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs index 229fae5f5..7413a2ad8 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs @@ -18,7 +18,8 @@ type internal TransactionOutpoint = OutputIndex: int } - member self.ToCoin (): Coin = Coin (self.Transaction, uint32 self.OutputIndex) + member self.ToCoin (): Coin = + Coin (self.Transaction, uint32 self.OutputIndex) type internal IUtxoAccount = inherit IAccount @@ -59,6 +60,7 @@ module Account = if not (currency.IsUtxo ()) then failwith <| SPrintF1 "Assertion failed: currency %A should be UTXO-type" currency + match currency with | BTC -> Config.BitcoinNet | LTC -> Config.LitecoinNet @@ -78,7 +80,9 @@ module Account = |> GetElectrumScriptHashFromAddress let internal GetPublicAddressFromPublicKey currency (publicKey: PubKey) = - (publicKey.GetSegwitAddress (GetNetwork currency)).GetScriptAddress().ToString() + (publicKey.GetSegwitAddress (GetNetwork currency)) + .GetScriptAddress() + .ToString() let internal GetPublicAddressFromNormalAccountFile (currency: Currency) (accountFile: FileRepresentation): string = let pubKey = PubKey (accountFile.Name) @@ -98,14 +102,18 @@ module Account = if not (currency.IsUtxo ()) then failwith <| SPrintF1 "Assertion failed: currency %A should be UTXO-type" currency + match kind with | AccountKind.ReadOnly -> ReadOnlyUtxoAccount - (currency, accountFile, (fun accountFile -> accountFile.Name), GetPublicKeyFromReadOnlyAccountFile) :> IAccount + (currency, accountFile, (fun accountFile -> accountFile.Name), GetPublicKeyFromReadOnlyAccountFile) + :> IAccount | AccountKind.Normal -> let fromAccountFileToPublicAddress = GetPublicAddressFromNormalAccountFile currency let fromAccountFileToPublicKey = GetPublicKeyFromNormalAccountFile - NormalUtxoAccount (currency, accountFile, fromAccountFileToPublicAddress, fromAccountFileToPublicKey) :> IAccount + + NormalUtxoAccount (currency, accountFile, fromAccountFileToPublicAddress, fromAccountFileToPublicKey) + :> IAccount | _ -> failwith <| SPrintF1 "Kind (%A) not supported for this API" kind let private BalanceToShow (balances: BlockchainScriptHashGetBalanceInnerResult) = @@ -120,12 +128,10 @@ module Account = let amountInBtc = (Money.Satoshis amountToShowInSatoshis).ToUnit MoneyUnit.BTC amountInBtc - let private BalanceMatchWithCacheOrInitialBalance - address - currency - (someRetrievedBalance: BlockchainScriptHashGetBalanceInnerResult) - : bool - = + let private BalanceMatchWithCacheOrInitialBalance address + currency + (someRetrievedBalance: BlockchainScriptHashGetBalanceInnerResult) + : bool = if Caching.Instance.FirstRun then BalanceToShow someRetrievedBalance = 0m else @@ -133,12 +139,10 @@ module Account = | None -> false | Some balance -> BalanceToShow someRetrievedBalance = balance - let private GetBalances - (account: IUtxoAccount) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async - = + let private GetBalances (account: IUtxoAccount) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async = let scriptHashHex = GetElectrumScriptHashFromPublicAddress account.Currency account.PublicAddress let querySettings = @@ -147,25 +151,22 @@ module Account = let balanceJob = ElectrumClient.GetBalance scriptHashHex Server.Query account.Currency querySettings balanceJob cancelSourceOption - let private GetBalancesFromServer - (account: IUtxoAccount) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async> - = + let private GetBalancesFromServer (account: IUtxoAccount) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async> = async { try let! balances = GetBalances account mode cancelSourceOption return Some balances - with ex when (FSharpUtil.FindException ex).IsSome -> return None + with ex when (FSharpUtil.FindException ex) + .IsSome -> return None } - let internal GetShowableBalance - (account: IUtxoAccount) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async> - = + let internal GetShowableBalance (account: IUtxoAccount) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async> = async { let! maybeBalances = GetBalancesFromServer account mode cancelSourceOption @@ -181,19 +182,19 @@ module Account = let coin = Coin (txHash, uint32 inputOutpointInfo.OutputIndex, Money (inputOutpointInfo.ValueInSatoshis), scriptPubKey) - coin.ToScriptCoin account.PublicKey.WitHash.ScriptPubKey :> ICoin - let private CreateTransactionAndCoinsToBeSigned - (account: IUtxoAccount) - (transactionInputs: List) - (destination: string) - (amount: TransferAmount) - : TransactionBuilder - = + let private CreateTransactionAndCoinsToBeSigned (account: IUtxoAccount) + (transactionInputs: List) + (destination: string) + (amount: TransferAmount) + : TransactionBuilder = let coins = List.map (ConvertToICoin account) transactionInputs - let transactionBuilder = (GetNetwork account.Currency).CreateTransactionBuilder() + let transactionBuilder = + (GetNetwork account.Currency) + .CreateTransactionBuilder() + transactionBuilder.AddCoins coins |> ignore let currency = account.Currency @@ -221,11 +222,9 @@ module Account = Value: Int64 } - let private ConvertToInputOutpointInfo - currency - (utxo: UnspentTransactionOutputInfo) - : Async - = + let private ConvertToInputOutpointInfo currency + (utxo: UnspentTransactionOutputInfo) + : Async = async { let job = ElectrumClient.GetBlockchainTransaction utxo.TransactionId let! transRaw = Server.Query currency (QuerySettings.Default ServerSelectionMode.Fast) job None @@ -245,14 +244,12 @@ module Account = return ret } - let rec private EstimateFees - (txBuilder: TransactionBuilder) - (feeRate: FeeRate) - (account: IUtxoAccount) - (usedInputsSoFar: List) - (unusedUtxos: List) - : Async> - = + let rec private EstimateFees (txBuilder: TransactionBuilder) + (feeRate: FeeRate) + (account: IUtxoAccount) + (usedInputsSoFar: List) + (unusedUtxos: List) + : Async> = async { try let fees = txBuilder.EstimateFees feeRate @@ -266,32 +263,29 @@ module Account = let newCoin = newInput |> ConvertToICoin account let newTxBuilder = txBuilder.AddCoins [ newCoin ] + let newInputs = newInput :: usedInputsSoFar return! EstimateFees newTxBuilder feeRate account newInputs tail } - let internal EstimateFee - (account: IUtxoAccount) - (amount: TransferAmount) - (destination: string) - : Async - = + let internal EstimateFee (account: IUtxoAccount) + (amount: TransferAmount) + (destination: string) + : Async = async { - let rec addInputsUntilAmount - (utxos: List) - soFarInSatoshis - amount - (acc: List) - : List * List - = + let rec addInputsUntilAmount (utxos: List) + soFarInSatoshis + amount + (acc: List) + : List * List = match utxos with | [] -> // should `raise InsufficientFunds` instead? failwith <| SPrintF2 "Not enough funds (needed: %s, got so far: %s)" - (amount.ToString ()) - (soFarInSatoshis.ToString ()) + (amount.ToString ()) + (soFarInSatoshis.ToString ()) | utxoInfo :: tail -> let newAcc = // Avoid querying for zero-value UTXOs, which would make many unnecessary parallel @@ -308,6 +302,7 @@ module Account = acc let newSoFar = soFarInSatoshis + utxoInfo.Value + if (newSoFar < amount) then addInputsUntilAmount tail newSoFar amount newAcc else @@ -325,11 +320,12 @@ module Account = let possibleInputs = seq { for utxo in utxos do - yield { - TransactionId = utxo.TxHash - OutputIndex = utxo.TxPos - Value = utxo.Value - } + yield + { + TransactionId = utxo.TxHash + OutputIndex = utxo.TxPos + Value = utxo.Value + } } // first ones are the smallest ones @@ -365,7 +361,7 @@ module Account = <| Exception (SPrintF1 "Could not create fee rate from %s btc per KB" - (btcPerKiloByteForFastTrans.ToString ()), + (btcPerKiloByteForFastTrans.ToString ()), ex) let transactionBuilder = @@ -379,37 +375,40 @@ module Account = let minerFee = MinerFee (estimatedMinerFeeInSatoshis, DateTime.UtcNow, account.Currency) - return { - Inputs = allUsedInputs - Fee = minerFee - } + return + { + Inputs = allUsedInputs + Fee = minerFee + } with :? NBitcoin.NotEnoughFundsException -> return raise <| InsufficientBalanceForFee None } - let private SignTransactionWithPrivateKey - (account: IUtxoAccount) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (privateKey: Key) - = + let private SignTransactionWithPrivateKey (account: IUtxoAccount) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (privateKey: Key) + = let btcMinerFee = txMetadata.Fee let finalTransactionBuilder = CreateTransactionAndCoinsToBeSigned account txMetadata.Inputs destination amount finalTransactionBuilder.AddKeys privateKey |> ignore + finalTransactionBuilder.SendFees (Money.Satoshis (btcMinerFee.EstimatedFeeInSatoshis)) |> ignore let finalTransaction = finalTransactionBuilder.BuildTransaction true let transCheckResultAfterSigning = finalTransaction.Check () + if (transCheckResultAfterSigning <> TransactionCheckResult.Success) then failwith <| SPrintF1 "Transaction check failed after signing with %A" transCheckResultAfterSigning if not (finalTransactionBuilder.Verify finalTransaction) then failwith "Something went wrong when verifying transaction" + finalTransaction let internal GetPrivateKey (account: NormalAccount) password = @@ -422,13 +421,12 @@ module Account = encryptedSecret.GetKey (password) with :? SecurityException -> raise (InvalidPassword) - let internal SignTransaction - (account: NormalUtxoAccount) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (password: string) - = + let internal SignTransaction (account: NormalUtxoAccount) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (password: string) + = let privateKey = GetPrivateKey account password @@ -448,14 +446,14 @@ module Account = // and show the info from the RawTx, using NBitcoin to extract it BroadcastRawTransaction currency transaction.RawTransaction - let internal SendPayment - (account: NormalUtxoAccount) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (password: string) - = + let internal SendPayment (account: NormalUtxoAccount) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (password: string) + = let baseAccount = account :> IAccount + if (baseAccount.PublicAddress.Equals (destination, StringComparison.InvariantCultureIgnoreCase)) then raise DestinationEqualToOrigin @@ -466,28 +464,28 @@ module Account = let public ExportUnsignedTransactionToJson trans = Marshalling.Serialize trans - let internal SaveUnsignedTransaction - (transProposal: UnsignedTransactionProposal) - (txMetadata: TransactionMetadata) - (readOnlyAccounts: seq) - : string - = + let internal SaveUnsignedTransaction (transProposal: UnsignedTransactionProposal) + (txMetadata: TransactionMetadata) + (readOnlyAccounts: seq) + : string = let unsignedTransaction = { Proposal = transProposal - Cache = Caching.Instance.GetLastCachedData().ToDietCache readOnlyAccounts + Cache = + Caching + .Instance + .GetLastCachedData().ToDietCache readOnlyAccounts Metadata = txMetadata } ExportUnsignedTransactionToJson unsignedTransaction - let internal SweepArchivedFunds - (account: ArchivedUtxoAccount) - (balance: decimal) - (destination: IAccount) - (txMetadata: TransactionMetadata) - = + let internal SweepArchivedFunds (account: ArchivedUtxoAccount) + (balance: decimal) + (destination: IAccount) + (txMetadata: TransactionMetadata) + = let currency = (account :> IAccount).Currency let network = GetNetwork currency let amount = TransferAmount (balance, balance, currency) @@ -506,10 +504,12 @@ module Account = let encryptedSecret = secret.PrivateKey.GetEncryptedBitcoinSecret (password, network) let encryptedPrivateKey = encryptedSecret.ToWif () let publicKey = secret.PubKey.ToString () - return { - Name = publicKey - Content = fun _ -> encryptedPrivateKey - } + + return + { + Name = publicKey + Content = fun _ -> encryptedPrivateKey + } } let internal ValidateAddress (currency: Currency) (address: string) = @@ -523,6 +523,7 @@ module Account = | BTC -> let BITCOIN_ADDRESS_PUBKEYHASH_PREFIX = "1" let BITCOIN_ADDRESS_SCRIPTHASH_PREFIX = "3" + [ BITCOIN_ADDRESS_PUBKEYHASH_PREFIX BITCOIN_ADDRESS_SCRIPTHASH_PREFIX @@ -531,6 +532,7 @@ module Account = | LTC -> let LITECOIN_ADDRESS_PUBKEYHASH_PREFIX = "L" let LITECOIN_ADDRESS_SCRIPTHASH_PREFIX = "M" + [ LITECOIN_ADDRESS_PUBKEYHASH_PREFIX LITECOIN_ADDRESS_SCRIPTHASH_PREFIX @@ -549,17 +551,19 @@ module Account = 27, true, 34 let limits = [ minLength; maxLength ] + if address.Length > maxLength then raise <| AddressWithInvalidLength limits + if address.Length < minLength then raise <| AddressWithInvalidLength limits + if not lenghtInBetweenAllowed && (address.Length <> minLength && address.Length <> maxLength) then raise <| AddressWithInvalidLength limits let network = GetNetwork currency + try BitcoinAddress.Create (address, network) |> ignore - with - // TODO: propose to NBitcoin upstream to generate an NBitcoin exception instead - :? FormatException -> raise (AddressWithInvalidChecksum None) + with :? FormatException -> raise (AddressWithInvalidChecksum None) diff --git a/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs b/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs index 6348ba20c..a3e986674 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs @@ -46,10 +46,9 @@ module Server = ServerSelectionMode.Fast (Some (SpecificNumberOfConsistentResponsesRequired 1u)) - let private FaultTolerantParallelClientSettingsForBalanceCheck - (mode: ServerSelectionMode) - cacheOrInitialBalanceMatchFunc - = + let private FaultTolerantParallelClientSettingsForBalanceCheck (mode: ServerSelectionMode) + cacheOrInitialBalanceMatchFunc + = let consistencyConfig = if mode = ServerSelectionMode.Fast then Some (OneServerConsistentWithCertainValueOrTwoServers cacheOrInitialBalanceMatchFunc) @@ -63,17 +62,13 @@ module Server = // FIXME: seems there's some code duplication between this function and EtherServer.fs's GetServerFuncs function // and room for simplification to not pass a new ad-hoc delegate? - let internal GetServerFuncs<'R> - (electrumClientFunc: Async -> Async<'R>) - (electrumServers: seq) - : seq> - = - - let ElectrumServerToRetrievalFunc - (server: ServerDetails) - (electrumClientFunc: Async -> Async<'R>) - : Async<'R> - = + let internal GetServerFuncs<'R> (electrumClientFunc: Async -> Async<'R>) + (electrumServers: seq) + : seq> = + + let ElectrumServerToRetrievalFunc (server: ServerDetails) + (electrumClientFunc: Async -> Async<'R>) + : Async<'R> = async { try let stratumClient = ElectrumClient.StratumServer server @@ -85,16 +80,15 @@ module Server = let msg = SPrintF2 "%s: %s" (ex.GetType().FullName) ex.Message return raise <| ServerDiscardedException (msg, ex) | ex -> - return raise - <| Exception - (SPrintF1 "Some problem when connecting to %s" server.ServerInfo.NetworkPath, ex) + return + raise + <| Exception + (SPrintF1 "Some problem when connecting to %s" server.ServerInfo.NetworkPath, ex) } - let ElectrumServerToGenericServer - (electrumClientFunc: Async -> Async<'R>) - (electrumServer: ServerDetails) - : Server - = + let ElectrumServerToGenericServer (electrumClientFunc: Async -> Async<'R>) + (electrumServer: ServerDetails) + : Server = { Details = electrumServer Retrieval = ElectrumServerToRetrievalFunc electrumServer electrumClientFunc @@ -103,22 +97,18 @@ module Server = let serverFuncs = Seq.map (ElectrumServerToGenericServer electrumClientFunc) electrumServers serverFuncs - let private GetRandomizedFuncs<'R> - (currency: Currency) - (electrumClientFunc: Async -> Async<'R>) - : List> - = + let private GetRandomizedFuncs<'R> (currency: Currency) + (electrumClientFunc: Async -> Async<'R>) + : List> = let electrumServers = ElectrumServerSeedList.Randomize currency GetServerFuncs electrumClientFunc electrumServers |> List.ofSeq - let Query<'R when 'R: equality> - currency - (settings: QuerySettings<'R>) - (job: Async -> Async<'R>) - (cancelSourceOption: Option) - : Async<'R> - = + let Query<'R when 'R: equality> currency + (settings: QuerySettings<'R>) + (job: Async -> Async<'R>) + (cancelSourceOption: Option) + : Async<'R> = let query = match cancelSourceOption with | None -> faultTolerantElectrumClient.Query @@ -130,6 +120,7 @@ module Server = | Balance (mode, predicate) -> FaultTolerantParallelClientSettingsForBalanceCheck mode predicate | FeeEstimation averageFee -> let minResponsesRequired = 3u + FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast (Some (AverageBetweenResponses (minResponsesRequired, averageFee))) diff --git a/src/GWallet.Backend/WarpKey.fs b/src/GWallet.Backend/WarpKey.fs index 06f2f6f74..696e176cb 100644 --- a/src/GWallet.Backend/WarpKey.fs +++ b/src/GWallet.Backend/WarpKey.fs @@ -1,5 +1,4 @@ -// because of the use of obsolete NBitcoin.Crypto.Pbkdf2 -#nowarn "44" +#nowarn "44" namespace GWallet.Backend @@ -17,8 +16,10 @@ module WarpKey = raise (ArgumentException ()) else let result = Array.create a.Length (byte 0) + for i = 0 to (a.Length - 1) do result.[i] <- ((a.[i]) ^^^ (b.[i])) + result let Scrypt (passphrase: string) (salt: string): array = @@ -55,10 +56,12 @@ module WarpKey = let scrypt = Scrypt passphrase salt let pbkdf2 = PBKDF2 passphrase salt let privKeyBytes = XOR scrypt pbkdf2 + if (privKeyBytes.Length <> LENGTH_OF_PRIVATE_KEYS) then failwith <| SPrintF2 "Something went horribly wrong because length of privKey was not %i but %i" - LENGTH_OF_PRIVATE_KEYS - privKeyBytes.Length + LENGTH_OF_PRIVATE_KEYS + privKeyBytes.Length + privKeyBytes