From 0436a96f44e10a12165bd3dac8117f5b6096f162 Mon Sep 17 00:00:00 2001 From: "Andres G. Aragoneses" Date: Sun, 12 Jul 2020 15:34:41 +0800 Subject: [PATCH] Add fantomas configuration file This version of fantomas doesn't crash anymore when formatting it: dotnet tool install -g fantomas-tool --add-source https://www.myget.org/F/fantomas/api/v3/index.json --framework netcoreapp3.1 --version 4.0.0-alpha-012 Source will be formatted using this command: fantomas --recurse src/GWallet.Backend/ Things that would need to be fixed manually before merging this to master: - We can drop parens in many if statements, e.g.: StratumClient.fs' CreateVersion's, ServerManager.fs' GetDummyBalanceAction, FTPC.fs' FTPC type, EtherAccount.fs' GetTransactionCount - Drop parents in ReadAllText calls of Account.fs - Many raise lines should use <|, e.g. in WarpKey.fs, UtxoCoinAccount.fs, and ElectrumServer.fs - UtxoCoinAccount.fs' EstimateFees unneeded use of |> with 'head' Fantomas issues from geewallet's wishlist: - https://github.com/fsprojects/fantomas/issues/712 - https://github.com/fsprojects/fantomas/issues/908 - https://github.com/fsprojects/fantomas/issues/684 - https://github.com/fsprojects/fantomas/issues/964 Issues not yet reported: - There should be a setting called AlwaysSplitPipeOperatorInNewLine? but I actually don't understand the consistency of this: ``` use webClient = new WebClient() let serverListInJson = webClient.DownloadString urlToElectrumJsonFile ExtractServerListFromElectrumJsonFile serverListInJson - |> Seq.filter FilterCompatibleServer + |> Seq.filter FilterCompatibleServer - let DefaultBtcList = - Caching.Instance.GetServers Currency.BTC - |> List.ofSeq + let DefaultBtcList = Caching.Instance.GetServers Currency.BTC |> List.ofSeq ``` - MaxLineLength not being respected? look at how long some lines in UtxoCoinAccount.fs' GetAccountFromFile are. - UtxoCoinAccount.fs' TransactionOutpoint.ToCoin() should start on next line. - Why cut `truncated` var assignment in Formatting.fs' DecimalAmountTruncating func? - FaultTolerantParallelClient.fs' Runner.Run is tooooooo long - Moving commend comment of FTPC.fs' CustomCancelSource's Dispose func - This stupid diff adding an unneeded space: ``` return! faultTolerantEtherClient.Query (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast - currency - (Some (AverageBetweenResponses (minResponsesRequired, AverageGasPrice)))) + currency + (Some (AverageBetweenResponses (minResponsesRequired, AverageGasPrice)))) web3Funcs ``` - This stupid 3-space indentation: ``` - if not (account.Currency.IsEtherBased()) then - failwith <| SPrintF1 "Currency %A not ether based and not UTXO either? not supported, report this bug (estimatefee)" - account.Currency + if not (account.Currency.IsEtherBased ()) then + failwith + <| SPrintF1 + "Currency %A not ether based and not UTXO either? not supported, report this bug (estimatefee)" + account.Currency ``` - (Investigate) FSharpUtil.option{} that contains a `do! if...`, WAT - Excessive EOLs in ElectrumClient.fs (one extra addition I didn't even add to this commit) - In a lock() statement, it should allow placing the ending `)` in its own line at the end, in the same column where `lock` starts. Last but not least, investigate if alpha-012 contains unwanted things like 311bff817f89f8b47c0799eb7474da886175ef15, otherwise we might need to go back to 04c48d5977acef1f2a81e5da8b1f9cbbfc3cb0a7, which should be alpha-011 with these fantomas-config.json settings: { "IndentSpaceNum":4, "PageWidth":80, "SemicolonAtEndOfLine":false, "SpaceBeforeParameter":true, "SpaceBeforeLowercaseInvocation":true, "SpaceBeforeUppercaseInvocation":true, "SpaceBeforeClassConstructor":true, "SpaceBeforeMember":true, "SpaceBeforeColon":false, "SpaceAfterComma":true, "SpaceBeforeSemicolon":false, "SpaceAfterSemicolon":true, "IndentOnTryWith":true, "SpaceAroundDelimiter":true, "MaxIfThenElseShortWidth":0, "MaxInfixOperatorExpression":80, "MaxRecordWidth":0, "MaxFunctionBindingWidth":0, "MaxValueBindingWidth":80, "MultilineBlockBracketsOnSameColumn":true, "NewlineBetweenTypeDefinitionAndMembers":true, "KeepIfThenInSameLine":true, "StrictMode":false } --- .editorconfig | 24 + src/GWallet.Backend/Account.fs | 756 ++++++------ src/GWallet.Backend/AccountTypes.fs | 55 +- src/GWallet.Backend/BlockExplorer.fs | 55 +- src/GWallet.Backend/Caching.fs | 572 ++++----- src/GWallet.Backend/CachingTypes.fs | 16 +- src/GWallet.Backend/Config.fs | 103 +- src/GWallet.Backend/Currency.fs | 50 +- src/GWallet.Backend/Ether/EtherAccount.fs | 543 +++++---- src/GWallet.Backend/Ether/EtherExceptions.fs | 41 +- src/GWallet.Backend/Ether/EtherMinerFee.fs | 18 +- src/GWallet.Backend/Ether/EtherServer.fs | 608 +++++----- src/GWallet.Backend/Ether/TokenManager.fs | 34 +- .../Ether/TransactionMetadata.fs | 13 +- src/GWallet.Backend/Exceptions.fs | 1 - src/GWallet.Backend/FSharpUtil.fs | 213 ++-- .../FaultTolerantParallelClient.fs | 1051 +++++++++-------- src/GWallet.Backend/FiatValueEstimation.fs | 222 ++-- src/GWallet.Backend/Formatting.fs | 18 +- src/GWallet.Backend/IBlockchainFeeInfo.fs | 7 +- src/GWallet.Backend/Infrastructure.fs | 28 +- src/GWallet.Backend/JsonRpcTcpClient.fs | 158 +-- src/GWallet.Backend/Marshalling.fs | 120 +- src/GWallet.Backend/Networking.fs | 80 +- .../Properties/AssemblyInfo.fs | 23 +- .../Properties/CommonAssemblyInfo.fs | 16 +- src/GWallet.Backend/Server.fs | 118 +- src/GWallet.Backend/ServerManager.fs | 122 +- src/GWallet.Backend/Shuffler.fs | 16 +- src/GWallet.Backend/Transaction.fs | 36 +- src/GWallet.Backend/TransferAmount.fs | 12 +- .../UtxoCoin/ElectrumClient.fs | 138 ++- .../UtxoCoin/ElectrumServer.fs | 84 +- src/GWallet.Backend/UtxoCoin/StratumClient.fs | 314 ++--- .../UtxoCoin/TransactionTypes.fs | 22 +- .../UtxoCoin/UtxoCoinAccount.fs | 555 +++++---- .../UtxoCoin/UtxoCoinMinerFee.fs | 11 +- .../UtxoCoin/UtxoCoinServer.fs | 123 +- src/GWallet.Backend/WarpKey.fs | 36 +- 39 files changed, 3459 insertions(+), 2953 deletions(-) create mode 100644 .editorconfig diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 000000000..52f42393e --- /dev/null +++ b/.editorconfig @@ -0,0 +1,24 @@ +[*.fs] +indent_size=4, +max_line_length=80, +fsharp_semicolon_at_end_of_line=false +fsharp_space_before_parameter=true +fsharp_space_before_lowercase_invocation=true +fsharp_space_before_uppercase_invocation=true +fsharp_space_before_class_constructor=true +fsharp_space_before_member=true +fsharp_space_before_colon=false +fsharp_space_after_comma=true +fsharp_space_before_semicolon=false +fsharp_space_after_semicolon=true +fsharp_indent_on_try_with=true +fsharp_space_around_delimiter=true +fsharp_max_if_then_else_short_width=0 +fsharp_max_infix_operator_expression=80 +fsharp_max_record_width=0 +fsharp_max_function_binding_width=0 +fsharp_max_value_binding_width=80 +fsharp_multiline_block_brackets_on_same_column=true +fsharp_newline_between_type_definition_and_members=true +fsharp_keep_if_then_in_same_line=true +fsharp_strict_mode=false diff --git a/src/GWallet.Backend/Account.fs b/src/GWallet.Backend/Account.fs index ca9920cff..d2c977718 100644 --- a/src/GWallet.Backend/Account.fs +++ b/src/GWallet.Backend/Account.fs @@ -9,155 +9,184 @@ 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 - failwith <| SPrintF1 "Currency %A not Utxo-type but account is? report this bug (balance)" - account.Currency + if not (account.Currency.IsUtxo ()) then + failwith + <| SPrintF1 "Currency %A not Utxo-type but account is? report this bug (balance)" account.Currency UtxoCoin.Account.GetShowableBalance utxoAccount mode cancelSourceOption | _ -> - if not (account.Currency.IsEtherBased()) then - failwith <| SPrintF1 "Currency %A not ether based and not UTXO either? not supported, report this bug (balance)" - account.Currency + if not (account.Currency.IsEtherBased ()) then + failwith + <| SPrintF1 + "Currency %A not ether based and not UTXO either? not supported, report this bug (balance)" + 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 else - let! maybeBalance = GetShowableBalanceInternal account mode cancelSourceOption - match maybeBalance with - | None -> - return NotFresh(Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency) - | Some balance -> - let compoundBalance,_ = - Caching.Instance.RetrieveAndUpdateLastCompoundBalance account.PublicAddress - account.Currency - balance - return Fresh compoundBalance + let! maybeBalance = GetShowableBalanceInternal account mode cancelSourceOption + + match maybeBalance with + | None -> + return NotFresh + (Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency) + | Some balance -> + let compoundBalance, _ = + Caching.Instance.RetrieveAndUpdateLastCompoundBalance + account.PublicAddress + account.Currency + balance + + return Fresh compoundBalance } let internal GetAccountFromFile accountFile (currency: Currency) kind: IAccount = - if currency.IsUtxo() then + if currency.IsUtxo () then UtxoCoin.Account.GetAccountFromFile accountFile currency kind - elif currency.IsEtherBased() then + elif currency.IsEtherBased () then Ether.Account.GetAccountFromFile accountFile currency kind else failwith <| SPrintF1 "Currency (%A) not supported for this API" currency - let GetAllActiveAccounts(): seq = - Config.PropagateEthAccountInfoToMissingTokensAccounts() + let GetAllActiveAccounts (): seq = + Config.PropagateEthAccountInfoToMissingTokensAccounts () - let allCurrencies = Currency.GetAll() + let allCurrencies = Currency.GetAll () seq { for currency in allCurrencies do - let activeKinds = [AccountKind.ReadOnly; AccountKind.Normal] + let activeKinds = + [ + AccountKind.ReadOnly + AccountKind.Normal + ] + for kind in activeKinds do - for accountFile in Config.GetAccountFiles [currency] kind do + for accountFile in Config.GetAccountFiles [ currency ] kind do yield GetAccountFromFile accountFile currency kind } - let GetNormalAccountsPairingInfoForWatchWallet(): Option = - let allCurrencies = Currency.GetAll() + let GetNormalAccountsPairingInfoForWatchWallet (): Option = + let allCurrencies = Currency.GetAll () let utxoCurrencyAccountFiles = - Config.GetAccountFiles (allCurrencies.Where(fun currency -> currency.IsUtxo())) AccountKind.Normal + Config.GetAccountFiles (allCurrencies.Where (fun currency -> currency.IsUtxo ())) AccountKind.Normal + let etherCurrencyAccountFiles = - Config.GetAccountFiles (allCurrencies.Where(fun currency -> currency.IsEtherBased())) AccountKind.Normal - if (not (utxoCurrencyAccountFiles.Any())) || (not (etherCurrencyAccountFiles.Any())) then + Config.GetAccountFiles (allCurrencies.Where (fun currency -> currency.IsEtherBased ())) AccountKind.Normal + + if (not (utxoCurrencyAccountFiles.Any ())) + || (not (etherCurrencyAccountFiles.Any ())) then None else - let firstUtxoAccountFile = utxoCurrencyAccountFiles.First() + let firstUtxoAccountFile = utxoCurrencyAccountFiles.First () let utxoCoinPublicKey = UtxoCoin.Account.GetPublicKeyFromNormalAccountFile firstUtxoAccountFile - let firstEtherAccountFile = etherCurrencyAccountFiles.First() + let firstEtherAccountFile = etherCurrencyAccountFiles.First () let etherPublicAddress = Ether.Account.GetPublicAddressFromNormalAccountFile firstEtherAccountFile - Some { - UtxoCoinPublicKey = utxoCoinPublicKey.ToString() - EtherPublicAddress = etherPublicAddress - } + Some + { + UtxoCoinPublicKey = utxoCoinPublicKey.ToString () + EtherPublicAddress = etherPublicAddress + } - let GetArchivedAccountsWithPositiveBalance (cancelSourceOption: Option) - : Async> = - let asyncJobs = seq>> { - let allCurrencies = Currency.GetAll() + let GetArchivedAccountsWithPositiveBalance (cancelSourceOption: Option): Async> = + let asyncJobs = + seq>> { + let allCurrencies = Currency.GetAll () + + for currency in allCurrencies do + let fromUnencryptedPrivateKeyToPublicAddressFunc = + if currency.IsUtxo () then + UtxoCoin.Account.GetPublicAddressFromUnencryptedPrivateKey currency + elif currency.IsEtherBased () then + Ether.Account.GetPublicAddressFromUnencryptedPrivateKey + else + failwith <| SPrintF1 "Unknown currency %A" currency + + let fromConfigAccountFileToPublicAddressFunc (accountConfigFile: FileRepresentation) = + let privateKeyFromConfigFile = accountConfigFile.Content () + fromUnencryptedPrivateKeyToPublicAddressFunc privateKeyFromConfigFile + + for accountFile in Config.GetAccountFiles [ currency ] AccountKind.Archived do + let 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 + } + } - for currency in allCurrencies do - let fromUnencryptedPrivateKeyToPublicAddressFunc = - if currency.IsUtxo() then - UtxoCoin.Account.GetPublicAddressFromUnencryptedPrivateKey currency - elif currency.IsEtherBased() then - Ether.Account.GetPublicAddressFromUnencryptedPrivateKey - else - failwith <| SPrintF1 "Unknown currency %A" currency - - let fromConfigAccountFileToPublicAddressFunc (accountConfigFile: FileRepresentation) = - let privateKeyFromConfigFile = accountConfigFile.Content() - fromUnencryptedPrivateKeyToPublicAddressFunc privateKeyFromConfigFile - - for accountFile in Config.GetAccountFiles [currency] AccountKind.Archived do - let 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 - } - } 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 - | _ -> () - } + 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) - let ValidateAddress (currency: Currency) (address: string): Async = async { - if currency.IsEtherBased() then - do! Ether.Account.ValidateAddress currency address - elif currency.IsUtxo() then - UtxoCoin.Account.ValidateAddress currency address - else - failwith <| SPrintF1 "Unknown currency %A" currency - } + let ValidateAddress (currency: Currency) (address: string): Async = + async { + if currency.IsEtherBased () then + do! Ether.Account.ValidateAddress currency address + elif currency.IsUtxo () then + UtxoCoin.Account.ValidateAddress currency address + else + failwith <| SPrintF1 "Unknown currency %A" currency + } let EstimateFee (account: IAccount) (amount: TransferAmount) destination: Async = async { match account with | :? UtxoCoin.IUtxoAccount as utxoAccount -> - if not (account.Currency.IsUtxo()) then - failwith <| SPrintF1 "Currency %A not Utxo-type but account is? report this bug (estimatefee)" - account.Currency + if not (account.Currency.IsUtxo ()) then + failwith + <| SPrintF1 + "Currency %A not Utxo-type but account is? report this bug (estimatefee)" + account.Currency let! fee = UtxoCoin.Account.EstimateFee utxoAccount amount destination return fee :> IBlockchainFeeInfo | _ -> - if not (account.Currency.IsEtherBased()) then - failwith <| SPrintF1 "Currency %A not ether based and not UTXO either? not supported, report this bug (estimatefee)" - account.Currency + if not (account.Currency.IsEtherBased ()) then + failwith + <| SPrintF1 + "Currency %A not ether based and not UTXO either? not supported, report this bug (estimatefee)" + account.Currency let! fee = Ether.Account.EstimateFee account amount destination return fee :> IBlockchainFeeInfo } @@ -165,10 +194,11 @@ module Account = let private SaveOutgoingTransactionInCache transactionProposal (fee: IBlockchainFeeInfo) txId = let amountTransferredPlusFeeIfCurrencyFeeMatches = if transactionProposal.Amount.BalanceAtTheMomentOfSending = transactionProposal.Amount.ValueToSend - || transactionProposal.Amount.Currency <> fee.Currency then + || transactionProposal.Amount.Currency <> fee.Currency then transactionProposal.Amount.ValueToSend else transactionProposal.Amount.ValueToSend + fee.FeeValue + Caching.Instance.StoreOutgoingTransaction transactionProposal.OriginAddress transactionProposal.Amount.Currency @@ -179,20 +209,24 @@ module Account = // FIXME: if out of gas, miner fee is still spent, we should inspect GasUsed and use it for the call to // SaveOutgoingTransactionInCache - let private CheckIfOutOfGas (transactionMetadata: IBlockchainFeeInfo) (txHash: string) - : Async = + let private CheckIfOutOfGas (transactionMetadata: IBlockchainFeeInfo) (txHash: string): Async = async { match transactionMetadata with | :? Ether.TransactionMetadata as etherTxMetadata -> try - let! outOfGas = Ether.Server.IsOutOfGas transactionMetadata.Currency txHash etherTxMetadata.Fee.GasLimit + let! outOfGas = + Ether.Server.IsOutOfGas transactionMetadata.Currency txHash etherTxMetadata.Fee.GasLimit + 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) - | _ -> - () + with ex -> + return raise + <| Exception + (SPrintF1 + "An issue occurred while trying to check if the following transaction ran out of gas: %s" + txHash, + ex) + | _ -> () } // FIXME: broadcasting shouldn't just get N consistent replies from FaultToretantClient, @@ -203,9 +237,9 @@ module Account = let currency = trans.TransactionInfo.Proposal.Amount.Currency let! txId = - if currency.IsEtherBased() then + if currency.IsEtherBased () then Ether.Account.BroadcastTransaction trans - elif currency.IsUtxo() then + elif currency.IsUtxo () then UtxoCoin.Account.BroadcastTransaction currency trans else failwith <| SPrintF1 "Unknown currency %A" currency @@ -215,65 +249,54 @@ module Account = SaveOutgoingTransactionInCache trans.TransactionInfo.Proposal trans.TransactionInfo.Metadata txId let uri = BlockExplorer.GetTransaction currency txId + 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 -> - Ether.Account.SignTransaction - account - etherTxMetadata - destination - amount - password + Ether.Account.SignTransaction account etherTxMetadata destination amount password | :? UtxoCoin.TransactionMetadata as btcTxMetadata -> match account with | :? UtxoCoin.NormalUtxoAccount as utxoAccount -> - UtxoCoin.Account.SignTransaction - utxoAccount - btcTxMetadata - destination - amount - password - | _ -> - failwith "An UtxoCoin.TransactionMetadata should come with a UtxoCoin.Account" + UtxoCoin.Account.SignTransaction utxoAccount btcTxMetadata destination amount password + | _ -> failwith "An UtxoCoin.TransactionMetadata should come with a UtxoCoin.Account" | _ -> failwith "fee type unknown" let CheckValidPassword (password: string) = let checkJobs = seq { - for account in GetAllActiveAccounts().OfType() do + 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 - } + 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 let private CreateArchivedAccount (currency: Currency) (unencryptedPrivateKey: string): ArchivedAccount = let fromUnencryptedPrivateKeyToPublicAddressFunc = - if currency.IsUtxo() then + if currency.IsUtxo () then UtxoCoin.Account.GetPublicAddressFromUnencryptedPrivateKey currency - elif currency.IsEther() then + elif currency.IsEther () then Ether.Account.GetPublicAddressFromUnencryptedPrivateKey else failwith <| SPrintF1 "Unknown currency %A" currency @@ -281,38 +304,47 @@ module Account = let fromConfigFileToPublicAddressFunc (accountConfigFile: FileRepresentation) = // there's no ETH unencrypted standard: https://github.com/ethereum/wiki/wiki/Web3-Secret-Storage-Definition // ... so we simply write the private key in string format - let privateKeyFromConfigFile = accountConfigFile.Content() + let privateKeyFromConfigFile = accountConfigFile.Content () fromUnencryptedPrivateKeyToPublicAddressFunc privateKeyFromConfigFile let fileName = fromUnencryptedPrivateKeyToPublicAddressFunc unencryptedPrivateKey - let conceptAccount = { - Currency = currency - FileRepresentation = { Name = fileName; Content = fun _ -> unencryptedPrivateKey } - ExtractPublicAddressFromConfigFileFunc = fromConfigFileToPublicAddressFunc - } + + let conceptAccount = + { + Currency = currency + FileRepresentation = + { + Name = fileName + Content = fun _ -> unencryptedPrivateKey + } + ExtractPublicAddressFromConfigFileFunc = fromConfigFileToPublicAddressFunc + } + let newAccountFile = Config.AddAccount conceptAccount AccountKind.Archived - ArchivedAccount(currency, newAccountFile, fromConfigFileToPublicAddressFunc) + ArchivedAccount (currency, newAccountFile, fromConfigFileToPublicAddressFunc) + + let Archive (account: NormalAccount) (password: string): unit = + let currency = (account :> IAccount).Currency - let Archive (account: NormalAccount) - (password: string) - : unit = - let currency = (account:>IAccount).Currency let privateKeyAsString = - if currency.IsUtxo() then + if currency.IsUtxo () then let privKey = UtxoCoin.Account.GetPrivateKey account password privKey.GetWif(UtxoCoin.Account.GetNetwork currency).ToWif() - elif currency.IsEther() then + elif currency.IsEther () then let privKey = Ether.Account.GetPrivateKey account password - privKey.GetPrivateKey() + privKey.GetPrivateKey () else failwith <| SPrintF1 "Unknown currency %A" currency + 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 @@ -320,18 +352,19 @@ module Account = match account with | :? UtxoCoin.ArchivedUtxoAccount as utxoAccount -> UtxoCoin.Account.SweepArchivedFunds utxoAccount balance destination utxoTxMetadata - | _ -> - failwith "If tx metadata is UTXO type, archived account should be too" + | _ -> 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 + if (baseAccount.PublicAddress.Equals (destination, StringComparison.InvariantCultureIgnoreCase)) then raise DestinationEqualToOrigin let currency = baseAccount.Currency @@ -342,21 +375,21 @@ module Account = let! txId = match txMetadata with | :? UtxoCoin.TransactionMetadata as btcTxMetadata -> - if not (currency.IsUtxo()) then - failwith <| SPrintF1 "Currency %A not Utxo-type but tx metadata is? report this bug (sendpayment)" - currency + if not (currency.IsUtxo ()) then + failwith + <| SPrintF1 + "Currency %A not Utxo-type but tx metadata is? report this bug (sendpayment)" + currency match account with | :? UtxoCoin.NormalUtxoAccount as utxoAccount -> UtxoCoin.Account.SendPayment utxoAccount btcTxMetadata destination amount password - | _ -> - failwith "Account not Utxo-type but tx metadata is? report this bug (sendpayment)" + | _ -> failwith "Account not Utxo-type but tx metadata is? report this bug (sendpayment)" | :? Ether.TransactionMetadata as etherTxMetadata -> - if not (currency.IsEtherBased()) then + 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" + | _ -> failwith "Unknown tx metadata type" do! CheckIfOutOfGas txMetadata txId @@ -370,19 +403,23 @@ module Account = SaveOutgoingTransactionInCache transactionProposal txMetadata txId let uri = BlockExplorer.GetTransaction currency txId + return uri } - let SignUnsignedTransaction (account) - (unsignedTrans: UnsignedTransaction) - password = - let rawTransaction = SignTransaction account - unsignedTrans.Proposal.DestinationAddress - unsignedTrans.Proposal.Amount - unsignedTrans.Metadata - password - - { TransactionInfo = unsignedTrans; RawTransaction = rawTransaction } + let SignUnsignedTransaction (account) (unsignedTrans: UnsignedTransaction) password = + let rawTransaction = + SignTransaction + account + unsignedTrans.Proposal.DestinationAddress + unsignedTrans.Proposal.Amount + unsignedTrans.Metadata + password + + { + TransactionInfo = unsignedTrans + RawTransaction = rawTransaction + } let public ExportSignedTransaction (trans: SignedTransaction<_>) = Marshalling.Serialize trans @@ -390,188 +427,240 @@ module Account = let SaveSignedTransaction (trans: SignedTransaction<_>) (filePath: string) = let json = - match trans.TransactionInfo.Metadata.GetType() with + match trans.TransactionInfo.Metadata.GetType () with | t when t = typeof -> - let unsignedEthTx = { - Metadata = box trans.TransactionInfo.Metadata :?> Ether.TransactionMetadata; - Proposal = trans.TransactionInfo.Proposal; - Cache = trans.TransactionInfo.Cache; - } - let signedEthTx = { - TransactionInfo = unsignedEthTx; - RawTransaction = trans.RawTransaction; - } + let unsignedEthTx = + { + Metadata = box trans.TransactionInfo.Metadata :?> Ether.TransactionMetadata + Proposal = trans.TransactionInfo.Proposal + Cache = trans.TransactionInfo.Cache + } + + let signedEthTx = + { + TransactionInfo = unsignedEthTx + RawTransaction = trans.RawTransaction + } + ExportSignedTransaction signedEthTx | t when t = typeof -> - let unsignedBtcTx = { - Metadata = box trans.TransactionInfo.Metadata :?> UtxoCoin.TransactionMetadata; - Proposal = trans.TransactionInfo.Proposal; - Cache = trans.TransactionInfo.Cache; - } - let signedBtcTx = { - TransactionInfo = unsignedBtcTx; - RawTransaction = trans.RawTransaction; - } + let unsignedBtcTx = + { + Metadata = box trans.TransactionInfo.Metadata :?> UtxoCoin.TransactionMetadata + Proposal = trans.TransactionInfo.Proposal + Cache = trans.TransactionInfo.Cache + } + + let signedBtcTx = + { + TransactionInfo = unsignedBtcTx + RawTransaction = trans.RawTransaction + } + ExportSignedTransaction signedBtcTx | _ -> failwith "Unknown miner fee type" - File.WriteAllText(filePath, json) + File.WriteAllText (filePath, json) - let CreateReadOnlyAccounts (watchWalletInfo: WatchWalletInfo): Async = async { - for etherCurrency in Currency.GetAll().Where(fun currency -> currency.IsEtherBased()) do - do! ValidateAddress etherCurrency watchWalletInfo.EtherPublicAddress - let conceptAccountForReadOnlyAccount = { - Currency = etherCurrency - FileRepresentation = { Name = watchWalletInfo.EtherPublicAddress; Content = fun _ -> String.Empty } - ExtractPublicAddressFromConfigFileFunc = (fun file -> file.Name) - } - Config.AddAccount conceptAccountForReadOnlyAccount AccountKind.ReadOnly |> ignore - - for utxoCurrency in Currency.GetAll().Where(fun currency -> currency.IsUtxo()) do - let address = - UtxoCoin.Account.GetPublicAddressFromPublicKey utxoCurrency - (NBitcoin.PubKey(watchWalletInfo.UtxoCoinPublicKey)) - do! ValidateAddress utxoCurrency address - let conceptAccountForReadOnlyAccount = { - Currency = utxoCurrency - FileRepresentation = { Name = address; Content = fun _ -> watchWalletInfo.UtxoCoinPublicKey } - ExtractPublicAddressFromConfigFileFunc = (fun file -> file.Name) - } - Config.AddAccount conceptAccountForReadOnlyAccount AccountKind.ReadOnly |> ignore - } + let CreateReadOnlyAccounts (watchWalletInfo: WatchWalletInfo): Async = + async { + for etherCurrency in Currency.GetAll().Where(fun currency -> currency.IsEtherBased ()) do + do! ValidateAddress etherCurrency watchWalletInfo.EtherPublicAddress + + let conceptAccountForReadOnlyAccount = + { + Currency = etherCurrency + FileRepresentation = + { + Name = watchWalletInfo.EtherPublicAddress + Content = fun _ -> String.Empty + } + ExtractPublicAddressFromConfigFileFunc = (fun file -> file.Name) + } + + Config.AddAccount conceptAccountForReadOnlyAccount AccountKind.ReadOnly + |> ignore + + for utxoCurrency in Currency.GetAll().Where(fun currency -> currency.IsUtxo ()) do + let address = + UtxoCoin.Account.GetPublicAddressFromPublicKey + utxoCurrency + (NBitcoin.PubKey (watchWalletInfo.UtxoCoinPublicKey)) + + do! ValidateAddress utxoCurrency address + + let conceptAccountForReadOnlyAccount = + { + Currency = utxoCurrency + FileRepresentation = + { + Name = address + Content = fun _ -> watchWalletInfo.UtxoCoinPublicKey + } + ExtractPublicAddressFromConfigFileFunc = (fun file -> file.Name) + } + + Config.AddAccount conceptAccountForReadOnlyAccount AccountKind.ReadOnly + |> ignore + } let Remove (account: ReadOnlyAccount) = Config.RemoveReadOnlyAccount account - let private CreateConceptEtherAccountInternal (password: string) (seed: array) - : Asyncstring)> = + 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) - : Asyncstring)> = + let private CreateConceptAccountInternal + (currency: Currency) + (password: string) + (seed: array) + : Async string)> + = async { - if currency.IsUtxo() then + if currency.IsUtxo () then let! virtualFile = UtxoCoin.Account.Create currency password seed return virtualFile, UtxoCoin.Account.GetPublicAddressFromNormalAccountFile currency - elif currency.IsEtherBased() then + elif currency.IsEtherBased () then return! CreateConceptEtherAccountInternal password seed else return failwith <| SPrintF1 "Unknown currency %A" currency } - let CreateConceptAccount (currency: Currency) (password: string) (seed: array) - : Async = + let CreateConceptAccount (currency: Currency) (password: string) (seed: array): Async = async { - let! virtualFile, fromEncPrivKeyToPublicAddressFunc = - CreateConceptAccountInternal currency password seed + let! virtualFile, fromEncPrivKeyToPublicAddressFunc = CreateConceptAccountInternal currency password seed + return { - Currency = currency; + Currency = currency FileRepresentation = virtualFile - ExtractPublicAddressFromConfigFileFunc = fromEncPrivKeyToPublicAddressFunc; + 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 + return singleAccount :: List.Empty } - let CreateEtherNormalAccounts (password: string) (seed: array) - : Async> = - 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 - } + let CreateEtherNormalAccounts (password: string) (seed: array): Async> = + 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 + } + etherAccounts let CreateNormalAccount (conceptAccount: ConceptAccount): NormalAccount = let newAccountFile = Config.AddAccount conceptAccount AccountKind.Normal - NormalAccount(conceptAccount.Currency, newAccountFile, conceptAccount.ExtractPublicAddressFromConfigFileFunc) - - let GenerateMasterPrivateKey (passphrase: string) - (dobPartOfSalt: DateTime) (emailPartOfSalt: string) - : Async> = + NormalAccount (conceptAccount.Currency, newAccountFile, conceptAccount.ExtractPublicAddressFromConfigFileFunc) + + let GenerateMasterPrivateKey + (passphrase: string) + (dobPartOfSalt: DateTime) + (emailPartOfSalt: string) + : Async> + = async { - let salt = SPrintF2 "%s+%s" (dobPartOfSalt.Date.ToString("yyyyMMdd")) (emailPartOfSalt.ToLower()) + let salt = + SPrintF2 "%s+%s" (dobPartOfSalt.Date.ToString ("yyyyMMdd")) (emailPartOfSalt.ToLower ()) + let privateKeyBytes = WarpKey.CreatePrivateKey passphrase salt return privateKeyBytes } - let CreateAllConceptAccounts (privateKeyBytes: array) (encryptionPassword: string) - : Async> = async { - let etherAccounts = CreateEtherNormalAccounts encryptionPassword privateKeyBytes - let nonEthCurrencies = Currency.GetAll().Where(fun currency -> not (currency.IsEtherBased())) + let CreateAllConceptAccounts (privateKeyBytes: array) (encryptionPassword: string): Async> = + async { + let etherAccounts = CreateEtherNormalAccounts encryptionPassword privateKeyBytes + let nonEthCurrencies = Currency.GetAll().Where(fun currency -> not (currency.IsEtherBased ())) + + let nonEtherAccounts: List>> = + seq { + // TODO: figure out if we can reuse CPU computation of WIF creation between BTC<C + for nonEthCurrency in nonEthCurrencies do + yield CreateConceptAccountAux nonEthCurrency encryptionPassword privateKeyBytes + } + |> List.ofSeq - let nonEtherAccounts: List>> = - seq { - // TODO: figure out if we can reuse CPU computation of WIF creation between BTC<C - for nonEthCurrency in nonEthCurrencies do - yield CreateConceptAccountAux nonEthCurrency encryptionPassword privateKeyBytes - } |> List.ofSeq + let allAccounts = etherAccounts :: nonEtherAccounts - let allAccounts = etherAccounts::nonEtherAccounts + let createAllAccountsJob = Async.Parallel allAccounts - let createAllAccountsJob = Async.Parallel allAccounts + let! allCreatedConceptAccounts = createAllAccountsJob - let! allCreatedConceptAccounts = createAllAccountsJob - let allConceptAccounts = - seq { - for accountGroup in allCreatedConceptAccounts do - for conceptAccount in accountGroup do - yield conceptAccount - } - return allConceptAccounts - } - - let CreateAllAccounts (masterPrivateKeyTask: Task>) (encryptionPassword: string): Async = async { - let! privateKeyBytes = Async.AwaitTask masterPrivateKeyTask - let! allConceptAccounts = CreateAllConceptAccounts privateKeyBytes encryptionPassword - for conceptAccount in allConceptAccounts do - CreateNormalAccount conceptAccount |> ignore - } - - let CheckValidSeed (passphrase: string) - (dobPartOfSalt: DateTime) - (emailPartOfSalt: string) = + let allConceptAccounts = + seq { + for accountGroup in allCreatedConceptAccounts do + for conceptAccount in accountGroup do + yield conceptAccount + } + + return allConceptAccounts + } + + let CreateAllAccounts (masterPrivateKeyTask: Task>) (encryptionPassword: string): Async = + async { + let! privateKeyBytes = Async.AwaitTask masterPrivateKeyTask + let! allConceptAccounts = CreateAllConceptAccounts privateKeyBytes encryptionPassword + + for conceptAccount in allConceptAccounts do + CreateNormalAccount conceptAccount |> ignore + } + + let CheckValidSeed (passphrase: string) (dobPartOfSalt: DateTime) (emailPartOfSalt: string) = async { 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() = - Config.Wipe() - Caching.Instance.ClearAll() + let WipeAll () = + Config.Wipe () + Caching.Instance.ClearAll () let public ExportUnsignedTransactionToJson trans = Marshalling.Serialize trans - let private SerializeUnsignedTransactionPlain (transProposal: UnsignedTransactionProposal) - (txMetadata: IBlockchainFeeInfo) - : string = - let readOnlyAccounts = GetAllActiveAccounts().OfType() + let private SerializeUnsignedTransactionPlain + (transProposal: UnsignedTransactionProposal) + (txMetadata: IBlockchainFeeInfo) + : string + = + let readOnlyAccounts = GetAllActiveAccounts().OfType () match txMetadata with | :? Ether.TransactionMetadata as etherTxMetadata -> @@ -580,11 +669,13 @@ 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) + File.WriteAllText (filePath, json) let public ImportUnsignedTransactionFromJson (json: string): UnsignedTransaction = @@ -593,14 +684,17 @@ module Account = match transType with | _ when transType = typeof> -> let deserializedBtcTransaction: UnsignedTransaction = - Marshalling.Deserialize json - deserializedBtcTransaction.ToAbstract() + Marshalling.Deserialize json + + deserializedBtcTransaction.ToAbstract () | _ when transType = typeof> -> let deserializedBtcTransaction: UnsignedTransaction = - Marshalling.Deserialize json - deserializedBtcTransaction.ToAbstract() + Marshalling.Deserialize json + + deserializedBtcTransaction.ToAbstract () | unexpectedType -> - raise <| Exception(SPrintF1 "Unknown unsignedTransaction subtype: %s" unexpectedType.FullName) + raise + <| Exception (SPrintF1 "Unknown unsignedTransaction subtype: %s" unexpectedType.FullName) let public ImportSignedTransactionFromJson (json: string): SignedTransaction = let transType = Marshalling.ExtractType json @@ -608,22 +702,22 @@ module Account = match transType with | _ when transType = typeof> -> let deserializedBtcTransaction: SignedTransaction = - Marshalling.Deserialize json - deserializedBtcTransaction.ToAbstract() + Marshalling.Deserialize json + + deserializedBtcTransaction.ToAbstract () | _ when transType = typeof> -> - let deserializedBtcTransaction: SignedTransaction = - Marshalling.Deserialize json - deserializedBtcTransaction.ToAbstract() + let deserializedBtcTransaction: SignedTransaction = Marshalling.Deserialize json + deserializedBtcTransaction.ToAbstract () | unexpectedType -> - raise <| Exception(SPrintF1 "Unknown signedTransaction subtype: %s" unexpectedType.FullName) + raise + <| Exception (SPrintF1 "Unknown signedTransaction subtype: %s" unexpectedType.FullName) let LoadSignedTransactionFromFile (filePath: string) = - let signedTransInJson = File.ReadAllText(filePath) + let signedTransInJson = File.ReadAllText (filePath) ImportSignedTransactionFromJson signedTransInJson let LoadUnsignedTransactionFromFile (filePath: string): UnsignedTransaction = - let unsignedTransInJson = File.ReadAllText(filePath) + let unsignedTransInJson = File.ReadAllText (filePath) ImportUnsignedTransactionFromJson unsignedTransInJson - diff --git a/src/GWallet.Backend/AccountTypes.fs b/src/GWallet.Backend/AccountTypes.fs index bd2aec6ba..be5cbdf1d 100644 --- a/src/GWallet.Backend/AccountTypes.fs +++ b/src/GWallet.Backend/AccountTypes.fs @@ -10,9 +10,10 @@ type WatchWalletInfo = type FileRepresentation = { - Name: string; - Content: unit->string; + Name: string + Content: unit -> string } + static member FromFile (file: FileInfo) = { Name = Path.GetFileName file.FullName @@ -21,16 +22,17 @@ type FileRepresentation = type ConceptAccount = { - Currency: Currency; - FileRepresentation: FileRepresentation; - ExtractPublicAddressFromConfigFileFunc: FileRepresentation->string; + Currency: Currency + FileRepresentation: FileRepresentation + ExtractPublicAddressFromConfigFileFunc: FileRepresentation -> string } type AccountKind = | Normal | ReadOnly | Archived - static member All() = + + static member All () = seq { yield Normal yield ReadOnly @@ -38,42 +40,45 @@ type AccountKind = } type IAccount = - abstract member Currency: Currency with get - abstract member PublicAddress: string with get + abstract Currency: Currency + abstract PublicAddress: string [] -type BaseAccount(currency: Currency, accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string) = - member val AccountFile = accountFile with get +type BaseAccount (currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string) = + member val AccountFile = accountFile - abstract member Kind: AccountKind + abstract Kind: AccountKind interface IAccount with - member val Currency = currency with get - member val PublicAddress = - fromAccountFileToPublicAddress accountFile with get + member val Currency = currency + member val PublicAddress = fromAccountFileToPublicAddress accountFile -type NormalAccount(currency: Currency, accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string) = +type NormalAccount (currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string) = inherit BaseAccount(currency, accountFile, fromAccountFileToPublicAddress) - member internal __.GetEncryptedPrivateKey() = - accountFile.Content() + member internal __.GetEncryptedPrivateKey () = + accountFile.Content () override __.Kind = AccountKind.Normal -type ReadOnlyAccount(currency: Currency, accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string) = +type ReadOnlyAccount (currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string) = inherit BaseAccount(currency, accountFile, fromAccountFileToPublicAddress) override __.Kind = AccountKind.ReadOnly -type ArchivedAccount(currency: Currency, accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string) = +type ArchivedAccount (currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string) = inherit BaseAccount(currency, accountFile, fromAccountFileToPublicAddress) - member internal __.GetUnencryptedPrivateKey() = - accountFile.Content() + member internal __.GetUnencryptedPrivateKey () = + accountFile.Content () override __.Kind = AccountKind.Archived diff --git a/src/GWallet.Backend/BlockExplorer.fs b/src/GWallet.Backend/BlockExplorer.fs index 8bce8fbd1..b178155cc 100644 --- a/src/GWallet.Backend/BlockExplorer.fs +++ b/src/GWallet.Backend/BlockExplorer.fs @@ -10,34 +10,33 @@ module BlockExplorer = let GetTransactionHistory (account: IAccount): Uri = let baseUrl = - match account.Currency with - | Currency.BTC -> - // SmartBit explorer is built on top of NBitcoin: https://github.com/ProgrammingBlockchain/ProgrammingBlockchain/issues/1 - "https://www.smartbit.com.au/address/" - | Currency.LTC -> - // because the more popular https://live.blockcypher.com/ltc/ doesn't seem to have segwit support - "https://chainz.cryptoid.info/ltc/address.dws?" - | Currency.ETH -> - // most popular one... - "https://etherscan.io/address/" - | Currency.ETC -> - // the only one? minergate.com seems to only show blocks, not addresses - "https://gastracker.io/addr/" - | Currency.SAI | Currency.DAI -> - SPrintF1 "https://etherscan.io/token/%s?a=" (TokenManager.GetTokenContractAddress account.Currency) - Uri(baseUrl + account.PublicAddress) + match account.Currency with + | Currency.BTC -> + // SmartBit explorer is built on top of NBitcoin: https://github.com/ProgrammingBlockchain/ProgrammingBlockchain/issues/1 + "https://www.smartbit.com.au/address/" + | Currency.LTC -> + // because the more popular https://live.blockcypher.com/ltc/ doesn't seem to have segwit support + "https://chainz.cryptoid.info/ltc/address.dws?" + | Currency.ETH -> + // most popular one... + "https://etherscan.io/address/" + | Currency.ETC -> + // the only one? minergate.com seems to only show blocks, not addresses + "https://gastracker.io/addr/" + | Currency.SAI + | Currency.DAI -> + SPrintF1 "https://etherscan.io/token/%s?a=" (TokenManager.GetTokenContractAddress account.Currency) + + Uri (baseUrl + account.PublicAddress) let GetTransaction (currency: Currency) (txHash: string): Uri = let baseUrl = - match currency with - | Currency.BTC -> - "https://www.smartbit.com.au/tx/" - | Currency.LTC -> - "https://chainz.cryptoid.info/ltc/tx.dws?" - | Currency.ETH -> - "https://etherscan.io/tx/" - | Currency.ETC -> - "https://gastracker.io/tx/" - | Currency.DAI | Currency.SAI -> - "https://etherscan.io/tx/" - Uri(baseUrl + txHash) + match currency with + | Currency.BTC -> "https://www.smartbit.com.au/tx/" + | Currency.LTC -> "https://chainz.cryptoid.info/ltc/tx.dws?" + | Currency.ETH -> "https://etherscan.io/tx/" + | Currency.ETC -> "https://gastracker.io/tx/" + | Currency.DAI + | Currency.SAI -> "https://etherscan.io/tx/" + + Uri (baseUrl + txHash) diff --git a/src/GWallet.Backend/Caching.fs b/src/GWallet.Backend/Caching.fs index 38288315a..d50ff4f93 100644 --- a/src/GWallet.Backend/Caching.fs +++ b/src/GWallet.Backend/Caching.fs @@ -9,10 +9,11 @@ open GWallet.Backend.FSharpUtil.UwpHacks type CachedNetworkData = { - UsdPrice: Map>; - Balances: Map>>; - OutgoingTransactions: Map>>>; + UsdPrice: Map> + Balances: Map>> + OutgoingTransactions: Map>>> } + static member Empty = { UsdPrice = Map.empty @@ -22,46 +23,74 @@ type CachedNetworkData = static member FromDietCache (dietCache: DietCache): CachedNetworkData = let now = DateTime.UtcNow + let fiatPrices = - [ for KeyValue(currencyString, price) in dietCache.UsdPrice -> (Currency.Parse currencyString,(price,now)) ] - |> Map.ofSeq + [ + for KeyValue (currencyString, price) in dietCache.UsdPrice -> + (Currency.Parse currencyString, (price, now)) + ] + |> Map.ofSeq + let balances = seq { - for KeyValue(address,currencies) in dietCache.Addresses do + for KeyValue (address, currencies) in dietCache.Addresses do for currencyStr in currencies do match dietCache.Balances.TryFind currencyStr with | None -> () - | Some balance -> - yield (Currency.Parse currencyStr),Map.empty.Add(address,(balance,now)) - } |> Map.ofSeq - { UsdPrice = fiatPrices; Balances = balances - OutgoingTransactions = Map.empty; } - - member self.ToDietCache(readOnlyAccounts: seq) = - let rec extractAddressesFromAccounts (acc: Map>) (accounts: List) - : Map> = - match accounts with - | [] -> acc - | head::tail -> - let existingCurrenciesForHeadAddress = - match acc.TryFind head.PublicAddress with - | None -> List.Empty - | Some currencies -> currencies - let newAcc = acc.Add(head.PublicAddress, head.Currency.ToString()::existingCurrenciesForHeadAddress) - extractAddressesFromAccounts newAcc tail + | Some balance -> yield (Currency.Parse currencyStr), Map.empty.Add (address, (balance, now)) + } + |> Map.ofSeq + + { + UsdPrice = fiatPrices + Balances = balances + OutgoingTransactions = Map.empty + } + + member self.ToDietCache (readOnlyAccounts: seq) = + let rec extractAddressesFromAccounts + (acc: Map>) + (accounts: List) + : Map> + = + match accounts with + | [] -> acc + | head :: tail -> + let existingCurrenciesForHeadAddress = + match acc.TryFind head.PublicAddress with + | None -> List.Empty + | Some currencies -> currencies + + let newAcc = + acc.Add (head.PublicAddress, head.Currency.ToString () :: existingCurrenciesForHeadAddress) + + extractAddressesFromAccounts newAcc tail + let fiatPrices = - [ for (KeyValue(currency, (price,_))) in self.UsdPrice -> currency.ToString(),price ] - |> Map.ofSeq - let addresses = extractAddressesFromAccounts - Map.empty (List.ofSeq readOnlyAccounts |> List.map (fun acc -> acc:>IAccount)) + [ + for (KeyValue (currency, (price, _))) in self.UsdPrice -> currency.ToString (), price + ] + |> Map.ofSeq + + let addresses = + extractAddressesFromAccounts + Map.empty + (List.ofSeq readOnlyAccounts |> List.map (fun acc -> acc :> IAccount)) + let balances = seq { - for (KeyValue(currency, currencyBalances)) in self.Balances do - for (KeyValue(address, (balance,_))) in currencyBalances do - if readOnlyAccounts.Any(fun account -> (account:>IAccount).PublicAddress = address) then - yield (currency.ToString(),balance) - } |> Map.ofSeq - { UsdPrice = fiatPrices; Addresses = addresses; Balances = balances; } + for (KeyValue (currency, currencyBalances)) in self.Balances do + for (KeyValue (address, (balance, _))) in currencyBalances do + if readOnlyAccounts.Any (fun account -> (account :> IAccount).PublicAddress = address) then + yield (currency.ToString (), balance) + } + |> Map.ofSeq + + { + UsdPrice = fiatPrices + Addresses = addresses + Balances = balances + } type CacheFiles = { @@ -71,18 +100,18 @@ type CacheFiles = module Caching = - let private GetCacheDir() = + let private GetCacheDir () = let configPath = Config.GetConfigDirForThisProgram().FullName - let configDir = DirectoryInfo(Path.Combine(configPath, "cache")) + let configDir = DirectoryInfo (Path.Combine (configPath, "cache")) if not configDir.Exists then - configDir.Create() + configDir.Create () configDir let private defaultCacheFiles = { - CachedNetworkData = FileInfo(Path.Combine(GetCacheDir().FullName, "networkdata.json")) - ServerStats = FileInfo(Path.Combine(GetCacheDir().FullName, - ServerRegistry.ServersEmbeddedResourceFileName)) + CachedNetworkData = FileInfo (Path.Combine (GetCacheDir().FullName, "networkdata.json")) + ServerStats = + FileInfo (Path.Combine (GetCacheDir().FullName, ServerRegistry.ServersEmbeddedResourceFileName)) } let public ImportFromJson<'T> (cacheData: string): 'T = @@ -96,6 +125,7 @@ module Caching = Some json let droppedCachedMsgWarning = "Warning: cleaning incompatible cache data found from different GWallet version" + let private LoadFromDiskInternal<'T> (file: FileInfo): Option<'T> = try match LoadFromDiskInner file with @@ -105,127 +135,138 @@ module Caching = let deserializedJson = ImportFromJson json Some deserializedJson with - | :? VersionMismatchDuringDeserializationException -> - Infrastructure.LogError droppedCachedMsgWarning - None - | :? DeserializationException -> - // FIXME: report a warning to sentry here... - Infrastructure.LogError "Warning: cleaning incompatible cache data found" - Infrastructure.LogDebug (SPrintF1 "JSON content: <<<%s>>>" json) - None - with - | :? FileNotFoundException -> None + | :? VersionMismatchDuringDeserializationException -> + Infrastructure.LogError droppedCachedMsgWarning + None + | :? DeserializationException -> + // FIXME: report a warning to sentry here... + Infrastructure.LogError "Warning: cleaning incompatible cache data found" + Infrastructure.LogDebug (SPrintF1 "JSON content: <<<%s>>>" json) + None + with :? FileNotFoundException -> None // this weird thing could happen because the previous version of GWallet didn't have a new element // FIXME: we should save each Map<> into its own file let private WeirdNullCheckToDetectVersionConflicts x = - Object.ReferenceEquals(x, null) + Object.ReferenceEquals (x, null) - let private LoadFromDisk (files: CacheFiles): bool*CachedNetworkData*ServerRanking = + let private LoadFromDisk (files: CacheFiles): bool * CachedNetworkData * ServerRanking = let maybeNetworkData = LoadFromDiskInternal files.CachedNetworkData - let maybeFirstRun,resultingNetworkData = + + let maybeFirstRun, resultingNetworkData = match maybeNetworkData with - | None -> - true,CachedNetworkData.Empty + | None -> true, CachedNetworkData.Empty | Some networkData -> if WeirdNullCheckToDetectVersionConflicts networkData.OutgoingTransactions then Infrastructure.LogError droppedCachedMsgWarning - true,CachedNetworkData.Empty + true, CachedNetworkData.Empty else - false,networkData + 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>>) = + | 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>>) + = match currencyList with | [] -> accumulator - | address::tail -> + | address :: tail -> let maybeCachedBalance = Map.tryFind address oldMap match maybeCachedBalance with | None -> let newCachedBalance = newMap.[address] - let newAcc = accumulator.Add(address, newCachedBalance) + let newAcc = accumulator.Add (address, newCachedBalance) MergeRatesInternal oldMap newMap tail newAcc - | Some(_,time) -> - let newBalance,newTime = newMap.[address] + | Some (_, time) -> + let newBalance, newTime = newMap.[address] + let newAcc = if (newTime > time) then - accumulator.Add(address, (newBalance,newTime)) + accumulator.Add (address, (newBalance, newTime)) else accumulator + MergeRatesInternal oldMap newMap tail newAcc let private MergeRates (oldMap: Map<'K, CachedValue<'V>>) (newMap: Map<'K, CachedValue<'V>>) = 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 -> + | (currency, address) :: tail -> let maybeCachedBalances = Map.tryFind currency oldMap match maybeCachedBalances with | None -> let newCachedBalance = newMap.[currency].[address] - let newCachedBalancesForThisCurrency = [(address,newCachedBalance)] |> Map.ofList - let newAcc = accumulator.Add(currency, newCachedBalancesForThisCurrency) + let newCachedBalancesForThisCurrency = [ (address, newCachedBalance) ] |> Map.ofList + let newAcc = accumulator.Add (currency, newCachedBalancesForThisCurrency) MergeBalancesInternal oldMap newMap tail newAcc - | Some(balancesMapForCurrency) -> + | Some (balancesMapForCurrency) -> let accBalancesForThisCurrency = accumulator.[currency] let maybeCachedBalance = Map.tryFind address balancesMapForCurrency match maybeCachedBalance with | None -> let newCachedBalance = newMap.[currency].[address] - let newAccBalances = accBalancesForThisCurrency.Add(address, newCachedBalance) - let newAcc = accumulator.Add(currency, newAccBalances) + let newAccBalances = accBalancesForThisCurrency.Add (address, newCachedBalance) + let newAcc = accumulator.Add (currency, newAccBalances) MergeBalancesInternal oldMap newMap tail newAcc - | Some(_,time) -> - let newBalance,newTime = newMap.[currency].[address] + | Some (_, time) -> + let newBalance, newTime = newMap.[currency].[address] + let newAcc = if (newTime > time) then - let newAccBalances = accBalancesForThisCurrency.Add(address, (newBalance,newTime)) - accumulator.Add(currency, newAccBalances) + let newAccBalances = accBalancesForThisCurrency.Add (address, (newBalance, newTime)) + accumulator.Add (currency, newAccBalances) else accumulator + 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 - for address,_ in Map.toList subMap do - yield (currency,address) - } |> List.ofSeq + for currency, subMap in Map.toList newMap do + for address, _ in Map.toList subMap do + yield (currency, address) + } + |> List.ofSeq + MergeBalancesInternal oldMap newMap addressList oldMap // taken from http://www.fssnip.net/2z/title/All-combinations-of-list-elements let ListCombinations lst = let rec comb accLst elemLst = match elemLst with - | h::t -> - let next = [h]::List.map (fun el -> h::el) accLst @ accLst + | h :: t -> + let next = [ h ] :: List.map (fun el -> h :: el) accLst @ accLst + comb next t | _ -> accLst + comb List.Empty lst - let MapCombinations<'K,'V when 'K: comparison> (map: Map<'K,'V>): List> = + let MapCombinations<'K, 'V when 'K: comparison> (map: Map<'K, 'V>): List> = Map.toList map |> ListCombinations - type MainCache(maybeCacheFiles: Option, unconfTxExpirationSpan: TimeSpan) = + type MainCache (maybeCacheFiles: Option, unconfTxExpirationSpan: TimeSpan) = let cacheFiles = match maybeCacheFiles with | Some files -> files @@ -252,21 +293,28 @@ module Caching = let InitServers (lastServerStats: ServerRanking) = let mergedServers = ServerRegistry.MergeWithBaseline lastServerStats let mergedAndSaved = SaveServerRankingsToDisk mergedServers - for KeyValue(currency,servers) in mergedAndSaved do + 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) + Infrastructure.LogError + (SPrintF2 + "WARNING: no history stats about %A server %s" + currency + server.ServerInfo.NetworkPath) mergedServers - let firstRun,initialSessionCachedNetworkData,lastServerStats = LoadFromDisk cacheFiles + let firstRun, initialSessionCachedNetworkData, lastServerStats = LoadFromDisk cacheFiles let initialServerStats = InitServers lastServerStats 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 @@ -276,171 +324,156 @@ module Caching = 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 - ) - - let rec RemoveRangeFromMap (map: Map<'K,'V>) (list: List<'K*'V>) = + 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) + + let rec RemoveRangeFromMap (map: Map<'K, 'V>) (list: List<'K * 'V>) = match list with | [] -> map - | (key,_)::tail -> RemoveRangeFromMap (map.Remove key) tail + | (key, _) :: tail -> RemoveRangeFromMap (map.Remove key) tail let GatherDebuggingInfo (previousBalance) (currency) (address) (newCache) = let json1 = Marshalling.Serialize previousBalance let json2 = Marshalling.Serialize currency let json3 = Marshalling.Serialize address let json4 = Marshalling.Serialize newCache - String.Join(Environment.NewLine, json1, json2, json3, json4) + String.Join (Environment.NewLine, json1, json2, json3, json4) let ReportProblem (negativeBalance: decimal) (previousBalance) (currency) (address) (newCache) = - Infrastructure.ReportError (SPrintF2 "Negative balance '%s'. Details: %s" - (negativeBalance.ToString()) - (GatherDebuggingInfo - previousBalance - currency - address - newCache)) + Infrastructure.ReportError + (SPrintF2 + "Negative balance '%s'. Details: %s" + (negativeBalance.ToString ()) + (GatherDebuggingInfo previousBalance currency address newCache)) member __.ClearAll () = SaveNetworkDataToDisk CachedNetworkData.Empty - SaveServerRankingsToDisk Map.empty - |> ignore + SaveServerRankingsToDisk Map.empty |> ignore - member __.SaveSnapshot(newDietCachedData: DietCache) = + 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 with + UsdPrice = mergedUsdPrices + Balances = mergedBalances } sessionCachedNetworkData <- newSessionCachedNetworkData - SaveNetworkDataToDisk newSessionCachedNetworkData - ) + SaveNetworkDataToDisk newSessionCachedNetworkData) member __.GetLastCachedData (): CachedNetworkData = - lock cacheFiles.CachedNetworkData (fun _ -> - sessionCachedNetworkData - ) + lock cacheFiles.CachedNetworkData (fun _ -> sessionCachedNetworkData) member __.RetrieveLastKnownUsdPrice currency: NotFresh = lock cacheFiles.CachedNetworkData (fun _ -> try - Cached(sessionCachedNetworkData.UsdPrice.Item currency) + Cached (sessionCachedNetworkData.UsdPrice.Item currency) with // FIXME: rather use tryFind func instead of using a try-with block - | :? System.Collections.Generic.KeyNotFoundException -> NotAvailable - ) + :? 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)) } + { sessionCachedNetworkData with + UsdPrice = sessionCachedNetworkData.UsdPrice.Add (currency, (lastFiatUsdPrice, time)) + } + 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) + 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 + :? System.Collections.Generic.KeyNotFoundException -> NotAvailable + match balance with - | NotAvailable -> - NotAvailable - | Cached(balance,time) -> + | 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) + ReportProblem compoundBalance None currency address sessionCachedNetworkData + Cached (0.0m, time) else - Cached(compoundBalance,time) - ) + 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 + | NotAvailable -> None + | Cached (cachedBalance, _) -> Some cachedBalance member __.RetrieveAndUpdateLastCompoundBalance (address: PublicAddress) (currency: Currency) (newBalance: decimal) - : CachedValue = + : CachedValue = let time = DateTime.UtcNow lock cacheFiles.CachedNetworkData (fun _ -> - let newCachedValueWithNewBalance,previousBalance = - let newCurrencyBalances,previousBalance = + let newCachedValueWithNewBalance, previousBalance = + let newCurrencyBalances, previousBalance = match sessionCachedNetworkData.Balances.TryFind currency with - | None -> - Map.empty,None + | 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 + 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 + 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 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 - } + newCachedValueWithNewBalance.OutgoingTransactions.Add + (currency, currencyAddresses.Add (address, newAddressTransactions)) + + return { newCachedValueWithNewBalance with + OutgoingTransactions = newOutgoingTransactions + } } + match maybeNewValue with | None -> newCachedValueWithNewBalance | Some x -> x @@ -450,51 +483,52 @@ module Caching = SaveNetworkDataToDisk newCachedValueWithNewBalanceAndMaybeLessTransactions let allTransSum = - GetSumOfAllTransactions newCachedValueWithNewBalanceAndMaybeLessTransactions.OutgoingTransactions - currency - address + GetSumOfAllTransactions + newCachedValueWithNewBalanceAndMaybeLessTransactions.OutgoingTransactions + currency + address + let compoundBalance = newBalance - allTransSum if (compoundBalance < 0.0m) then - ReportProblem compoundBalance - previousBalance - currency - address - newCachedValueWithNewBalanceAndMaybeLessTransactions - 0.0m,time + ReportProblem + compoundBalance + previousBalance + currency + address + newCachedValueWithNewBalanceAndMaybeLessTransactions + 0.0m, time else - compoundBalance,time - ) + compoundBalance, time) member private __.StoreTransactionRecord (address: PublicAddress) (currency: Currency) (txId: string) (amount: decimal) - : unit = + : unit = let time = DateTime.UtcNow lock cacheFiles.CachedNetworkData (fun _ -> let newCurrencyAddresses = match sessionCachedNetworkData.OutgoingTransactions.TryFind currency with - | None -> - Map.empty - | Some currencyAddresses -> - currencyAddresses + | 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)) + | 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.OutgoingTransactions.Add + (currency, newCurrencyAddresses.Add (address, newAddressTransactions)) + + let newCachedValue = + { sessionCachedNetworkData with + OutgoingTransactions = newOutgoingTxs + } sessionCachedNetworkData <- newCachedValue - SaveNetworkDataToDisk newCachedValue - ) + SaveNetworkDataToDisk newCachedValue) member self.StoreOutgoingTransaction (address: PublicAddress) (transactionCurrency: Currency) @@ -502,70 +536,79 @@ module Caching = (txId: string) (amount: decimal) (feeAmount: decimal) - : unit = + : unit = self.StoreTransactionRecord address transactionCurrency txId amount - if transactionCurrency <> feeCurrency && (not Config.EthTokenEstimationCouldBeBuggyAsInNotAccurate) then + if transactionCurrency + <> feeCurrency + && (not Config.EthTokenEstimationCouldBeBuggyAsInNotAccurate) then self.StoreTransactionRecord address feeCurrency txId feeAmount - member __.SaveServerLastStat (serverMatchFunc: ServerDetails->bool) - (stat: HistoryFact): unit = + member __.SaveServerLastStat (serverMatchFunc: ServerDetails -> bool) (stat: HistoryFact): unit = lock cacheFiles.ServerStats (fun _ -> - let currency,serverInfo,previousLastSuccessfulCommunication = + 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 + | 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) + ({ + TimeSpan = stat.TimeSpan + Status = Success + }, + now) | Some exInfo -> - ({ TimeSpan = stat.TimeSpan - Status = Fault { Exception = exInfo - LastSuccessfulCommunication = previousLastSuccessfulCommunication }}, now) + ({ + 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 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 - ) + 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 - ) + 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 - ) + lock cacheFiles.ServerStats (fun _ -> LoadFromDiskInner cacheFiles.ServerStats) - member __.BootstrapServerStatsFromTrustedSource(): Async = + member __.BootstrapServerStatsFromTrustedSource (): Async = let downloadFile url: Async> = let tryDownloadFile url: Async = async { @@ -573,20 +616,24 @@ module Caching = let uri = Uri url let! response = Async.AwaitTask (httpClient.GetAsync uri) let isSuccess = response.IsSuccessStatusCode - let! content = Async.AwaitTask <| response.Content.ReadAsStringAsync() + + let! content = Async.AwaitTask <| response.Content.ReadAsStringAsync () + if isSuccess then return content else Infrastructure.LogError ("WARNING: error trying to retrieve server stats: " + content) + return failwith content } + async { try let! content = tryDownloadFile url return Some content with // should we specify HttpRequestException? - | ex -> + ex -> Infrastructure.ReportWarning ex return None } @@ -595,40 +642,37 @@ module Caching = let orgName1 = "nblockchain" let orgName2 = "World" let projName = "geewallet" - let ghBaseUrl,glBaseUrl,gnomeBaseUrl = - "https://raw.githubusercontent.com","https://gitlab.com","https://gitlab.gnome.org" + + let ghBaseUrl, glBaseUrl, gnomeBaseUrl = + "https://raw.githubusercontent.com", "https://gitlab.com", "https://gitlab.gnome.org" + let pathToFile = SPrintF1 "src/GWallet.Backend/%s" ServerRegistry.ServersEmbeddedResourceFileName - let gitHub = - SPrintF5 "%s/%s/%s/%s/%s" - ghBaseUrl orgName1 projName targetBranch pathToFile + let gitHub = SPrintF5 "%s/%s/%s/%s/%s" ghBaseUrl orgName1 projName targetBranch pathToFile let gitLab = - SPrintF5 "%s/%s/%s/raw/%s/%s" - glBaseUrl orgName1 projName targetBranch pathToFile + SPrintF5 "%s/%s/%s/raw/%s/%s" glBaseUrl orgName1 projName targetBranch pathToFile let gnomeGitLab = - SPrintF5 "%s/%s/%s/raw/%s/%s" - gnomeBaseUrl orgName2 projName targetBranch pathToFile + SPrintF5 "%s/%s/%s/raw/%s/%s" gnomeBaseUrl orgName2 projName targetBranch pathToFile let allUrls = [ gitHub; gitLab; gnomeGitLab ] - let allJobs = - allUrls |> Seq.map downloadFile + let allJobs = allUrls |> Seq.map downloadFile async { let! maybeLastServerStatsInJson = Async.Choice allJobs + match maybeLastServerStatsInJson with | None -> - Infrastructure.LogError "WARNING: Couldn't reach a trusted server to retrieve server stats to bootstrap cache, running in offline mode?" + Infrastructure.LogError + "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 - ) + sessionServerRanking <- savedServerStats) } - member __.FirstRun - with get() = firstRun + member __.FirstRun = firstRun let Instance = MainCache (None, TimeSpan.FromDays 1.0) diff --git a/src/GWallet.Backend/CachingTypes.fs b/src/GWallet.Backend/CachingTypes.fs index 4970e7e39..d2a507f6f 100644 --- a/src/GWallet.Backend/CachingTypes.fs +++ b/src/GWallet.Backend/CachingTypes.fs @@ -2,11 +2,15 @@ open System -type CachedValue<'T> = ('T*DateTime) +type CachedValue<'T> = ('T * DateTime) + type NotFresh<'T> = - NotAvailable | Cached of CachedValue<'T> + | NotAvailable + | Cached of CachedValue<'T> + type MaybeCached<'T> = - NotFresh of NotFresh<'T> | Fresh of 'T + | NotFresh of NotFresh<'T> + | Fresh of 'T type PublicAddress = string type private DietCurrency = string @@ -14,7 +18,7 @@ type private ServerIdentifier = string type DietCache = { - UsdPrice: Map; - Addresses: Map>; - Balances: Map; + UsdPrice: Map + Addresses: Map> + Balances: Map } diff --git a/src/GWallet.Backend/Config.fs b/src/GWallet.Backend/Config.fs index 2f1fbbb34..52295f3ee 100644 --- a/src/GWallet.Backend/Config.fs +++ b/src/GWallet.Backend/Config.fs @@ -33,35 +33,43 @@ module Config = // balances, so you might find discrepancies (e.g. the donut-chart-view) let internal NoNetworkBalanceForDebuggingPurposes = false - let IsWindowsPlatform() = + let IsWindowsPlatform () = Path.DirectorySeparatorChar = '\\' - let IsMacPlatform() = - let macDirs = [ "/Applications"; "/System"; "/Users"; "/Volumes" ] + let IsMacPlatform () = + let macDirs = + [ + "/Applications" + "/System" + "/Users" + "/Volumes" + ] + match Environment.OSVersion.Platform with - | PlatformID.MacOSX -> - true + | PlatformID.MacOSX -> true | PlatformID.Unix -> - if macDirs.All(fun dir -> Directory.Exists dir) then + if macDirs.All (fun dir -> Directory.Exists dir) then if not (DeviceInfo.Platform.Equals DevicePlatform.iOS) then true else false else false - | _ -> - false + | _ -> false - let GetMonoVersion(): Option = + let GetMonoVersion (): Option = FSharpUtil.option { // this gives None on MS.NET (e.g. UWP/WPF) let! monoRuntime = Type.GetType "Mono.Runtime" |> Option.ofObj // this gives None on Mono Android/iOS/macOS let! displayName = - monoRuntime.GetMethod("GetDisplayName", BindingFlags.NonPublic ||| BindingFlags.Static) |> Option.ofObj - // example: 5.12.0.309 (2018-02/39d89a335c8 Thu Sep 27 06:54:53 EDT 2018) - let fullVersion = displayName.Invoke(null, null) :?> string - let simpleVersion = fullVersion.Substring(0, fullVersion.IndexOf(' ')) |> Version + monoRuntime.GetMethod ("GetDisplayName", BindingFlags.NonPublic ||| BindingFlags.Static) + |> Option.ofObj + // example: 5.12.0.309 (2018-02/39d89a335c8 Thu Sep 27 06:54:53 EDT 2018) + let fullVersion = displayName.Invoke (null, null) :?> string + + let simpleVersion = fullVersion.Substring (0, fullVersion.IndexOf (' ')) |> Version + return simpleVersion } @@ -72,18 +80,18 @@ module Config = let internal NUMBER_OF_RETRIES_TO_SAME_SERVERS = 3u - let internal GetConfigDirForThisProgram() = - let configPath = Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData) - let configDir = DirectoryInfo(Path.Combine(configPath, "gwallet")) + let internal GetConfigDirForThisProgram () = + let configPath = Environment.GetFolderPath (Environment.SpecialFolder.ApplicationData) + let configDir = DirectoryInfo (Path.Combine (configPath, "gwallet")) if not configDir.Exists then - configDir.Create() + configDir.Create () configDir - let private GetConfigDirForAccounts() = + let private GetConfigDirForAccounts () = let configPath = GetConfigDirForThisProgram().FullName - let configDir = DirectoryInfo(Path.Combine(configPath, "accounts")) + let configDir = DirectoryInfo (Path.Combine (configPath, "accounts")) if not configDir.Exists then - configDir.Create() + configDir.Create () configDir let private GetConfigDir (currency: Currency) (accountKind: AccountKind) = @@ -91,48 +99,50 @@ module Config = let baseConfigDir = match accountKind with - | AccountKind.Normal -> - accountConfigDir - | AccountKind.ReadOnly -> - Path.Combine(accountConfigDir, "readonly") - | AccountKind.Archived -> - Path.Combine(accountConfigDir, "archived") - - let configDir = Path.Combine(baseConfigDir, currency.ToString()) |> DirectoryInfo + | AccountKind.Normal -> accountConfigDir + | AccountKind.ReadOnly -> Path.Combine (accountConfigDir, "readonly") + | AccountKind.Archived -> Path.Combine (accountConfigDir, "archived") + + let configDir = Path.Combine (baseConfigDir, currency.ToString ()) |> DirectoryInfo + if not configDir.Exists then - configDir.Create() + configDir.Create () configDir // In case a new token was added it will not have a config for an existing user // we copy the eth configs to the new tokens config directory - let PropagateEthAccountInfoToMissingTokensAccounts() = - for accountKind in (AccountKind.All()) do + let PropagateEthAccountInfoToMissingTokensAccounts () = + for accountKind in (AccountKind.All ()) do let ethConfigDir = GetConfigDir Currency.ETH accountKind - for token in Currency.GetAll() do - if token.IsEthToken() then + for token in Currency.GetAll () do + if token.IsEthToken () then let tokenConfigDir = GetConfigDir token accountKind for ethAccountFilePath in Directory.GetFiles ethConfigDir.FullName do - let newPath = ethAccountFilePath.Replace(ethConfigDir.FullName, tokenConfigDir.FullName) + let newPath = ethAccountFilePath.Replace (ethConfigDir.FullName, tokenConfigDir.FullName) if not (File.Exists newPath) then - File.Copy(ethAccountFilePath, newPath) + File.Copy (ethAccountFilePath, newPath) let GetAccountFiles (currencies: seq) (accountKind: AccountKind): seq = seq { for currency in currencies do for filePath in Directory.GetFiles (GetConfigDir currency accountKind).FullName do - yield FileRepresentation.FromFile (FileInfo(filePath)) + yield FileRepresentation.FromFile (FileInfo (filePath)) } let private GetFile (currency: Currency) (account: BaseAccount): FileInfo = let configDir, fileName = GetConfigDir currency account.Kind, account.AccountFile.Name - Path.Combine(configDir.FullName, fileName) |> FileInfo + Path.Combine (configDir.FullName, fileName) |> FileInfo let AddAccount (conceptAccount: ConceptAccount) (accountKind: AccountKind): FileRepresentation = let configDir = GetConfigDir conceptAccount.Currency accountKind - let newAccountFile = Path.Combine(configDir.FullName, conceptAccount.FileRepresentation.Name) |> FileInfo + + let newAccountFile = + Path.Combine (configDir.FullName, conceptAccount.FileRepresentation.Name) + |> FileInfo + if newAccountFile.Exists then raise AccountAlreadyAdded - File.WriteAllText(newAccountFile.FullName, conceptAccount.FileRepresentation.Content()) + File.WriteAllText (newAccountFile.FullName, conceptAccount.FileRepresentation.Content ()) { Name = Path.GetFileName newAccountFile.FullName @@ -140,16 +150,17 @@ module Config = } let public Wipe (): unit = - let configDirForAccounts = GetConfigDirForAccounts() - Directory.Delete(configDirForAccounts.FullName, true) |> ignore + let configDirForAccounts = GetConfigDirForAccounts () + Directory.Delete (configDirForAccounts.FullName, true) |> ignore // we don't expose this as public because we don't want to allow removing archived accounts let private RemoveAccount (account: BaseAccount): unit = - let configFile = GetFile (account:>IAccount).Currency account + let configFile = GetFile (account :> IAccount).Currency account if not configFile.Exists then - failwith <| SPrintF1 "File %s doesn't exist. Please report this issue." configFile.FullName + failwith + <| SPrintF1 "File %s doesn't exist. Please report this issue." configFile.FullName else - configFile.Delete() + configFile.Delete () let RemoveNormalAccount (account: NormalAccount): unit = RemoveAccount account @@ -158,9 +169,9 @@ module Config = RemoveAccount account let ExtractEmbeddedResourceFileContents resourceName = - let assembly = Assembly.GetExecutingAssembly() + let assembly = Assembly.GetExecutingAssembly () use stream = assembly.GetManifestResourceStream resourceName if (stream = null) then failwith <| SPrintF1 "Embedded resource %s not found" resourceName use reader = new StreamReader(stream) - reader.ReadToEnd() + reader.ReadToEnd () diff --git a/src/GWallet.Backend/Currency.fs b/src/GWallet.Backend/Currency.fs index 7a0703579..2cca5df30 100644 --- a/src/GWallet.Backend/Currency.fs +++ b/src/GWallet.Backend/Currency.fs @@ -18,14 +18,14 @@ type Currency = // #if STRICTER_COMPILATION_BUT_WITH_REFLECTION_AT_RUNTIME - static member ToStrings() = - Microsoft.FSharp.Reflection.FSharpType.GetUnionCases(typeof) - |> Array.map (fun info -> info.Name) + static member ToStrings () = + Microsoft.FSharp.Reflection.FSharpType.GetUnionCases (typeof) + |> Array.map (fun info -> info.Name) #endif - static member GetAll(): seq = + static member GetAll (): seq = #if STRICTER_COMPILATION_BUT_WITH_REFLECTION_AT_RUNTIME - FSharpUtil.GetAllElementsFromDiscriminatedUnion() + FSharpUtil.GetAllElementsFromDiscriminatedUnion () #else seq { yield BTC @@ -37,29 +37,32 @@ type Currency = } #endif - static member Parse(currencyString: string): Currency = - Currency.GetAll().First(fun currency -> currencyString = currency.ToString()) + static member Parse (currencyString: string): Currency = + Currency.GetAll().First(fun currency -> currencyString = currency.ToString ()) - member self.IsEther() = + member self.IsEther () = self = Currency.ETC || self = Currency.ETH - member self.IsEthToken() = + + member self.IsEthToken () = self = Currency.DAI || self = Currency.SAI - member self.IsEtherBased() = - self.IsEther() || self.IsEthToken() - member self.IsUtxo() = + + member self.IsEtherBased () = + self.IsEther () || self.IsEthToken () + + member self.IsUtxo () = self = Currency.BTC || self = Currency.LTC - member self.DecimalPlaces(): int = - if self.IsUtxo() then + member self.DecimalPlaces (): int = + if self.IsUtxo () then 8 - elif self.IsEther() then + elif self.IsEther () then 18 elif self = Currency.SAI then 18 else failwith <| SPrintF1 "Unable to determine decimal places for %A" self - override self.ToString() = + override self.ToString () = #if STRICTER_COMPILATION_BUT_WITH_REFLECTION_AT_RUNTIME SPrintF1 "%A" self #else @@ -76,12 +79,13 @@ type Currency = // the reason we have used "and" is because of the circular reference // between StringTypeConverter and Currency -and private StringTypeConverter() = +and private StringTypeConverter () = inherit TypeConverter() - override __.CanConvertFrom(context, sourceType) = - sourceType = typeof || base.CanConvertFrom(context, sourceType) - override __.ConvertFrom(context, culture, value) = + + override __.CanConvertFrom (context, sourceType) = + sourceType = typeof || base.CanConvertFrom (context, sourceType) + + override __.ConvertFrom (context, culture, value) = match value with - | :? string as stringValue -> - Seq.find (fun cur -> cur.ToString() = stringValue) (Currency.GetAll()) :> obj - | _ -> base.ConvertFrom(context, culture, value) + | :? string as stringValue -> Seq.find (fun cur -> cur.ToString () = stringValue) (Currency.GetAll ()) :> obj + | _ -> base.ConvertFrom (context, culture, value) diff --git a/src/GWallet.Backend/Ether/EtherAccount.fs b/src/GWallet.Backend/Ether/EtherAccount.fs index fad846959..f44526b0e 100644 --- a/src/GWallet.Backend/Ether/EtherAccount.fs +++ b/src/GWallet.Backend/Ether/EtherAccount.fs @@ -17,84 +17,89 @@ open GWallet.Backend.FSharpUtil.UwpHacks module internal Account = - let private addressUtil = AddressUtil() - let private signer = TransactionSigner() + let private addressUtil = AddressUtil () + let private signer = TransactionSigner () - let private KeyStoreService = KeyStoreService() + let private KeyStoreService = KeyStoreService () let GetPublicAddressFromUnencryptedPrivateKey (privateKey: string) = EthECKey(privateKey).GetPublicAddress() let internal GetPublicAddressFromNormalAccountFile (accountFile: FileRepresentation): string = - let encryptedPrivateKey = accountFile.Content() + let encryptedPrivateKey = accountFile.Content () let rawPublicAddress = KeyStoreService.GetAddressFromKeyStore encryptedPrivateKey + let publicAddress = - if (rawPublicAddress.StartsWith("0x")) then + if (rawPublicAddress.StartsWith ("0x")) then rawPublicAddress else "0x" + rawPublicAddress + publicAddress let internal GetAccountFromFile (accountFile: FileRepresentation) (currency: Currency) kind: IAccount = - if not (currency.IsEtherBased()) then - failwith <| SPrintF1 "Assertion failed: currency %A should be Ether-type" currency + 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) - = async { - let! balance = - if (account.Currency.IsEther()) then - Server.GetEtherBalance account.Currency account.PublicAddress balType mode cancelSourceOption - elif (account.Currency.IsEthToken()) then - Server.GetTokenBalance account.Currency account.PublicAddress balType mode cancelSourceOption - else - failwith <| SPrintF1 "Assertion failed: currency %A should be Ether or Ether token" account.Currency - return balance - } - - let private GetBalanceFromServer (account: IAccount) - (balType: BalanceType) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async> = + 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) + = + async { + let! balance = + if (account.Currency.IsEther ()) then + Server.GetEtherBalance account.Currency account.PublicAddress balType mode cancelSourceOption + elif (account.Currency.IsEthToken ()) then + Server.GetTokenBalance account.Currency account.PublicAddress balType mode cancelSourceOption + else + failwith + <| SPrintF1 "Assertion failed: currency %A should be Ether or Ether token" account.Currency + + return balance + } + + 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 + if mode = ServerSelectionMode.Fast then return confirmed else let! unconfirmed = match maybeUnconfirmedBalanceTaskAlreadyStarted with - | None -> - GetBalanceFromServer account BalanceType.Confirmed mode cancelSourceOption - | Some unconfirmedBalanceTask -> - Async.AwaitTask unconfirmedBalanceTask + | None -> GetBalanceFromServer account BalanceType.Confirmed mode cancelSourceOption + | Some unconfirmedBalanceTask -> Async.AwaitTask unconfirmedBalanceTask - match unconfirmed,confirmed with - | Some unconfirmedAmount,Some confirmedAmount -> + match unconfirmed, confirmed with + | Some unconfirmedAmount, Some confirmedAmount -> if (unconfirmedAmount < confirmedAmount) then return unconfirmed else @@ -108,230 +113,283 @@ module internal Account = else let unconfirmedJob = GetBalanceFromServer account BalanceType.Confirmed mode cancelSourceOption let! cancellationToken = Async.CancellationToken - let unconfirmedTask = Async.StartAsTask(unconfirmedJob, ?cancellationToken = Some cancellationToken) - let maybeCachedBalance = Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency + let unconfirmedTask = Async.StartAsTask (unconfirmedJob, ?cancellationToken = Some cancellationToken) + + let maybeCachedBalance = + Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency + match maybeCachedBalance with - | NotAvailable -> - return! getBalanceWithoutCaching(Some unconfirmedTask) - | Cached(cachedBalance,_) -> + | NotAvailable -> return! getBalanceWithoutCaching (Some unconfirmedTask) + | Cached (cachedBalance, _) -> let! unconfirmed = Async.AwaitTask unconfirmedTask + match unconfirmed with | Some unconfirmedAmount -> if unconfirmedAmount <= cachedBalance then return unconfirmed else - return! getBalanceWithoutCaching(Some unconfirmedTask) - | None -> - return! getBalanceWithoutCaching(Some unconfirmedTask) + return! getBalanceWithoutCaching (Some unconfirmedTask) + | None -> return! getBalanceWithoutCaching (Some unconfirmedTask) + } + + let ValidateAddress (currency: Currency) (address: string) = + async { + if String.IsNullOrEmpty address then + raise <| ArgumentNullException "address" + + let ETHEREUM_ADDRESSES_LENGTH = 42 + let ETHEREUM_ADDRESS_PREFIX = "0x" + + if not (address.StartsWith (ETHEREUM_ADDRESS_PREFIX)) then + raise (AddressMissingProperPrefix ([ ETHEREUM_ADDRESS_PREFIX ])) + + if (address.Length <> ETHEREUM_ADDRESSES_LENGTH) then + raise <| AddressWithInvalidLength [ ETHEREUM_ADDRESSES_LENGTH ] + + do! Ether.Server.CheckIfAddressIsAValidPaymentDestination currency address + + if (not (addressUtil.IsChecksumAddress (address))) then + let validCheckSumAddress = addressUtil.ConvertToChecksumAddress (address) + raise (AddressWithInvalidChecksum (Some validCheckSumAddress)) } - let ValidateAddress (currency: Currency) (address: string) = async { - if String.IsNullOrEmpty address then - raise <| ArgumentNullException "address" + let private GetTransactionCount (currency: Currency) (publicAddress: string): Async = + async { + let! result = Ether.Server.GetTransactionCount currency publicAddress + let value = result.Value - let ETHEREUM_ADDRESSES_LENGTH = 42 - let ETHEREUM_ADDRESS_PREFIX = "0x" + if (value > BigInteger (Int64.MaxValue)) then + failwith + <| SPrintF1 + "Serialization doesn't support such a big integer (%s) for the nonce, please report this issue." + (result.ToString ()) - if not (address.StartsWith(ETHEREUM_ADDRESS_PREFIX)) then - raise (AddressMissingProperPrefix([ETHEREUM_ADDRESS_PREFIX])) + let int64result: Int64 = BigInteger.op_Explicit value - if (address.Length <> ETHEREUM_ADDRESSES_LENGTH) then - raise <| AddressWithInvalidLength [ ETHEREUM_ADDRESSES_LENGTH ] + return int64result + } - do! Ether.Server.CheckIfAddressIsAValidPaymentDestination currency address + let private GetGasPrice currency: Async = + async { + let! gasPrice = Ether.Server.GetGasPrice currency - if (not (addressUtil.IsChecksumAddress(address))) then - let validCheckSumAddress = addressUtil.ConvertToChecksumAddress(address) - raise (AddressWithInvalidChecksum(Some validCheckSumAddress)) - } + if (gasPrice.Value > BigInteger (Int64.MaxValue)) then + failwith + <| SPrintF1 + "Serialization doesn't support such a big integer (%s) for the gas, please report this issue." + (gasPrice.Value.ToString ()) - let private GetTransactionCount (currency: Currency) (publicAddress: string): Async = async { - let! result = Ether.Server.GetTransactionCount currency publicAddress - let value = result.Value - if (value > BigInteger(Int64.MaxValue)) then - failwith <| SPrintF1 "Serialization doesn't support such a big integer (%s) for the nonce, please report this issue." - (result.ToString()) - let int64result:Int64 = BigInteger.op_Explicit value - return int64result - } + let gasPrice64: Int64 = BigInteger.op_Explicit gasPrice.Value - let private GetGasPrice currency: Async = async { - let! gasPrice = Ether.Server.GetGasPrice currency - if (gasPrice.Value > BigInteger(Int64.MaxValue)) then - failwith <| SPrintF1 "Serialization doesn't support such a big integer (%s) for the gas, please report this issue." - (gasPrice.Value.ToString()) - let gasPrice64: Int64 = BigInteger.op_Explicit gasPrice.Value - return gasPrice64 - } + return gasPrice64 + } + + let private GAS_COST_FOR_A_NORMAL_ETHER_TRANSACTION: int64 = 21000L + + let EstimateEtherTransferFee (account: IAccount) (amount: TransferAmount): Async = + async { + let! gasPrice64 = GetGasPrice account.Currency - let private GAS_COST_FOR_A_NORMAL_ETHER_TRANSACTION:int64 = 21000L + let ethMinerFee = + MinerFee (GAS_COST_FOR_A_NORMAL_ETHER_TRANSACTION, gasPrice64, DateTime.UtcNow, account.Currency) - let EstimateEtherTransferFee (account: IAccount) (amount: TransferAmount): Async = async { - let! gasPrice64 = GetGasPrice account.Currency - let ethMinerFee = MinerFee(GAS_COST_FOR_A_NORMAL_ETHER_TRANSACTION, gasPrice64, DateTime.UtcNow, account.Currency) - let! txCount = GetTransactionCount account.Currency account.PublicAddress + let! txCount = GetTransactionCount account.Currency account.PublicAddress - let feeValue = ethMinerFee.CalculateAbsoluteValue() - if (amount.ValueToSend <> amount.BalanceAtTheMomentOfSending && - feeValue > (amount.BalanceAtTheMomentOfSending - amount.ValueToSend)) then - raise <| InsufficientBalanceForFee (Some feeValue) + let feeValue = ethMinerFee.CalculateAbsoluteValue () - return { Ether.Fee = ethMinerFee; Ether.TransactionCount = txCount } - } + if (amount.ValueToSend + <> amount.BalanceAtTheMomentOfSending + && feeValue > (amount.BalanceAtTheMomentOfSending - amount.ValueToSend)) then + raise <| InsufficientBalanceForFee (Some feeValue) + + return { + Ether.Fee = ethMinerFee + Ether.TransactionCount = txCount + } + } // FIXME: this should raise InsufficientBalanceForFee - let EstimateTokenTransferFee (account: IAccount) amount destination: Async = async { - let! gasPrice64 = GetGasPrice account.Currency - - let baseCurrency = - match account.Currency with - | DAI | SAI -> ETH - | _ -> failwith <| SPrintF1 "Unknown token %A" account.Currency - - let! tokenTransferFee = Ether.Server.EstimateTokenTransferFee account amount destination - if (tokenTransferFee.Value > BigInteger(Int64.MaxValue)) then - 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()) - let gasCost64: Int64 = BigInteger.op_Explicit tokenTransferFee.Value - - let ethMinerFee = MinerFee(gasCost64, gasPrice64, DateTime.UtcNow, baseCurrency) - let! txCount = GetTransactionCount account.Currency account.PublicAddress - return { Ether.Fee = ethMinerFee; Ether.TransactionCount = txCount } - } - - let EstimateFee (account: IAccount) (amount: TransferAmount) destination: Async = async { - if account.Currency.IsEther() then - return! EstimateEtherTransferFee account amount - 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 - } + let EstimateTokenTransferFee (account: IAccount) amount destination: Async = + async { + let! gasPrice64 = GetGasPrice account.Currency + + let baseCurrency = + match account.Currency with + | DAI + | SAI -> ETH + | _ -> failwith <| SPrintF1 "Unknown token %A" account.Currency + + let! tokenTransferFee = Ether.Server.EstimateTokenTransferFee account amount destination + + if (tokenTransferFee.Value > BigInteger (Int64.MaxValue)) then + 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 ()) + + let gasCost64: Int64 = BigInteger.op_Explicit tokenTransferFee.Value + + let ethMinerFee = MinerFee (gasCost64, gasPrice64, DateTime.UtcNow, baseCurrency) + + let! txCount = GetTransactionCount account.Currency account.PublicAddress + + return { + Ether.Fee = ethMinerFee + Ether.TransactionCount = txCount + } + } + + let EstimateFee (account: IAccount) (amount: TransferAmount) destination: Async = + async { + if account.Currency.IsEther () then + return! EstimateEtherTransferFee account amount + 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 + } let private BroadcastRawTransaction (currency: Currency) trans = Ether.Server.BroadcastTransaction currency ("0x" + trans) let BroadcastTransaction (trans: SignedTransaction<_>) = - BroadcastRawTransaction - trans.TransactionInfo.Proposal.Amount.Currency - trans.RawTransaction + BroadcastRawTransaction trans.TransactionInfo.Proposal.Amount.Currency trans.RawTransaction let internal GetPrivateKey (account: NormalAccount) password = - let encryptedPrivateKey = account.GetEncryptedPrivateKey() + let encryptedPrivateKey = account.GetEncryptedPrivateKey () + let privKeyInBytes = try - KeyStoreService.DecryptKeyStoreFromJson(password, encryptedPrivateKey) - with - | :? DecryptionException -> - raise (InvalidPassword) + KeyStoreService.DecryptKeyStoreFromJson (password, encryptedPrivateKey) + with :? DecryptionException -> raise (InvalidPassword) - EthECKey(privKeyInBytes, true) + EthECKey (privKeyInBytes, true) let private GetNetwork (currency: Currency) = - if not (currency.IsEtherBased()) then - failwith <| SPrintF1 "Assertion failed: currency %A should be Ether-type" currency - if currency.IsEthToken() || currency = ETH then + 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 Config.EtcNet else - failwith <| SPrintF1 "Assertion failed: Ether currency %A not supported?" currency + 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) + invalidArg + "chain" + (SPrintF2 + "Assertion failed: fee currency (%A) chain doesn't match with passed chain (%A)" + txMetadata.Fee.Currency + chain) let amountToSendConsideringMinerFee = if (amount.ValueToSend = amount.BalanceAtTheMomentOfSending) then amount.ValueToSend - (txMetadata :> IBlockchainFeeInfo).FeeValue else amount.ValueToSend - let amountInWei = UnitConversion.Convert.ToWei(amountToSendConsideringMinerFee, - UnitConversion.EthUnit.Ether) - - let privKeyInBytes = privateKey.GetPrivateKeyAsBytes() - let trans = signer.SignTransaction( - privKeyInBytes, - chain, - destination, - amountInWei, - BigInteger(txMetadata.TransactionCount), - - // we use the SignTransaction() overload that has these 2 arguments because if we don't, we depend on - // how well the defaults are of Geth node we're connected to, e.g. with the myEtherWallet server I - // was trying to spend 0.002ETH from an account that had 0.01ETH and it was always failing with the - // "Insufficient Funds" error saying it needed 212,000,000,000,000,000 wei (0.212 ETH)... - BigInteger(txMetadata.Fee.GasPriceInWei), - BigInteger(txMetadata.Fee.GasLimit)) + + let amountInWei = + UnitConversion.Convert.ToWei (amountToSendConsideringMinerFee, UnitConversion.EthUnit.Ether) + + let privKeyInBytes = privateKey.GetPrivateKeyAsBytes () + + let trans = + signer.SignTransaction + (privKeyInBytes, + chain, + destination, + amountInWei, + BigInteger (txMetadata.TransactionCount), + + // we use the SignTransaction() overload that has these 2 arguments because if we don't, we depend on + // how well the defaults are of Geth node we're connected to, e.g. with the myEtherWallet server I + // was trying to spend 0.002ETH from an account that had 0.01ETH and it was always failing with the + // "Insufficient Funds" error saying it needed 212,000,000,000,000,000 wei (0.212 ETH)... + BigInteger (txMetadata.Fee.GasPriceInWei), + BigInteger (txMetadata.Fee.GasLimit)) + 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() - - let amountInWei = UnitConversion.Convert.ToWei(amount.ValueToSend, UnitConversion.EthUnit.Ether) - let gasLimit = BigInteger(txMetadata.Fee.GasLimit) - let data = (TokenManager.OfflineTokenServiceWrapper currency) - .ComposeInputDataForTransferTransaction(origin, - destination, - amountInWei, - gasLimit) - - let etherValue = BigInteger(0) - let nonce = BigInteger(txMetadata.TransactionCount) - let gasPrice = BigInteger(txMetadata.Fee.GasPriceInWei) + let privKeyInBytes = privateKey.GetPrivateKeyAsBytes () + + let amountInWei = UnitConversion.Convert.ToWei (amount.ValueToSend, UnitConversion.EthUnit.Ether) + let gasLimit = BigInteger (txMetadata.Fee.GasLimit) + + let data = + (TokenManager.OfflineTokenServiceWrapper currency) + .ComposeInputDataForTransferTransaction(origin, destination, amountInWei, gasLimit) + + let etherValue = BigInteger (0) + let nonce = BigInteger (txMetadata.TransactionCount) + let gasPrice = BigInteger (txMetadata.Fee.GasPriceInWei) let contractAddress = TokenManager.GetTokenContractAddress currency - signer.SignTransaction (privKeyInBytes, - chain, - contractAddress, - etherValue, - nonce, - gasPrice, - gasLimit, - data) - - let private SignTransactionWithPrivateKey (account: IAccount) - (txMetadata: TransactionMetadata) - (destination: string) - (amount: TransferAmount) - (privateKey: EthECKey) = + signer.SignTransaction (privKeyInBytes, chain, contractAddress, etherValue, nonce, gasPrice, gasLimit, data) + + let private SignTransactionWithPrivateKey + (account: IAccount) + (txMetadata: TransactionMetadata) + (destination: string) + (amount: TransferAmount) + (privateKey: EthECKey) + = let trans = - if account.Currency.IsEthToken() then + if account.Currency.IsEthToken () then SignEtherTokenTransaction - account.Currency txMetadata account.PublicAddress destination amount privateKey - elif account.Currency.IsEtherBased() then + account.Currency + txMetadata + account.PublicAddress + destination + amount + privateKey + elif account.Currency.IsEtherBased () then if (txMetadata.Fee.Currency <> account.Currency) then - failwith <| SPrintF2 "Assertion failed: fee currency (%A) doesn't match with passed chain (%A)" - txMetadata.Fee.Currency account.Currency + failwith + <| SPrintF2 + "Assertion failed: fee currency (%A) doesn't match with passed chain (%A)" + txMetadata.Fee.Currency + account.Currency SignEtherTransaction account.Currency txMetadata destination amount privateKey else - failwith <| SPrintF1 "Assertion failed: Ether currency %A not supported?" account.Currency + failwith + <| SPrintF1 "Assertion failed: Ether currency %A not supported?" account.Currency let chain = GetNetwork account.Currency - if not (signer.VerifyTransaction(trans, chain)) then + 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 @@ -339,24 +397,30 @@ module internal Account = let CheckValidPassword (account: NormalAccount) (password: string) = GetPrivateKey account password |> ignore - 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()) - let signedTrans = SignTransactionWithPrivateKey - account txMetadata destination.PublicAddress amount ecPrivKey + 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 ()) + + let signedTrans = + SignTransactionWithPrivateKey account txMetadata destination.PublicAddress amount ecPrivKey + 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 + if (baseAccount.PublicAddress.Equals (destination, StringComparison.InvariantCultureIgnoreCase)) then raise DestinationEqualToOrigin let currency = baseAccount.Currency @@ -366,16 +430,15 @@ module internal Account = BroadcastRawTransaction currency trans let private CreateInternal (password: string) (seed: array): FileRepresentation = - let privateKey = EthECKey(seed, true) - let publicAddress = privateKey.GetPublicAddress() - if not (addressUtil.IsChecksumAddress(publicAddress)) then + 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) let accountSerializedJson = - KeyStoreService.EncryptAndGenerateDefaultKeyStoreAsJson(password, - seed, - publicAddress) - let fileNameForAccount = KeyStoreService.GenerateUTCFileName(publicAddress) + KeyStoreService.EncryptAndGenerateDefaultKeyStoreAsJson (password, seed, publicAddress) + + let fileNameForAccount = KeyStoreService.GenerateUTCFileName (publicAddress) { Name = fileNameForAccount @@ -383,23 +446,23 @@ module internal Account = } let Create (password: string) (seed: array): Async = - async { - return CreateInternal password seed - } + async { return CreateInternal password seed } 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; - Metadata = txMetadata; + Proposal = transProposal + Cache = Caching.Instance.GetLastCachedData().ToDietCache readOnlyAccounts + Metadata = txMetadata } - ExportUnsignedTransactionToJson unsignedTransaction + ExportUnsignedTransactionToJson unsignedTransaction diff --git a/src/GWallet.Backend/Ether/EtherExceptions.fs b/src/GWallet.Backend/Ether/EtherExceptions.fs index 2025d9b8a..bc21d172f 100644 --- a/src/GWallet.Backend/Ether/EtherExceptions.fs +++ b/src/GWallet.Backend/Ether/EtherExceptions.fs @@ -31,50 +31,37 @@ type ServerCannotBeResolvedException = inherit CommunicationUnsuccessfulException new(message: string, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(message, innerException) - } + { inherit CommunicationUnsuccessfulException(message, innerException) } type ServerUnavailableException = inherit CommunicationUnsuccessfulException new(message: string, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(message, innerException) - } + { inherit CommunicationUnsuccessfulException(message, innerException) } type ServerChannelNegotiationException = inherit CommunicationUnsuccessfulException new(message: string, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(message, innerException) - } + { inherit CommunicationUnsuccessfulException(message, innerException) } + new(message: string, webExStatusCode: WebExceptionStatus, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(SPrintF2 "%s (WebErr: %s)" message (webExStatusCode.ToString()), - innerException) - } + { inherit CommunicationUnsuccessfulException(SPrintF2 "%s (WebErr: %s)" message (webExStatusCode.ToString ()), + innerException) } + new(message: string, cloudFlareError: CloudFlareError, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(SPrintF2 "%s (CfErr: %s)" message (cloudFlareError.ToString()), - innerException) - } + { inherit CommunicationUnsuccessfulException(SPrintF2 "%s (CfErr: %s)" message (cloudFlareError.ToString ()), + innerException) } type ServerRestrictiveException = inherit CommunicationUnsuccessfulException - new (message: string, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException (message, innerException) - } + new(message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException(message, innerException) } type UnhandledWebException = inherit Exception - new (status: WebExceptionStatus, innerException: Exception) = - { - inherit Exception (SPrintF1 "Backend not prepared for this WebException with Status[%i]" - (int status), - innerException) - } + new(status: WebExceptionStatus, innerException: Exception) = + { inherit Exception(SPrintF1 "Backend not prepared for this WebException with Status[%i]" (int status), + innerException) } diff --git a/src/GWallet.Backend/Ether/EtherMinerFee.fs b/src/GWallet.Backend/Ether/EtherMinerFee.fs index 35341d690..8c9f4280e 100644 --- a/src/GWallet.Backend/Ether/EtherMinerFee.fs +++ b/src/GWallet.Backend/Ether/EtherMinerFee.fs @@ -7,14 +7,14 @@ open GWallet.Backend open Nethereum.Util -type MinerFee(gasLimit: Int64, gasPriceInWei: Int64, estimationTime: DateTime, currency: Currency) = +type MinerFee (gasLimit: Int64, gasPriceInWei: Int64, estimationTime: DateTime, currency: Currency) = - member val GasLimit = gasLimit with get - member val GasPriceInWei = gasPriceInWei with get - member val Currency = currency with get - member val EstimationTime = estimationTime with get + member val GasLimit = gasLimit + member val GasPriceInWei = gasPriceInWei + member val Currency = currency + member val EstimationTime = estimationTime - member __.CalculateAbsoluteValue() = - let gasPriceInWei = BigInteger(gasPriceInWei) - let costInWei = BigInteger.Multiply(gasPriceInWei, BigInteger(gasLimit)) - UnitConversion.Convert.FromWei(costInWei, UnitConversion.EthUnit.Ether) + member __.CalculateAbsoluteValue () = + let gasPriceInWei = BigInteger (gasPriceInWei) + let costInWei = BigInteger.Multiply (gasPriceInWei, BigInteger (gasLimit)) + UnitConversion.Convert.FromWei (costInWei, UnitConversion.EthUnit.Ether) diff --git a/src/GWallet.Backend/Ether/EtherServer.fs b/src/GWallet.Backend/Ether/EtherServer.fs index fce8835a8..4a6808f26 100644 --- a/src/GWallet.Backend/Ether/EtherServer.fs +++ b/src/GWallet.Backend/Ether/EtherServer.fs @@ -19,10 +19,10 @@ type BalanceType = | Unconfirmed | Confirmed -type SomeWeb3(url: string) = +type SomeWeb3 (url: string) = inherit Web3(url) - member val Url = url with get + member val Url = url type TransactionStatusDetails = { @@ -53,10 +53,12 @@ module Web3ServerSeedList = let baseCurrency = if currency = Currency.ETC || currency = Currency.ETH then currency - elif currency.IsEthToken() then + elif currency.IsEthToken () then Currency.ETH else - failwith <| SPrintF1 "Assertion failed: Ether currency %A not supported?" currency + failwith + <| SPrintF1 "Assertion failed: Ether currency %A not supported?" currency + Caching.Instance.GetServers baseCurrency |> List.ofSeq let Randomize currency = @@ -68,29 +70,35 @@ module Server = let private Web3Server (serverDetails: ServerDetails) = match serverDetails.ServerInfo.ConnectionType with - | { Protocol = Tcp _ ; Encrypted = _ } -> - failwith <| SPrintF1 "Ether server of TCP connection type?: %s" serverDetails.ServerInfo.NetworkPath - | { Protocol = Http ; Encrypted = encrypted } -> + | { Protocol = Tcp _; Encrypted = _ } -> + failwith + <| SPrintF1 "Ether server of TCP connection type?: %s" serverDetails.ServerInfo.NetworkPath + | { Protocol = Http; Encrypted = encrypted } -> let protocol = if encrypted then "https" else "http" + let uri = SPrintF2 "%s://%s" protocol serverDetails.ServerInfo.NetworkPath SomeWeb3 uri let HttpRequestExceptionMatchesErrorCode (ex: Http.HttpRequestException) (errorCode: int): bool = - ex.Message.StartsWith(SPrintF1 "%i " errorCode) || ex.Message.Contains(SPrintF1 " %i " errorCode) + ex.Message.StartsWith (SPrintF1 "%i " errorCode) + || ex.Message.Contains (SPrintF1 " %i " errorCode) let exMsg = "Could not communicate with EtherServer" - let PerformEtherRemoteCallWithTimeout<'T,'R> (job: Async<'R>): Async<'R> = async { - let! maybeResult = FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT job - match maybeResult with - | None -> - return raise <| ServerTimedOutException("Timeout when trying to communicate with Ether server") - | Some result -> - return result - } + + let PerformEtherRemoteCallWithTimeout<'T, 'R> (job: Async<'R>): Async<'R> = + async { + let! maybeResult = FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT job + + match maybeResult with + | None -> + 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 @@ -99,72 +107,73 @@ module Server = // TODO: send a warning in Sentry if webEx.Status = WebExceptionStatus.UnknownError then - raise <| ServerUnreachableException(exMsg, webEx) + raise <| ServerUnreachableException (exMsg, webEx) if webEx.Status = WebExceptionStatus.NameResolutionFailure then - raise <| ServerCannotBeResolvedException(exMsg, webEx) + raise <| ServerCannotBeResolvedException (exMsg, webEx) if webEx.Status = WebExceptionStatus.ReceiveFailure then - raise <| ServerTimedOutException(exMsg, webEx) + raise <| ServerTimedOutException (exMsg, webEx) if webEx.Status = WebExceptionStatus.ConnectFailure then - raise <| ServerUnreachableException(exMsg, webEx) + raise <| ServerUnreachableException (exMsg, webEx) if webEx.Status = WebExceptionStatus.SecureChannelFailure then - raise <| ServerChannelNegotiationException(exMsg, webEx.Status, webEx) + raise <| ServerChannelNegotiationException (exMsg, webEx.Status, webEx) if webEx.Status = WebExceptionStatus.RequestCanceled then - raise <| ServerChannelNegotiationException(exMsg, webEx.Status, webEx) + raise <| ServerChannelNegotiationException (exMsg, webEx.Status, webEx) if webEx.Status = WebExceptionStatus.TrustFailure then - raise <| ServerChannelNegotiationException(exMsg, webEx.Status, webEx) + raise <| ServerChannelNegotiationException (exMsg, webEx.Status, webEx) - raise <| UnhandledWebException(webEx.Status, webEx) + raise <| UnhandledWebException (webEx.Status, webEx) - | None -> - () + | None -> () 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) + raise <| ServerTimedOutException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.OriginUnreachable) then - raise <| ServerTimedOutException(exMsg, httpReqEx) + raise <| ServerTimedOutException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.OriginSslHandshakeError) then - raise <| ServerChannelNegotiationException(exMsg, CloudFlareError.OriginSslHandshakeError, httpReqEx) + raise + <| ServerChannelNegotiationException (exMsg, CloudFlareError.OriginSslHandshakeError, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.WebServerDown) then - raise <| ServerUnreachableException(exMsg, CloudFlareError.WebServerDown, httpReqEx) + raise + <| ServerUnreachableException (exMsg, CloudFlareError.WebServerDown, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.BadGateway) then - raise <| ServerUnreachableException(exMsg, HttpStatusCode.BadGateway, httpReqEx) + raise + <| ServerUnreachableException (exMsg, HttpStatusCode.BadGateway, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.GatewayTimeout) then - raise <| ServerUnreachableException(exMsg, HttpStatusCode.GatewayTimeout, httpReqEx) + raise + <| ServerUnreachableException (exMsg, HttpStatusCode.GatewayTimeout, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.ServiceUnavailable) then - raise <| ServerUnavailableException(exMsg, httpReqEx) + raise <| ServerUnavailableException (exMsg, httpReqEx) // 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) + raise <| ServerMisconfiguredException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.Unauthorized) then - raise <| ServerMisconfiguredException(exMsg, httpReqEx) + raise <| ServerMisconfiguredException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.MethodNotAllowed) then - raise <| ServerMisconfiguredException(exMsg, httpReqEx) + raise <| ServerMisconfiguredException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.InternalServerError) then - raise <| ServerUnavailableException(exMsg, httpReqEx) + raise <| ServerUnavailableException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.NotFound) then - raise <| ServerUnavailableException(exMsg, httpReqEx) + raise <| ServerUnavailableException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode - httpReqEx (int HttpStatusCodeNotPresentInTheBcl.TooManyRequests) then - raise <| ServerRestrictiveException(exMsg, httpReqEx) + if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCodeNotPresentInTheBcl.TooManyRequests) then + raise <| ServerRestrictiveException (exMsg, httpReqEx) if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCodeNotPresentInTheBcl.FrozenSite) then - raise <| ServerUnavailableException(exMsg, httpReqEx) + 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 - raise <| ServerMisconfiguredException(exMsg, httpReqEx) - | _ -> - () + raise <| ServerMisconfiguredException (exMsg, httpReqEx) + | _ -> () let MaybeRethrowRpcResponseException (ex: Exception): unit = let maybeRpcResponseEx = FSharpUtil.FindException ex @@ -172,46 +181,45 @@ module Server = | Some rpcResponseEx -> if rpcResponseEx.RpcError <> null then if rpcResponseEx.RpcError.Code = int RpcErrorCode.StatePruningNodeOrMissingTrieNodeOrHeaderNotFound then - if (not (rpcResponseEx.RpcError.Message.Contains "pruning=archive")) && - (not (rpcResponseEx.RpcError.Message.Contains "header not found")) && - (not (rpcResponseEx.RpcError.Message.Contains "missing trie node")) then - raise <| 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, - rpcResponseEx) + if (not (rpcResponseEx.RpcError.Message.Contains "pruning=archive")) + && (not (rpcResponseEx.RpcError.Message.Contains "header not found")) + && (not (rpcResponseEx.RpcError.Message.Contains "missing trie node")) then + raise + <| 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, + rpcResponseEx) else - raise <| ServerMisconfiguredException(exMsg, rpcResponseEx) + raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) if (rpcResponseEx.RpcError.Code = int RpcErrorCode.UnknownBlockNumber) then - raise <| ServerMisconfiguredException(exMsg, rpcResponseEx) + raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) if rpcResponseEx.RpcError.Code = int RpcErrorCode.GatewayTimeout then - raise <| ServerMisconfiguredException(exMsg, rpcResponseEx) + 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) - | None -> - () + 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) + | None -> () let MaybeRethrowRpcClientTimeoutException (ex: Exception): unit = - let maybeRpcTimeoutException = - FSharpUtil.FindException ex + let maybeRpcTimeoutException = FSharpUtil.FindException ex match maybeRpcTimeoutException with - | Some rpcTimeoutEx -> - raise <| ServerTimedOutException(exMsg, rpcTimeoutEx) - | None -> - () + | 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 -> - () + | Some socketRewrappedException -> raise socketRewrappedException + | None -> () // this could be a Xamarin.Android bug (see https://gitlab.gnome.org/World/geewallet/issues/119) let MaybeRethrowObjectDisposedException (ex: Exception): unit = @@ -222,11 +230,9 @@ module Server = match maybeObjectDisposedEx with | Some objectDisposedEx -> if objectDisposedEx.Message.Contains "MobileAuthenticatedStream" then - raise <| ProtocolGlitchException(objectDisposedEx.Message, objectDisposedEx) - | None -> - () - | None -> - () + raise <| ProtocolGlitchException (objectDisposedEx.Message, objectDisposedEx) + | None -> () + | None -> () let MaybeRethrowInnerRpcException (ex: Exception): unit = let maybeRpcUnknownEx = FSharpUtil.FindException ex @@ -235,11 +241,10 @@ module Server = let maybeDeSerializationEx = FSharpUtil.FindException rpcUnknownEx + match maybeDeSerializationEx with - | None -> - () - | Some deserEx -> - raise <| ServerMisconfiguredException(deserEx.Message, ex) + | None -> () + | Some deserEx -> raise <| ServerMisconfiguredException (deserEx.Message, ex) // this SSL exception could be a mono 6.0.x bug (see https://gitlab.com/knocte/geewallet/issues/121) let maybeHttpReqEx = FSharpUtil.FindException ex @@ -248,20 +253,16 @@ module Server = if httpReqEx.Message.Contains "SSL" then let maybeIOEx = FSharpUtil.FindException ex match maybeIOEx with - | Some ioEx -> - raise <| ProtocolGlitchException(ioEx.Message, ex) + | Some ioEx -> raise <| ProtocolGlitchException (ioEx.Message, ex) | None -> let maybeSecEx = FSharpUtil.FindException ex + match maybeSecEx with - | Some secEx -> - raise <| ProtocolGlitchException(secEx.Message, ex) - | None -> - () - | None -> - () - | None -> - () + | Some secEx -> raise <| ProtocolGlitchException (secEx.Message, ex) + | None -> () + | None -> () + | None -> () let private ReworkException (ex: Exception): unit = @@ -285,9 +286,11 @@ 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 @@ -296,13 +299,9 @@ module Server = { NumberOfParallelJobsAllowed = NumberOfParallelJobsForMode mode - NumberOfRetries = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS; - NumberOfRetriesForInconsistency = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS; - ExceptionHandler = Some - ( - fun ex -> - Infrastructure.ReportWarning ex - ) + NumberOfRetries = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS + NumberOfRetriesForInconsistency = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS + ExceptionHandler = Some (fun ex -> Infrastructure.ReportWarning ex) ResultSelectionMode = Selective { @@ -320,12 +319,14 @@ module Server = 1u else 2u - FaultTolerantParallelClientInnerSettings numberOfConsistentResponsesRequired - mode - let private FaultTolerantParallelClientSettingsForBalanceCheck (mode: ServerSelectionMode) - (currency: Currency) - (cacheOrInitialBalanceMatchFunc: decimal->bool) = + FaultTolerantParallelClientInnerSettings numberOfConsistentResponsesRequired mode + + let private FaultTolerantParallelClientSettingsForBalanceCheck + (mode: ServerSelectionMode) + (currency: Currency) + (cacheOrInitialBalanceMatchFunc: decimal -> bool) + = let consistencyConfig = if etcEcosystemIsMomentarilyCentralized && currency = Currency.ETC then None @@ -333,6 +334,7 @@ module Server = Some (OneServerConsistentWithCertainValueOrTwoServers cacheOrInitialBalanceMatchFunc) else None + FaultTolerantParallelClientDefaultSettings mode currency consistencyConfig let private FaultTolerantParallelClientSettingsForBroadcast () = @@ -340,24 +342,22 @@ module Server = let private faultTolerantEtherClient = JsonRpcSharp.Client.HttpClient.ConnectionTimeout <- Config.DEFAULT_NETWORK_TIMEOUT - FaultTolerantParallelClient Caching.Instance.SaveServerLastStat + FaultTolerantParallelClient Caching.Instance.SaveServerLastStat - let Web3ServerToRetrievalFunc (server: ServerDetails) - (web3ClientFunc: SomeWeb3->Async<'R>) - : Async<'R> = + let Web3ServerToRetrievalFunc (server: ServerDetails) (web3ClientFunc: SomeWeb3 -> Async<'R>): Async<'R> = let HandlePossibleEtherFailures (job: Async<'R>): Async<'R> = async { try let! result = PerformEtherRemoteCallWithTimeout job return result - with - | ex -> + with ex -> ReworkException ex return raise <| FSharpUtil.ReRaise ex } + async { let web3Server = Web3Server server try @@ -365,96 +365,109 @@ module Server = // NOTE: try to make this 'with' block be in sync with the one in UtxoCoinAccount:GetRandomizedFuncs() with - | :? CommunicationUnsuccessfulException as ex -> - 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) + | :? CommunicationUnsuccessfulException as ex -> + 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) } // 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 } - let serverFuncs = - Seq.map (Web3ServerToGenericServer web3Func) - etherServers + 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 + GetServerFuncs web3Func etherServers |> List.ofSeq - let GetTransactionCount (currency: Currency) (address: string) - : Async = + let GetTransactionCount (currency: Currency) (address: string): Async = async { let web3Funcs = let web3Func (web3: Web3): Async = - async { - let! cancelToken = Async.CancellationToken - let task = - web3.Eth.Transactions.GetTransactionCount.SendRequestAsync(address, null, cancelToken) - return! Async.AwaitTask task - } + async { + let! cancelToken = Async.CancellationToken + + let task = + web3.Eth.Transactions.GetTransactionCount.SendRequestAsync (address, null, cancelToken) + + return! Async.AwaitTask task + } + GetRandomizedFuncs currency web3Func + return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) - web3Funcs + (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) + web3Funcs } - let private NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED = BigInteger(45) - let private GetBlockToCheckForConfirmedBalance(web3: Web3): Async = + let private NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED = BigInteger (45) + + let private GetBlockToCheckForConfirmedBalance (web3: Web3): Async = async { let! cancelToken = Async.CancellationToken + let! latestBlock = web3.Eth.Blocks.GetBlockNumber.SendRequestAsync (null, cancelToken) - |> Async.AwaitTask + |> Async.AwaitTask + if (latestBlock = null) then failwith "latestBlock somehow is null" - let blockToCheck = BigInteger.Subtract(latestBlock.Value, - NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED) + let blockToCheck = + BigInteger.Subtract (latestBlock.Value, NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED) if blockToCheck.Sign < 0 then - let errMsg = SPrintF2 - "Looks like we received a wrong latestBlock(%s) because the substract was negative(%s)" - (latestBlock.Value.ToString()) - (blockToCheck.ToString()) + let errMsg = + SPrintF2 + "Looks like we received a wrong latestBlock(%s) because the substract was negative(%s)" + (latestBlock.Value.ToString ()) + (blockToCheck.ToString ()) + raise <| ServerMisconfiguredException errMsg - return BlockParameter(HexBigInteger(blockToCheck)) + return BlockParameter (HexBigInteger (blockToCheck)) } let private GetConfirmedEtherBalanceInternal (web3: Web3) (publicAddress: string): Async = async { let! blockForConfirmationReference = GetBlockToCheckForConfirmedBalance web3 -(* + + (* if (Config.DebugLog) then Infrastructure.LogError (SPrintF2 "Last block number and last confirmed block number: %s: %s" (latestBlock.Value.ToString()) (blockForConfirmationReference.BlockNumber.Value.ToString())) *) let! cancelToken = Async.CancellationToken - cancelToken.ThrowIfCancellationRequested() + + cancelToken.ThrowIfCancellationRequested () + let! balance = - web3.Eth.GetBalance.SendRequestAsync (publicAddress, - blockForConfirmationReference, - null, - cancelToken) - |> Async.AwaitTask + web3.Eth.GetBalance.SendRequestAsync (publicAddress, blockForConfirmationReference, null, cancelToken) + |> Async.AwaitTask + return balance } @@ -466,232 +479,258 @@ 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 = async { - let! balance = - match balType with - | BalanceType.Confirmed -> - GetConfirmedEtherBalanceInternal web3 address - | BalanceType.Unconfirmed -> - async { - let! cancelToken = Async.CancellationToken - let task = web3.Eth.GetBalance.SendRequestAsync (address, null, cancelToken) - return! Async.AwaitTask task - } - if Object.ReferenceEquals(balance, null) then - failwith "Weird null response from balance job" - return UnitConversion.Convert.FromWei(balance.Value, UnitConversion.EthUnit.Ether) - } + let web3Func (web3: Web3): Async = + async { + let! balance = + match balType with + | BalanceType.Confirmed -> GetConfirmedEtherBalanceInternal web3 address + | BalanceType.Unconfirmed -> + async { + let! cancelToken = Async.CancellationToken + let task = web3.Eth.GetBalance.SendRequestAsync (address, null, cancelToken) + return! Async.AwaitTask task + } + + if Object.ReferenceEquals (balance, null) then + failwith "Weird null response from balance job" + + return UnitConversion.Convert.FromWei (balance.Value, UnitConversion.EthUnit.Ether) + } + GetRandomizedFuncs currency web3Func let query = match cancelSourceOption with - | None -> - faultTolerantEtherClient.Query - | Some cancelSource -> - faultTolerantEtherClient.QueryWithCancellation cancelSource + | None -> faultTolerantEtherClient.Query + | Some cancelSource -> faultTolerantEtherClient.QueryWithCancellation cancelSource return! query (FaultTolerantParallelClientSettingsForBalanceCheck - mode currency (BalanceMatchWithCacheOrInitialBalance address currency)) + 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" async { let! blockForConfirmationReference = GetBlockToCheckForConfirmedBalance web3 - let balanceOfFunctionMsg = BalanceOfFunction(Owner = publicAddress) + let balanceOfFunctionMsg = BalanceOfFunction (Owner = publicAddress) let contractAddress = TokenManager.GetTokenContractAddress currency let contractHandler = web3.Eth.GetContractHandler contractAddress + if (contractHandler = null) then failwith "contractHandler somehow is null" let! cancelToken = Async.CancellationToken - cancelToken.ThrowIfCancellationRequested() - let! balance = contractHandler.QueryAsync - (balanceOfFunctionMsg, - blockForConfirmationReference, - cancelToken) |> Async.AwaitTask - return UnitConversion.Convert.FromWei(balance, UnitConversion.EthUnit.Ether) + + cancelToken.ThrowIfCancellationRequested () + + let! balance = + contractHandler.QueryAsync + (balanceOfFunctionMsg, blockForConfirmationReference, cancelToken) + |> Async.AwaitTask + + return UnitConversion.Convert.FromWei (balance, UnitConversion.EthUnit.Ether) } - 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 = - match balType with - | 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) - let! balance = Async.AwaitTask task - return UnitConversion.Convert.FromWei(balance, UnitConversion.EthUnit.Ether) - } + match balType with + | 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) + let! balance = Async.AwaitTask task + return UnitConversion.Convert.FromWei (balance, UnitConversion.EthUnit.Ether) + } + GetRandomizedFuncs currency web3Func let query = match cancelSourceOption with - | None -> - faultTolerantEtherClient.Query - | Some cancelSource -> - faultTolerantEtherClient.QueryWithCancellation cancelSource + | None -> faultTolerantEtherClient.Query + | Some cancelSource -> faultTolerantEtherClient.QueryWithCancellation cancelSource return! query (FaultTolerantParallelClientSettingsForBalanceCheck - mode currency (BalanceMatchWithCacheOrInitialBalance address currency)) + mode + currency + (BalanceMatchWithCacheOrInitialBalance address currency)) web3Funcs } - let EstimateTokenTransferFee (account: IAccount) (amount: decimal) destination - : Async = + let EstimateTokenTransferFee (account: IAccount) (amount: decimal) destination: Async = async { let web3Funcs = let web3Func (web3: Web3): Async = let contractAddress = TokenManager.GetTokenContractAddress account.Currency let contractHandler = web3.Eth.GetContractHandler contractAddress - let amountInWei = UnitConversion.Convert.ToWei(amount, UnitConversion.EthUnit.Ether) - let transferFunctionMsg = TransferFunction(FromAddress = account.PublicAddress, - To = destination, - Value = amountInWei) + let amountInWei = UnitConversion.Convert.ToWei (amount, UnitConversion.EthUnit.Ether) + + let transferFunctionMsg = + TransferFunction (FromAddress = account.PublicAddress, To = destination, Value = amountInWei) + async { - let! cancelToken = Async.CancellationToken - let task = - contractHandler.EstimateGasAsync(transferFunctionMsg, cancelToken) - return! Async.AwaitTask task + let! cancelToken = Async.CancellationToken + + let task = + contractHandler.EstimateGasAsync (transferFunctionMsg, cancelToken) + + return! Async.AwaitTask task } + GetRandomizedFuncs account.Currency web3Func + 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)) - let avg = BigInteger.Divide(sum, BigInteger(gasPricesFromDifferentServers.Length)) - HexBigInteger(avg) + let sum = + gasPricesFromDifferentServers.Select(fun hbi -> hbi.Value) + .Aggregate(fun bi1 bi2 -> BigInteger.Add (bi1, bi2)) + + let avg = BigInteger.Divide (sum, BigInteger (gasPricesFromDifferentServers.Length)) + HexBigInteger (avg) - let GetGasPrice (currency: Currency) - : Async = + let GetGasPrice (currency: Currency): Async = async { let web3Funcs = let web3Func (web3: Web3): Async = - async { - let! cancelToken = Async.CancellationToken - let task = web3.Eth.GasPrice.SendRequestAsync(null, cancelToken) - return! Async.AwaitTask task - } + async { + let! cancelToken = Async.CancellationToken + let task = web3.Eth.GasPrice.SendRequestAsync (null, cancelToken) + return! Async.AwaitTask task + } + GetRandomizedFuncs currency web3Func + let minResponsesRequired = if etcEcosystemIsMomentarilyCentralized && currency = Currency.ETC then 1u else 2u + return! faultTolerantEtherClient.Query (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast - currency - (Some (AverageBetweenResponses (minResponsesRequired, AverageGasPrice)))) + currency + (Some (AverageBetweenResponses (minResponsesRequired, AverageGasPrice)))) web3Funcs - } - let BroadcastTransaction (currency: Currency) (transaction: string) - : Async = + let BroadcastTransaction (currency: Currency) (transaction: string): Async = let insufficientFundsMsg = "Insufficient funds" async { let web3Funcs = let web3Func (web3: Web3): Async = - async { - let! cancelToken = Async.CancellationToken - let task = - web3.Eth.Transactions.SendRawTransaction.SendRequestAsync(transaction, null, cancelToken) - return! Async.AwaitTask task - } + async { + let! cancelToken = Async.CancellationToken + + let task = + web3.Eth.Transactions.SendRawTransaction.SendRequestAsync (transaction, null, cancelToken) + + return! Async.AwaitTask task + } + GetRandomizedFuncs currency web3Func + try - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientSettingsForBroadcast ()) - web3Funcs - with - | ex -> + return! faultTolerantEtherClient.Query (FaultTolerantParallelClientSettingsForBroadcast ()) web3Funcs + with ex -> match FSharpUtil.FindException ex with - | None -> - return raise (FSharpUtil.ReRaise ex) + | None -> return raise (FSharpUtil.ReRaise ex) | Some rpcResponseException -> // FIXME: this is fragile, ideally should respond with an error code - if rpcResponseException.Message.StartsWith(insufficientFundsMsg, - StringComparison.InvariantCultureIgnoreCase) then + if rpcResponseException.Message.StartsWith + (insufficientFundsMsg, StringComparison.InvariantCultureIgnoreCase) then return raise InsufficientFunds else 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 = async { let! cancelToken = Async.CancellationToken + let task = - web3.TransactionManager.TransactionReceiptService.PollForReceiptAsync(txHash, cancelToken) + web3.TransactionManager.TransactionReceiptService.PollForReceiptAsync (txHash, cancelToken) + let! transactionReceipt = Async.AwaitTask task + return { - GasUsed = transactionReceipt.GasUsed.Value - Status = transactionReceipt.Status.Value - } + GasUsed = transactionReceipt.GasUsed.Value + Status = transactionReceipt.Status.Value + } } + GetRandomizedFuncs currency web3Func + return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) - web3Funcs + (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) + web3Funcs } let IsOutOfGas (currency: Currency) (txHash: string) (spentGas: int64): Async = async { 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 = + let private GetContractCode (baseCurrency: Currency) (address: string): Async = async { let web3Funcs = let web3Func (web3: Web3): Async = - async { - let! cancelToken = Async.CancellationToken - let task = web3.Eth.GetCode.SendRequestAsync(address, null, cancelToken) - return! Async.AwaitTask task - } + async { + let! cancelToken = Async.CancellationToken + let task = web3.Eth.GetCode.SendRequestAsync (address, null, cancelToken) + return! Async.AwaitTask task + } + GetRandomizedFuncs baseCurrency web3Func + return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast baseCurrency None) - web3Funcs + (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast baseCurrency None) + web3Funcs } let CheckIfAddressIsAValidPaymentDestination (currency: Currency) (address: string): Async = @@ -700,9 +739,14 @@ module Server = let emptyContract = "0x" if not (contractCode.StartsWith emptyContract) then - failwith <| SPrintF2 "GetCode API should always return a string starting with %s, but got: %s" - emptyContract contractCode + failwith + <| SPrintF2 + "GetCode API should always return a string starting with %s, but got: %s" + 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/Ether/TokenManager.fs b/src/GWallet.Backend/Ether/TokenManager.fs index dee36120a..fdee6b6c4 100644 --- a/src/GWallet.Backend/Ether/TokenManager.fs +++ b/src/GWallet.Backend/Ether/TokenManager.fs @@ -18,36 +18,38 @@ module TokenManager = | Currency.SAI -> "0x89d24A6b4CcB1B6fAA2625fE562bDD9a23260359" | _ -> raise <| invalidOp (SPrintF1 "%A has no contract address" currency) - type TokenServiceWrapper(web3, currency: Currency) = + type TokenServiceWrapper (web3, currency: Currency) = inherit StandardTokenService(web3, GetTokenContractAddress currency) member self.ComposeInputDataForTransferTransaction (origin: string, destination: string, tokenAmountInWei: BigInteger, gasLimit: BigInteger) - : string = - let transferFuncBuilder = self.ContractHandler.GetFunction() + : string = + let transferFuncBuilder = self.ContractHandler.GetFunction () - let transferFunctionMsg = TransferFunction(To = destination, - Value = tokenAmountInWei) + let transferFunctionMsg = TransferFunction (To = destination, Value = tokenAmountInWei) let tokenValue = HexBigInteger tokenAmountInWei - let transactionInput = transferFuncBuilder.CreateTransactionInput(transferFunctionMsg, - origin, - HexBigInteger(gasLimit), - tokenValue) + + let transactionInput = + transferFuncBuilder.CreateTransactionInput + (transferFunctionMsg, origin, HexBigInteger (gasLimit), tokenValue) + if (transactionInput = null) then failwith "Assertion failed: transaction input should not be null" if transactionInput.To <> GetTokenContractAddress currency then failwith "Assertion failed: transactionInput's TO property should be equal to the contract address" - if not (transactionInput.Gas.Value.Equals(gasLimit)) then - failwith "Assertion failed: transactionInput's GAS property should be equal to passed GasLimit parameter" - if not (transactionInput.Value.Value.Equals(tokenAmountInWei)) then - failwith "Assertion failed: transactionInput's VALUE property should be equal to passed tokenAmountInWei parameter" + if not (transactionInput.Gas.Value.Equals (gasLimit)) then + failwith + "Assertion failed: transactionInput's GAS property should be equal to passed GasLimit parameter" + if not (transactionInput.Value.Value.Equals (tokenAmountInWei)) then + failwith + "Assertion failed: transactionInput's VALUE property should be equal to passed tokenAmountInWei parameter" transactionInput.Data // this is a dummy instance we need in order to pass it to base class of StandardTokenService, but not // really used online; FIXME: propose "Web3-less" overload to Nethereum - let private dummyOfflineWeb3 = Web3() - type OfflineTokenServiceWrapper(currency: Currency) = - inherit TokenServiceWrapper(dummyOfflineWeb3, currency) + let private dummyOfflineWeb3 = Web3 () + type OfflineTokenServiceWrapper (currency: Currency) = + inherit TokenServiceWrapper(dummyOfflineWeb3, currency) diff --git a/src/GWallet.Backend/Ether/TransactionMetadata.fs b/src/GWallet.Backend/Ether/TransactionMetadata.fs index 21c1d8371..47beb8bdd 100644 --- a/src/GWallet.Backend/Ether/TransactionMetadata.fs +++ b/src/GWallet.Backend/Ether/TransactionMetadata.fs @@ -4,12 +4,15 @@ open GWallet.Backend type TransactionMetadata = { - Fee: MinerFee; + Fee: MinerFee // this below cannot be directly BigInteger because it needs to be JSON-serialized later - TransactionCount: int64; + TransactionCount: int64 } + interface IBlockchainFeeInfo with - member self.FeeEstimationTime with get() = self.Fee.EstimationTime - member self.FeeValue with get() = self.Fee.CalculateAbsoluteValue() - member self.Currency with get() = self.Fee.Currency + member self.FeeEstimationTime = self.Fee.EstimationTime + + member self.FeeValue = self.Fee.CalculateAbsoluteValue () + + member self.Currency = self.Fee.Currency diff --git a/src/GWallet.Backend/Exceptions.fs b/src/GWallet.Backend/Exceptions.fs index 269c2d602..53853fc17 100644 --- a/src/GWallet.Backend/Exceptions.fs +++ b/src/GWallet.Backend/Exceptions.fs @@ -14,4 +14,3 @@ exception AddressWithInvalidChecksum of Option exception AccountAlreadyAdded exception InvalidDestinationAddress of msg: string - diff --git a/src/GWallet.Backend/FSharpUtil.fs b/src/GWallet.Backend/FSharpUtil.fs index a212b1083..7082440d5 100644 --- a/src/GWallet.Backend/FSharpUtil.fs +++ b/src/GWallet.Backend/FSharpUtil.fs @@ -20,47 +20,70 @@ module FSharpUtil = let ToStringFormat (fmt: string) = let rec inner (innerFmt: string) (count: uint32) = // TODO: support %e, %E, %g, %G, %o, %O, %x, %X, etc. see link above - let supportedFormats = [| "%s"; "%d"; "%i"; "%u"; "%M"; "%f"; "%b" ; "%A"; |] - let formatsFound = supportedFormats.Where(fun format -> innerFmt.IndexOf(format) >= 0) - if formatsFound.Any() then - let firstIndexWhereFormatFound = formatsFound.Min(fun format -> innerFmt.IndexOf(format)) + let supportedFormats = + [| + "%s" + "%d" + "%i" + "%u" + "%M" + "%f" + "%b" + "%A" + |] + + let formatsFound = supportedFormats.Where (fun format -> innerFmt.IndexOf (format) >= 0) + if formatsFound.Any () then + let firstIndexWhereFormatFound = formatsFound.Min (fun format -> innerFmt.IndexOf (format)) + let firstFormat = - formatsFound.First(fun format -> innerFmt.IndexOf(format) = firstIndexWhereFormatFound) - let subEnd = innerFmt.IndexOf(firstFormat) + "%x".Length - let sub = innerFmt.Substring(0, subEnd) - let x = sub.Replace(firstFormat, "{" + count.ToString() + "}") + innerFmt.Substring(subEnd) - inner x (count+1u) + formatsFound.First (fun format -> innerFmt.IndexOf (format) = firstIndexWhereFormatFound) + + let subEnd = innerFmt.IndexOf (firstFormat) + "%x".Length + let sub = innerFmt.Substring (0, subEnd) + + let x = + sub.Replace (firstFormat, "{" + count.ToString () + "}") + + innerFmt.Substring (subEnd) + + inner x (count + 1u) else innerFmt + (inner fmt 0u).Replace("%%", "%") let SPrintF1 (fmt: string) (a: Object) = - String.Format(ToStringFormat fmt, a) + String.Format (ToStringFormat fmt, a) let SPrintF2 (fmt: string) (a: Object) (b: Object) = - String.Format(ToStringFormat fmt, a, b) + String.Format (ToStringFormat fmt, a, b) let SPrintF3 (fmt: string) (a: Object) (b: Object) (c: Object) = - String.Format(ToStringFormat fmt, a, b, c) + String.Format (ToStringFormat fmt, a, b, c) let SPrintF4 (fmt: string) (a: Object) (b: Object) (c: Object) (d: Object) = - String.Format(ToStringFormat fmt, a, b, c, d) + String.Format (ToStringFormat fmt, a, b, c, d) let SPrintF5 (fmt: string) (a: Object) (b: Object) (c: Object) (d: Object) (e: Object) = - String.Format(ToStringFormat fmt, a, b, c, d, e) + String.Format (ToStringFormat fmt, a, b, c, d, e) module UwpHacks = #if STRICTER_COMPILATION_BUT_WITH_REFLECTION_AT_RUNTIME - let SPrintF1 fmt a = sprintf fmt a + let SPrintF1 fmt a = + sprintf fmt a - let SPrintF2 fmt a b = sprintf fmt a b + let SPrintF2 fmt a b = + sprintf fmt a b - let SPrintF3 fmt a b c = sprintf fmt a b c + let SPrintF3 fmt a b c = + sprintf fmt a b c - let SPrintF4 fmt a b c d = sprintf fmt a b c d + let SPrintF4 fmt a b c d = + sprintf fmt a b c d - let SPrintF5 fmt a b c d e = sprintf fmt a b c d e + let SPrintF5 fmt a b c d e = + sprintf fmt a b c d e #else let SPrintF1 (fmt: string) (a: Object) = ReflectionlessPrint.SPrintF1 fmt a @@ -78,7 +101,7 @@ module FSharpUtil = ReflectionlessPrint.SPrintF5 fmt a b c d e #endif - type internal ResultWrapper<'T>(value : 'T) = + type internal ResultWrapper<'T> (value: 'T) = // hack? inherit Exception() @@ -87,7 +110,7 @@ module FSharpUtil = module AsyncExtensions = - let MixedParallel2 (a: Async<'T1>) (b: Async<'T2>): Async<'T1*'T2> = + let MixedParallel2 (a: Async<'T1>) (b: Async<'T2>): Async<'T1 * 'T2> = async { let aJob = Async.StartChild a let bJob = Async.StartChild b @@ -96,12 +119,13 @@ module FSharpUtil = let! bStartedJob = bJob let! aJobResult = aStartedJob + let! bJobResult = bStartedJob - return aJobResult,bJobResult + return aJobResult, bJobResult } - let MixedParallel3 (a: Async<'T1>) (b: Async<'T2>) (c: Async<'T3>): Async<'T1*'T2*'T3> = + let MixedParallel3 (a: Async<'T1>) (b: Async<'T2>) (c: Async<'T3>): Async<'T1 * 'T2 * 'T3> = async { let aJob = Async.StartChild a let bJob = Async.StartChild b @@ -112,18 +136,20 @@ module FSharpUtil = let! cStartedJob = cJob let! aJobResult = aStartedJob + let! bJobResult = bStartedJob + let! cJobResult = cStartedJob - return aJobResult,bJobResult,cJobResult + return aJobResult, bJobResult, cJobResult } // efficient raise let private RaiseResult (e: ResultWrapper<'T>) = - Async.FromContinuations(fun (_, econt, _) -> econt e) + Async.FromContinuations (fun (_, econt, _) -> econt e) // like Async.Choice, but with no need for Option types - let WhenAny<'T>(jobs: seq>): Async<'T> = + let WhenAny<'T> (jobs: seq>): Async<'T> = let wrap (job: Async<'T>): Async> = async { let! res = job @@ -133,117 +159,124 @@ module FSharpUtil = async { let wrappedJobs = jobs |> Seq.map wrap let! combinedRes = Async.Choice wrappedJobs + match combinedRes with - | Some x -> - return x - | None -> - return failwith "unreachable" + | Some x -> return x + | None -> return failwith "unreachable" } // a mix between Async.WhenAny and Async.Choice - let WhenAnyAndAll<'T>(jobs: seq>): Async>> = - let taskSource = TaskCompletionSource() + let WhenAnyAndAll<'T> (jobs: seq>): Async>> = + let taskSource = TaskCompletionSource () + let wrap (job: Async<'T>) = async { let! res = job - taskSource.TrySetResult() |> ignore + taskSource.TrySetResult () |> ignore return res } + async { - let allJobsInParallel = - jobs - |> Seq.map wrap - |> Async.Parallel - |> Async.StartChild + let allJobsInParallel = jobs |> Seq.map wrap |> Async.Parallel |> Async.StartChild + let! allJobsStarted = allJobsInParallel + let! _ = Async.AwaitTask taskSource.Task return allJobsStarted } let rec private ListIntersectInternal list1 list2 offset acc currentIndex = - match list1,list2 with - | [],[] -> List.rev acc - | [],_ -> List.append (List.rev acc) list2 - | _,[] -> List.append (List.rev acc) list1 - | head1::tail1,head2::tail2 -> + match list1, list2 with + | [], [] -> List.rev acc + | [], _ -> List.append (List.rev acc) list2 + | _, [] -> List.append (List.rev acc) list1 + | head1 :: tail1, head2 :: tail2 -> if currentIndex % (int offset) = 0 then - ListIntersectInternal list1 tail2 offset (head2::acc) (currentIndex + 1) + ListIntersectInternal list1 tail2 offset (head2 :: acc) (currentIndex + 1) else - ListIntersectInternal tail1 list2 offset (head1::acc) (currentIndex + 1) + ListIntersectInternal tail1 list2 offset (head1 :: acc) (currentIndex + 1) let ListIntersect<'T> (list1: List<'T>) (list2: List<'T>) (offset: uint32): List<'T> = ListIntersectInternal list1 list2 offset [] 1 - let WithTimeout (timeSpan: TimeSpan) (job: Async<'R>): Async> = async { - let read = async { - let! value = job - return value |> SuccessfulValue |> Some - } + let WithTimeout (timeSpan: TimeSpan) (job: Async<'R>): Async> = + async { + let read = + async { + let! value = job + return value |> SuccessfulValue |> Some + } - let delay = async { - let total = int timeSpan.TotalMilliseconds - do! Async.Sleep total - return FailureResult <| TimeoutException() |> Some - } + let delay = + async { + let total = int timeSpan.TotalMilliseconds + do! Async.Sleep total + return FailureResult <| TimeoutException () |> Some + } + + let! dummyOption = Async.Choice ([ read; delay ]) - let! dummyOption = Async.Choice([read; delay]) - match dummyOption with - | Some theResult -> - match theResult with - | SuccessfulValue r -> - return Some r - | FailureResult _ -> - return None - | None -> - // none of the jobs passed to Async.Choice returns None - return failwith "unreachable" - } + match dummyOption with + | Some theResult -> + match theResult with + | SuccessfulValue r -> return Some r + | FailureResult _ -> return None + | None -> + // none of the jobs passed to Async.Choice returns None + return failwith "unreachable" + } // FIXME: we should not need this workaround anymore when this gets addressed: // https://github.com/fsharp/fslang-suggestions/issues/660 let ReRaise (ex: Exception): Exception = - (ExceptionDispatchInfo.Capture ex).Throw () + (ExceptionDispatchInfo.Capture ex).Throw() failwith "Should be unreachable" ex - let rec public FindException<'T when 'T:> Exception>(ex: Exception): Option<'T> = - let rec findExInSeq(sq: seq) = + let rec public FindException<'T when 'T :> Exception> (ex: Exception): Option<'T> = + let rec findExInSeq (sq: seq) = match Seq.tryHead sq with | Some head -> let found = FindException head match found with | Some ex -> Some ex - | None -> - findExInSeq <| Seq.tail sq - | None -> - None + | None -> findExInSeq <| Seq.tail sq + | None -> None + if null = ex then None else match ex with - | :? 'T as specificEx -> Some(specificEx) - | :? AggregateException as aggEx -> - findExInSeq aggEx.InnerExceptions - | _ -> FindException<'T>(ex.InnerException) + | :? 'T as specificEx -> Some (specificEx) + | :? AggregateException as aggEx -> findExInSeq aggEx.InnerExceptions + | _ -> FindException<'T> (ex.InnerException) #if STRICTER_COMPILATION_BUT_WITH_REFLECTION_AT_RUNTIME -// http://stackoverflow.com/a/28466431/6503091 + // http://stackoverflow.com/a/28466431/6503091 // will crash if 'T contains members which aren't only tags - let Construct<'T> (caseInfo: UnionCaseInfo) = FSharpValue.MakeUnion(caseInfo, [||]) :?> 'T + let Construct<'T> (caseInfo: UnionCaseInfo) = + FSharpValue.MakeUnion (caseInfo, [||]) :?> 'T - let GetUnionCaseInfoAndInstance<'T> (caseInfo: UnionCaseInfo) = (Construct<'T> caseInfo) + let GetUnionCaseInfoAndInstance<'T> (caseInfo: UnionCaseInfo) = + (Construct<'T> caseInfo) - let GetAllElementsFromDiscriminatedUnion<'T>() = - FSharpType.GetUnionCases(typeof<'T>) - |> Seq.map GetUnionCaseInfoAndInstance<'T> + let GetAllElementsFromDiscriminatedUnion<'T> () = + FSharpType.GetUnionCases (typeof<'T>) |> Seq.map GetUnionCaseInfoAndInstance<'T> #endif - type OptionBuilder() = + type OptionBuilder () = // see https://github.com/dsyme/fsharp-presentations/blob/master/design-notes/ces-compared.md#overview-of-f-computation-expressions - member x.Bind (v,f) = Option.bind f v - member x.Return v = Some v - member x.ReturnFrom o = o - member x.Zero () = None + member x.Bind (v, f) = + Option.bind f v + + member x.Return v = + Some v + + member x.ReturnFrom o = + o + + member x.Zero () = + None - let option = OptionBuilder() + let option = OptionBuilder () diff --git a/src/GWallet.Backend/FaultTolerantParallelClient.fs b/src/GWallet.Backend/FaultTolerantParallelClient.fs index 2a4508036..9973f8e82 100644 --- a/src/GWallet.Backend/FaultTolerantParallelClient.fs +++ b/src/GWallet.Backend/FaultTolerantParallelClient.fs @@ -9,52 +9,55 @@ open System.Threading.Tasks open GWallet.Backend.FSharpUtil.UwpHacks type ResourceUnavailabilityException (message: string, innerOrLastException: Exception) = - inherit Exception (message, innerOrLastException) + inherit Exception(message, innerOrLastException) type private TaskUnavailabilityException (message: string, innerException: Exception) = - inherit ResourceUnavailabilityException (message, innerException) + inherit ResourceUnavailabilityException(message, innerException) type private ServerUnavailabilityException (message: string, lastException: Exception) = - inherit ResourceUnavailabilityException (message, lastException) + inherit ResourceUnavailabilityException(message, lastException) -type private NoneAvailableException (message:string, lastException: Exception) = - inherit ServerUnavailabilityException (message, lastException) +type private NoneAvailableException (message: string, lastException: Exception) = + inherit ServerUnavailabilityException(message, lastException) -type private NotEnoughAvailableException (message:string, lastException: Exception) = - inherit ServerUnavailabilityException (message, lastException) +type private NotEnoughAvailableException (message: string, lastException: Exception) = + inherit ServerUnavailabilityException(message, lastException) type ResultInconsistencyException (totalNumberOfSuccesfulResultsObtained: int, maxNumberOfConsistentResultsObtained: int, numberOfConsistentResultsRequired: uint32) = - inherit Exception ("Results obtained were not enough to be considered consistent" + - SPrintF3 " (received: %i, consistent: %i, required: %i)" - totalNumberOfSuccesfulResultsObtained - maxNumberOfConsistentResultsObtained - numberOfConsistentResultsRequired) - -type UnsuccessfulServer<'K,'R when 'K: equality and 'K :> ICommunicationHistory> = + inherit Exception("Results obtained were not enough to be considered consistent" + + SPrintF3 + " (received: %i, consistent: %i, required: %i)" + totalNumberOfSuccesfulResultsObtained + maxNumberOfConsistentResultsObtained + numberOfConsistentResultsRequired) + +type UnsuccessfulServer<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = { - Server: Server<'K,'R> + Server: Server<'K, 'R> Failure: Exception } -type ExecutedServers<'K,'R when 'K: equality and 'K :> ICommunicationHistory> = + +type ExecutedServers<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = { SuccessfulResults: List<'R> - UnsuccessfulServers: List> + UnsuccessfulServers: List> } -type internal FinalResult<'K,'T,'R when 'K: equality and 'K :> ICommunicationHistory> = + +type internal FinalResult<'K, 'T, 'R when 'K: equality and 'K :> ICommunicationHistory> = | ConsistentResult of 'R | AverageResult of 'R - | InconsistentOrNotEnoughResults of ExecutedServers<'K,'R> + | InconsistentOrNotEnoughResults of ExecutedServers<'K, 'R> -type ServerResult<'K,'R when 'K: equality and 'K :> ICommunicationHistory> = +type ServerResult<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = | SuccessfulResult of 'R - | Failure of UnsuccessfulServer<'K,'R> + | Failure of UnsuccessfulServer<'K, 'R> type ConsistencySettings<'R> = // fun passed represents if cached value matches or not - | OneServerConsistentWithCertainValueOrTwoServers of ('R->bool) + | OneServerConsistentWithCertainValueOrTwoServers of ('R -> bool) | SpecificNumberOfConsistentResponsesRequired of uint32 | AverageBetweenResponses of (uint32 * (List<'R> -> 'R)) @@ -76,89 +79,86 @@ type ResultSelectionMode<'R> = type FaultTolerantParallelClientSettings<'R> = { - NumberOfParallelJobsAllowed: uint32; - NumberOfRetries: uint32; - NumberOfRetriesForInconsistency: uint32; + NumberOfParallelJobsAllowed: uint32 + NumberOfRetries: uint32 + NumberOfRetriesForInconsistency: uint32 ResultSelectionMode: ResultSelectionMode<'R> - ExceptionHandler: Optionunit> + ExceptionHandler: Option unit> } -type MutableStateUnsafeAccessor<'T>(initialState: 'T) = +type MutableStateUnsafeAccessor<'T> (initialState: 'T) = let mutable state = initialState + member __.Value - with get() = - state - and set value = - state <- value + with get () = state + and set value = state <- value -type MutableStateCapsule<'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) + let lockObject = Object () + member __.SafeDo (func: MutableStateUnsafeAccessor<'T> -> 'R): 'R = lock lockObject (fun _ -> func state) -type ServerJob<'K,'R when 'K: equality and 'K :> ICommunicationHistory> = +type ServerJob<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = { - Job: Async> - Server: Server<'K,'R> + Job: Async> + Server: Server<'K, 'R> } -type ServerTask<'K,'R when 'K: equality and 'K :> ICommunicationHistory> = +type ServerTask<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = { - Task: Task> - Server: Server<'K,'R> + Task: Task> + Server: Server<'K, 'R> CancellationTokenSource: CancellationTokenSource } - with - static member WhenAny(tasks: seq>) = - async { - let task = Task.WhenAny(tasks.Select(fun t -> t.Task)) - let! fastestTask = Async.AwaitTask task - let correspondingTask = tasks.Single(fun t -> t.Task = fastestTask) - return correspondingTask - } + + static member WhenAny (tasks: seq>) = + async { + let task = Task.WhenAny (tasks.Select (fun t -> t.Task)) + let! fastestTask = Async.AwaitTask task + let correspondingTask = tasks.Single (fun t -> t.Task = fastestTask) + return correspondingTask + } type internal ClientCancelStateInner = | Canceled of DateTime | Alive of List + type internal ClientCancelState = MutableStateCapsule type internal Runner<'Resource when 'Resource: equality> = - static member Run<'K,'Ex when 'K: equality and 'K :> ICommunicationHistory and 'Ex :> Exception> - (server: Server<'K,'Resource>) - (stopwatch: Stopwatch) - (cancelState: ClientCancelState) - (shouldReportUncanceledJobs: bool) - (maybeExceptionHandler: Optionunit>) - : Async> = + static member Run<'K, 'Ex when 'K: equality and 'K :> ICommunicationHistory and 'Ex :> Exception> (server: Server<'K, 'Resource>) + (stopwatch: Stopwatch) + (cancelState: ClientCancelState) + (shouldReportUncanceledJobs: bool) + (maybeExceptionHandler: Option unit>) + : Async> = async { try try let! res = server.Retrieval return SuccessfulValue res finally - stopwatch.Stop() - with - | ex -> + stopwatch.Stop () + with ex -> // because if an exception happens roughly at the same time as cancellation, we don't care so much let isLateEnoughToReportProblem (state: ClientCancelStateInner) = match state with | Alive _ -> false - | Canceled date -> - (date + TimeSpan.FromSeconds 1.) < DateTime.UtcNow + | Canceled date -> (date + TimeSpan.FromSeconds 1.) < DateTime.UtcNow - let report = Config.DebugLog && - shouldReportUncanceledJobs && - cancelState.SafeDo(fun state -> isLateEnoughToReportProblem state.Value) + let report = + Config.DebugLog + && shouldReportUncanceledJobs + && cancelState.SafeDo (fun state -> isLateEnoughToReportProblem state.Value) let maybeSpecificEx = FSharpUtil.FindException<'Ex> ex match maybeSpecificEx with | Some specificInnerEx -> if report then - Infrastructure.LogError (SPrintF1 "Cancellation fault warning: %s" - (ex.ToString())) + Infrastructure.LogError (SPrintF1 "Cancellation fault warning: %s" (ex.ToString ())) + return FailureResult (specificInnerEx :> Exception) | None -> match maybeExceptionHandler with @@ -168,337 +168,353 @@ type internal Runner<'Resource when 'Resource: equality> = return FailureResult ex } - static member CreateAsyncJobFromFunc<'K,'Ex when 'K: equality and 'K :> ICommunicationHistory and 'Ex :> Exception> - (shouldReportUncanceledJobs: bool) - (exceptionHandler: Optionunit>) - (cancelState: ClientCancelState) - (updateServer: ('K->bool)->HistoryFact->unit) - (server: Server<'K,'Resource>) - : ServerJob<'K,'Resource> = - let job = async { - let stopwatch = Stopwatch() - stopwatch.Start() - - let! runResult = - Runner.Run<'K,'Ex> server stopwatch cancelState shouldReportUncanceledJobs exceptionHandler - - match runResult with - | SuccessfulValue result -> - let historyFact = { TimeSpan = stopwatch.Elapsed; Fault = None } - updateServer (fun srv -> srv = server.Details) historyFact - return SuccessfulResult result - | FailureResult ex -> - let exInfo = - { - TypeFullName = ex.GetType().FullName - Message = ex.Message - } - let historyFact = { TimeSpan = stopwatch.Elapsed; Fault = (Some exInfo) } - updateServer (fun srv -> srv = server.Details) historyFact - return - Failure + static member CreateAsyncJobFromFunc<'K, 'Ex when 'K: equality and 'K :> ICommunicationHistory and 'Ex :> Exception> (shouldReportUncanceledJobs: bool) + (exceptionHandler: Option unit>) + (cancelState: ClientCancelState) + (updateServer: ('K -> bool) -> HistoryFact -> unit) + (server: Server<'K, 'Resource>) + : ServerJob<'K, 'Resource> = + let job = + async { + let stopwatch = Stopwatch () + stopwatch.Start () + + let! runResult = + Runner.Run<'K, 'Ex> server stopwatch cancelState shouldReportUncanceledJobs exceptionHandler + + match runResult with + | SuccessfulValue result -> + let historyFact = + { + TimeSpan = stopwatch.Elapsed + Fault = None + } + + updateServer (fun srv -> srv = server.Details) historyFact + + return SuccessfulResult result + | FailureResult ex -> + let exInfo = { - Server = server - Failure = ex + TypeFullName = ex.GetType().FullName + Message = ex.Message } + + let historyFact = + { + TimeSpan = stopwatch.Elapsed + Fault = (Some exInfo) + } + + updateServer (fun srv -> srv = server.Details) historyFact + + return Failure + { + Server = server + Failure = ex + } + } + + { + Job = job + Server = server } - { Job = job; Server = server } - - static member CreateJobs<'K,'Ex when 'K: equality and 'K :> ICommunicationHistory and 'Ex :> Exception> - (shouldReportUncanceledJobs: bool) - (parallelJobs: uint32) - (exceptionHandler: Optionunit>) - (updateServerFunc: ('K->bool)->HistoryFact->unit) - (funcs: List>) - (cancelState: ClientCancelState) - : List>*List> = - let launchFunc = Runner.CreateAsyncJobFromFunc<'K,'Ex> shouldReportUncanceledJobs - exceptionHandler - cancelState - updateServerFunc - let jobs = funcs - |> Seq.map launchFunc - |> List.ofSeq + static member CreateJobs<'K, 'Ex when 'K: equality and 'K :> ICommunicationHistory and 'Ex :> Exception> (shouldReportUncanceledJobs: bool) + (parallelJobs: uint32) + (exceptionHandler: Option unit>) + (updateServerFunc: ('K -> bool) -> HistoryFact -> unit) + (funcs: List>) + (cancelState: ClientCancelState) + : List> * List> = + let launchFunc = + Runner.CreateAsyncJobFromFunc<'K, 'Ex> + shouldReportUncanceledJobs + exceptionHandler + cancelState + updateServerFunc + + let jobs = funcs |> Seq.map launchFunc |> List.ofSeq if parallelJobs < uint32 jobs.Length then List.splitAt (int parallelJobs) jobs else - jobs,List.empty + jobs, List.empty exception AlreadyCanceled -type CustomCancelSource() = +type CustomCancelSource () = - let canceled = Event() + let canceled = Event () let mutable canceledAlready = false - let lockObj = Object() + let lockObj = Object () - member __.Cancel() = + member __.Cancel () = lock lockObj (fun _ -> if canceledAlready then raise <| ObjectDisposedException "Already canceled/disposed" - canceledAlready <- true - ) - canceled.Trigger() + canceledAlready <- true) + canceled.Trigger () [] - member __.Canceled - with get() = - lock lockObj (fun _ -> - if canceledAlready then - raise <| AlreadyCanceled - canceled.Publish - ) + member __.Canceled = + lock lockObj (fun _ -> + if canceledAlready then + raise <| AlreadyCanceled + canceled.Publish) interface IDisposable with - member self.Dispose() = + member self.Dispose () = try - self.Cancel() - with - | :? ObjectDisposedException -> - () - // TODO: cleanup also subscribed handlers? see https://stackoverflow.com/q/58912910/544947 + self.Cancel () + with :? ObjectDisposedException -> () +// TODO: cleanup also subscribed handlers? see https://stackoverflow.com/q/58912910/544947 -type FaultTolerantParallelClient<'K,'E when 'K: equality and 'K :> ICommunicationHistory and 'E :> Exception> - (updateServer: ('K->bool)->HistoryFact->unit) = +type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicationHistory and 'E :> Exception> (updateServer: ('K -> bool) -> HistoryFact -> unit) = do if typeof<'E> = typeof then - raise (ArgumentException("'E cannot be System.Exception, use a derived one", "'E")) + raise (ArgumentException ("'E cannot be System.Exception, use a derived one", "'E")) let MeasureConsistency (results: List<'R>) = - results |> Seq.countBy id |> Seq.sortByDescending (fun (_,count: int) -> count) |> List.ofSeq + results + |> Seq.countBy id + |> Seq.sortByDescending (fun (_, count: int) -> count) + |> List.ofSeq + + let LaunchAsyncJob (job: ServerJob<'K, 'R>): ServerTask<'K, 'R> = + let cancellationSource = new CancellationTokenSource() - let LaunchAsyncJob (job: ServerJob<'K,'R>) - : ServerTask<'K,'R> = - let cancellationSource = new CancellationTokenSource () let token = try cancellationSource.Token - with - | :? ObjectDisposedException as ex -> - raise <| TaskUnavailabilityException("cancellationTokenSource already disposed", ex) - let task = Async.StartAsTask(job.Job, ?cancellationToken = Some token) - - let serverTask = { - Task = task - Server = job.Server - CancellationTokenSource = cancellationSource - } + with :? ObjectDisposedException as ex -> + raise + <| TaskUnavailabilityException ("cancellationTokenSource already disposed", ex) + + let task = Async.StartAsTask (job.Job, ?cancellationToken = Some token) + + let serverTask = + { + Task = task + Server = job.Server + CancellationTokenSource = cancellationSource + } serverTask - 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 + 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 + } + else + let jobToWaitForFirstFinishedTask = ServerTask.WhenAny startedTasks + let! fastestTask = jobToWaitForFirstFinishedTask + + let restOfTasks = startedTasks.Where (fun task -> not (task = fastestTask)) |> List.ofSeq + + let newResults, newFailedFuncs = + match fastestTask.Task.Result with + | Failure unsuccessfulServer -> resultsSoFar, unsuccessfulServer :: failedFuncsSoFar + | SuccessfulResult newResult -> newResult :: resultsSoFar, failedFuncsSoFar + + fastestTask.CancellationTokenSource.Dispose () + + let newRestOfTasks, newRestOfJobs = + match jobsToLaunchLater with + | [] -> 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) + + match maybeNewTask with + | Some newTask -> newTask :: restOfTasks, tail + | None -> restOfTasks, tail + + let returnWithConsistencyOf (minNumberOfConsistentResultsRequired: Option) cacheMatchFunc = + async { + let resultsSortedByCount = MeasureConsistency newResults + match resultsSortedByCount with + | [] -> + return! WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState + | (mostConsistentResult, maxNumberOfConsistentResultsObtained) :: _ -> + match minNumberOfConsistentResultsRequired, cacheMatchFunc with + | None, None -> return ConsistentResult mostConsistentResult + | Some number, Some cacheMatch -> + if cacheMatch mostConsistentResult + || (maxNumberOfConsistentResultsObtained = int number) then + return ConsistentResult mostConsistentResult + else + return! WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState + | _ -> return failwith "should be either both None or both Some!" } - else - let jobToWaitForFirstFinishedTask = ServerTask.WhenAny startedTasks - let! fastestTask = jobToWaitForFirstFinishedTask - - let restOfTasks = - startedTasks.Where(fun task -> not (task = fastestTask)) |> List.ofSeq - - let newResults,newFailedFuncs = - match fastestTask.Task.Result with - | Failure unsuccessfulServer -> - resultsSoFar,unsuccessfulServer::failedFuncsSoFar - | SuccessfulResult newResult -> - newResult::resultsSoFar,failedFuncsSoFar - - fastestTask.CancellationTokenSource.Dispose() - - let newRestOfTasks,newRestOfJobs = - match jobsToLaunchLater with - | [] -> - 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 - ) - match maybeNewTask with - | Some newTask -> - newTask::restOfTasks,tail - | None -> - restOfTasks,tail - - let returnWithConsistencyOf (minNumberOfConsistentResultsRequired: Option) cacheMatchFunc = async { - let resultsSortedByCount = MeasureConsistency newResults - match resultsSortedByCount with - | [] -> - return! WhenSomeInternal consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState - | (mostConsistentResult,maxNumberOfConsistentResultsObtained)::_ -> - match minNumberOfConsistentResultsRequired,cacheMatchFunc with - | None, None -> - return ConsistentResult mostConsistentResult - | Some number, Some cacheMatch -> - if cacheMatch mostConsistentResult || (maxNumberOfConsistentResultsObtained = int number) then - return ConsistentResult mostConsistentResult - else - return! WhenSomeInternal consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState - | _ -> return failwith "should be either both None or both Some!" - } - match consistencySettings with - | Some (AverageBetweenResponses (minimumNumberOfResponses,averageFunc)) -> - if (newResults.Length >= int minimumNumberOfResponses) then - return AverageResult (averageFunc newResults) - else - return! WhenSomeInternal consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState - | Some (SpecificNumberOfConsistentResponsesRequired number) -> - return! returnWithConsistencyOf (Some number) ((fun _ -> false) |> Some) - | Some (OneServerConsistentWithCertainValueOrTwoServers cacheMatchFunc) -> - return! returnWithConsistencyOf (Some 2u) (Some cacheMatchFunc) - | None -> - if newRestOfTasks.Length = 0 then - - Infrastructure.LogDebug "100% done (for this currency)" - return! returnWithConsistencyOf None None + match consistencySettings with + | Some (AverageBetweenResponses (minimumNumberOfResponses, averageFunc)) -> + if (newResults.Length >= int minimumNumberOfResponses) then + return AverageResult (averageFunc newResults) + else + return! WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState + | Some (SpecificNumberOfConsistentResponsesRequired number) -> + return! returnWithConsistencyOf (Some number) ((fun _ -> false) |> Some) + | Some (OneServerConsistentWithCertainValueOrTwoServers cacheMatchFunc) -> + return! returnWithConsistencyOf (Some 2u) (Some cacheMatchFunc) + | None -> + if newRestOfTasks.Length = 0 then - else - 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 - } + Infrastructure.LogDebug "100% done (for this currency)" + return! returnWithConsistencyOf None None + + else + 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 + } 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 -> - () - - state.Value <- Canceled DateTime.UtcNow - ) + 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) // 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 let shouldReportUncanceledJobs = match settings.ResultSelectionMode with | Exhaustive -> false - | Selective subSettings -> - subSettings.ReportUncanceledJobs + | Selective subSettings -> subSettings.ReportUncanceledJobs 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 - ) - - let startedTasks,jobsToLaunchLater = + 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) + + let startedTasks, jobsToLaunchLater = match maybeJobs with - | None -> - raise <| TaskCanceledException "Found canceled when about to launch more jobs" - | Some (firstJobsToLaunch,jobsToLaunchLater) -> + | None -> raise <| TaskCanceledException "Found canceled when about to launch more jobs" + | Some (firstJobsToLaunch, jobsToLaunchLater) -> match cancellationSource with | None -> () | Some customCancelSource -> try - customCancelSource.Canceled.Add(fun _ -> - CancelAndDispose cancelState - ) - with - | AlreadyCanceled -> - raise <| TaskCanceledException( - "Found canceled when about to subscribe to cancellation" - ) + customCancelSource.Canceled.Add (fun _ -> CancelAndDispose cancelState) + 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" + | 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 - ) - - let job = WhenSomeInternal consistencyConfig - initialServerCount - startedTasks - jobsToLaunchLater - resultsSoFar - failedFuncsSoFar - cancellationSource - cancelState + startedTasks, jobsToLaunchLater) + + let job = + WhenSomeInternal + consistencyConfig + initialServerCount + startedTasks + jobsToLaunchLater + resultsSoFar + failedFuncsSoFar + cancellationSource + cancelState + let jobWithCancellation = async { try @@ -507,228 +523,225 @@ type FaultTolerantParallelClient<'K,'E when 'K: equality and 'K :> ICommunicatio finally CancelAndDispose cancelState } + jobWithCancellation 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 - - match settings.ResultSelectionMode with - | Selective resultSelectionSettings -> - match resultSelectionSettings.ConsistencyConfig with - | SpecificNumberOfConsistentResponsesRequired numberOfConsistentResponsesRequired -> - if numberOfConsistentResponsesRequired < 1u then - 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")) - | AverageBetweenResponses(minimumNumberOfResponses,_) -> - if (int minimumNumberOfResponses > numberOfParallelJobsAllowed) then - return raise(ArgumentException("numberOfParallelJobsAllowed should be equal or higher than minimumNumberOfResponses for the averageFunc", - "settings")) - | OneServerConsistentWithCertainValueOrTwoServers _ -> - () - | _ -> () - - let consistencyConfig = + (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 + match settings.ResultSelectionMode with - | Exhaustive -> None - | Selective subSettings -> Some subSettings.ConsistencyConfig - let job = WhenSome settings - consistencyConfig - funcs - resultsSoFar - failedFuncsSoFar - cancellationSource - let! result = job - match result with - | AverageResult averageResult -> - return averageResult - | ConsistentResult consistentResult -> - return consistentResult - | InconsistentOrNotEnoughResults executedServers -> - let failedFuncs = executedServers.UnsuccessfulServers - |> List.map (fun unsuccessfulServer -> unsuccessfulServer.Server) - if executedServers.SuccessfulResults.Length = 0 then - if (retries = settings.NumberOfRetries) then - 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 - else - let totalNumberOfSuccesfulResultsObtained = executedServers.SuccessfulResults.Length - - // HACK: we do this as a quick fix wrt new OneServerConsistentWithCertainValueOrTwoServers setting, but we should - // (TODO) rather throw a specific overload of ResultInconsistencyException about this mode being used - let wrappedSettings = - match consistencyConfig with - | Some (OneServerConsistentWithCertainValueOrTwoServers _) -> - Some (SpecificNumberOfConsistentResponsesRequired 2u) - | _ -> consistencyConfig - - 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" - | (_,maxNumberOfConsistentResultsObtained)::_ -> - if (retriesForInconsistency = settings.NumberOfRetriesForInconsistency) then - return raise (ResultInconsistencyException(totalNumberOfSuccesfulResultsObtained, - maxNumberOfConsistentResultsObtained, - numberOfConsistentResponsesRequired)) - else - return! QueryInternalImplementation - settings - initialFuncCount - funcs - List.Empty - List.Empty - retries - (retriesForInconsistency + 1u) - cancellationSource - | Some(AverageBetweenResponses _) -> + | Selective resultSelectionSettings -> + match resultSelectionSettings.ConsistencyConfig with + | SpecificNumberOfConsistentResponsesRequired numberOfConsistentResponsesRequired -> + if numberOfConsistentResponsesRequired < 1u then + 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")) + | AverageBetweenResponses (minimumNumberOfResponses, _) -> + if (int minimumNumberOfResponses > numberOfParallelJobsAllowed) then + return raise + (ArgumentException + ("numberOfParallelJobsAllowed should be equal or higher than minimumNumberOfResponses for the averageFunc", + "settings")) + | OneServerConsistentWithCertainValueOrTwoServers _ -> () + | _ -> () + + let consistencyConfig = + match settings.ResultSelectionMode with + | Exhaustive -> None + | Selective subSettings -> Some subSettings.ConsistencyConfig + + let job = + WhenSome settings consistencyConfig funcs resultsSoFar failedFuncsSoFar cancellationSource + + let! result = job + + match result with + | AverageResult averageResult -> return averageResult + | ConsistentResult consistentResult -> return consistentResult + | InconsistentOrNotEnoughResults executedServers -> + let failedFuncs = + executedServers.UnsuccessfulServers + |> List.map (fun unsuccessfulServer -> unsuccessfulServer.Server) + + if executedServers.SuccessfulResults.Length = 0 then 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)) + return raise (NoneAvailableException ("Not available", firstEx)) else return! QueryInternalImplementation - settings - initialFuncCount - failedFuncs - executedServers.SuccessfulResults - executedServers.UnsuccessfulServers - (retries + 1u) - retriesForInconsistency - cancellationSource - | _ -> - return failwith "wrapping settings didn't work?" + settings + initialFuncCount + failedFuncs + executedServers.SuccessfulResults + List.Empty + (retries + 1u) + retriesForInconsistency + cancellationSource + else + let totalNumberOfSuccesfulResultsObtained = executedServers.SuccessfulResults.Length + + // HACK: we do this as a quick fix wrt new OneServerConsistentWithCertainValueOrTwoServers setting, but we should + // (TODO) rather throw a specific overload of ResultInconsistencyException about this mode being used + let wrappedSettings = + match consistencyConfig with + | Some (OneServerConsistentWithCertainValueOrTwoServers _) -> + Some (SpecificNumberOfConsistentResponsesRequired 2u) + | _ -> consistencyConfig + + 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" + | (_, maxNumberOfConsistentResultsObtained) :: _ -> + if (retriesForInconsistency = settings.NumberOfRetriesForInconsistency) then + 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 + 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 - 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 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 + let faultyServers = + 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 List.append sortedWorkingServers (List.append serversWithNoHistoryServers sortedFaultyServers) else let intersectionOffset = 3u - let result = FSharpUtil.ListIntersect - (List.append serversWithNoHistoryServers sortedWorkingServers) - sortedFaultyServers - intersectionOffset + + let result = + FSharpUtil.ListIntersect + (List.append serversWithNoHistoryServers sortedWorkingServers) + sortedFaultyServers + intersectionOffset + let randomizationOffset = intersectionOffset + 1u Shuffler.RandomizeEveryNthElement result randomizationOffset - member private __.QueryInternal<'R when 'R : equality> - (settings: FaultTolerantParallelClientSettings<'R>) - (servers: List>) - (cancellationTokenSourceOption: Option) - : Async<'R> = + member private __.QueryInternal<'R when 'R: equality> (settings: FaultTolerantParallelClientSettings<'R>) + (servers: List>) + (cancellationTokenSourceOption: Option) + : Async<'R> = if settings.NumberOfParallelJobsAllowed < 1u then - raise (ArgumentException("must be higher than zero", "numberOfParallelJobsAllowed")) + raise (ArgumentException ("must be higher than zero", "numberOfParallelJobsAllowed")) let initialServerCount = uint32 servers.Length + let maybeSortedServers = match settings.ResultSelectionMode with | Exhaustive -> servers - | Selective selSettings -> - SortServers servers selSettings.ServerSelectionMode - - let job = QueryInternalImplementation - settings - initialServerCount - maybeSortedServers - List.Empty - List.Empty - 0u - 0u - cancellationTokenSourceOption + | Selective selSettings -> SortServers servers selSettings.ServerSelectionMode + + let job = + QueryInternalImplementation + settings + initialServerCount + maybeSortedServers + List.Empty + List.Empty + 0u + 0u + cancellationTokenSourceOption + async { let! res = job return res } - member self.QueryWithCancellation<'R when 'R : equality> - (cancellationTokenSource: CustomCancelSource) - (settings: FaultTolerantParallelClientSettings<'R>) - (servers: List>) - : Async<'R> = + member self.QueryWithCancellation<'R when 'R: equality> (cancellationTokenSource: CustomCancelSource) + (settings: FaultTolerantParallelClientSettings<'R>) + (servers: List>) + : Async<'R> = self.QueryInternal<'R> settings servers (Some cancellationTokenSource) - member self.Query<'R when 'R : equality> (settings: FaultTolerantParallelClientSettings<'R>) - (servers: List>) - : Async<'R> = + member self.Query<'R when 'R: equality> (settings: FaultTolerantParallelClientSettings<'R>) + (servers: List>) + : Async<'R> = self.QueryInternal<'R> settings servers None diff --git a/src/GWallet.Backend/FiatValueEstimation.fs b/src/GWallet.Backend/FiatValueEstimation.fs index 27894003f..a899474bd 100644 --- a/src/GWallet.Backend/FiatValueEstimation.fs +++ b/src/GWallet.Backend/FiatValueEstimation.fs @@ -10,7 +10,8 @@ open GWallet.Backend.FSharpUtil.UwpHacks module FiatValueEstimation = let private PERIOD_TO_CONSIDER_PRICE_STILL_FRESH = TimeSpan.FromMinutes 2.0 - type CoinCapProvider = JsonProvider<""" + type CoinCapProvider = + JsonProvider<""" { "data": { "id": "bitcoin", @@ -27,119 +28,130 @@ module FiatValueEstimation = | CoinCap | CoinGecko - let private QueryOnlineInternal currency (provider: PriceProvider): Async> = async { - use webClient = new WebClient() - let tickerName = - match currency,provider with - | Currency.BTC,_ -> "bitcoin" - | Currency.LTC,_ -> "litecoin" - | Currency.ETH,_ | Currency.SAI,_ -> "ethereum" - | Currency.ETC,_ -> "ethereum-classic" - | Currency.DAI,PriceProvider.CoinCap -> "multi-collateral-dai" - | Currency.DAI,_ -> "dai" - try - let baseUrl = - match provider with - | PriceProvider.CoinCap -> - SPrintF1 "https://api.coincap.io/v2/rates/%s" tickerName - | PriceProvider.CoinGecko -> - SPrintF1 "https://api.coingecko.com/api/v3/simple/price?ids=%s&vs_currencies=usd" tickerName - let uri = Uri baseUrl - let task = webClient.DownloadStringTaskAsync uri - let! res = Async.AwaitTask task - return Some (tickerName,res) - with - | ex -> - if (FSharpUtil.FindException ex).IsSome then - return None - else - return raise <| FSharpUtil.ReRaise ex - } + let private QueryOnlineInternal currency (provider: PriceProvider): Async> = + async { + use webClient = new WebClient() + + let tickerName = + match currency, provider with + | Currency.BTC, _ -> "bitcoin" + | Currency.LTC, _ -> "litecoin" + | Currency.ETH, _ + | Currency.SAI, _ -> "ethereum" + | Currency.ETC, _ -> "ethereum-classic" + | Currency.DAI, PriceProvider.CoinCap -> "multi-collateral-dai" + | Currency.DAI, _ -> "dai" - let private QueryCoinCap currency = async { - let! maybeJson = QueryOnlineInternal currency PriceProvider.CoinCap - match maybeJson with - | None -> return None - | Some (_, json) -> try - let tickerObj = CoinCapProvider.Parse json - return Some tickerObj.Data.RateUsd - with - | ex -> - if currency = ETC then - // interestingly this can throw in CoinCap because retreiving ethereum-classic doesn't work... + let baseUrl = + match provider with + | PriceProvider.CoinCap -> SPrintF1 "https://api.coincap.io/v2/rates/%s" tickerName + | PriceProvider.CoinGecko -> + SPrintF1 "https://api.coingecko.com/api/v3/simple/price?ids=%s&vs_currencies=usd" tickerName + + let uri = Uri baseUrl + let task = webClient.DownloadStringTaskAsync uri + let! res = Async.AwaitTask task + return Some (tickerName, res) + with ex -> + if (FSharpUtil.FindException ex).IsSome then return None else return raise <| FSharpUtil.ReRaise ex - } + } - let private QueryCoinGecko currency = async { - let! maybeJson = QueryOnlineInternal currency PriceProvider.CoinGecko - match maybeJson with - | None -> return None - | Some (ticker, json) -> - // try to parse this as an example: {"bitcoin":{"usd":7952.29}} - let parsedJsonObj = FSharp.Data.JsonValue.Parse json - let usdPrice = - match parsedJsonObj.TryGetProperty ticker with - | None -> failwith <| SPrintF1 "Could not pre-parse %s" json - | Some innerObj -> - match innerObj.TryGetProperty "usd" with - | None -> failwith <| SPrintF1 "Could not parse %s" json - | Some value -> value.AsDecimal() - return Some usdPrice - } + let private QueryCoinCap currency = + async { + let! maybeJson = QueryOnlineInternal currency PriceProvider.CoinCap - let private RetrieveOnline currency = async { - let coinGeckoJob = QueryCoinGecko currency - let coinCapJob = QueryCoinCap currency - let bothJobs = FSharpUtil.AsyncExtensions.MixedParallel2 coinGeckoJob coinCapJob - let! maybeUsdPriceFromCoinGecko, maybeUsdPriceFromCoinCap = bothJobs - if maybeUsdPriceFromCoinCap.IsSome && currency = Currency.ETC then - Infrastructure.ReportWarningMessage "Currency ETC can now be queried from CoinCap provider?" - let result = - match maybeUsdPriceFromCoinGecko, maybeUsdPriceFromCoinCap with - | None, None -> None - | Some usdPriceFromCoinGecko, None -> - Some usdPriceFromCoinGecko - | None, Some usdPriceFromCoinCap -> - Some usdPriceFromCoinCap - | Some usdPriceFromCoinGecko, Some usdPriceFromCoinCap -> - let average = (usdPriceFromCoinGecko + usdPriceFromCoinCap) / 2m - Some average - - let realResult = - match result with - | Some price -> - let realPrice = - if currency = Currency.SAI then - let ethMultiplied = price * 0.0053m - ethMultiplied + match maybeJson with + | None -> return None + | Some (_, json) -> + try + let tickerObj = CoinCapProvider.Parse json + return Some tickerObj.Data.RateUsd + with ex -> + if currency = ETC then + // interestingly this can throw in CoinCap because retreiving ethereum-classic doesn't work... + return None else - price - Caching.Instance.StoreLastFiatUsdPrice(currency, realPrice) - realPrice |> Some - | None -> None - return realResult - } + return raise <| FSharpUtil.ReRaise ex + } + + let private QueryCoinGecko currency = + async { + let! maybeJson = QueryOnlineInternal currency PriceProvider.CoinGecko + + match maybeJson with + | None -> return None + | Some (ticker, json) -> + // try to parse this as an example: {"bitcoin":{"usd":7952.29}} + let parsedJsonObj = FSharp.Data.JsonValue.Parse json + + let usdPrice = + match parsedJsonObj.TryGetProperty ticker with + | None -> failwith <| SPrintF1 "Could not pre-parse %s" json + | Some innerObj -> + match innerObj.TryGetProperty "usd" with + | None -> failwith <| SPrintF1 "Could not parse %s" json + | Some value -> value.AsDecimal () + + return Some usdPrice + } - let UsdValue(currency: Currency): Async> = async { - let maybeUsdPrice = Caching.Instance.RetrieveLastKnownUsdPrice currency - match maybeUsdPrice with - | NotAvailable -> - let! maybeOnlineUsdPrice = RetrieveOnline currency - match maybeOnlineUsdPrice with - | None -> return NotFresh NotAvailable - | Some value -> return Fresh value - | Cached(someValue,someDate) -> - if (someDate + PERIOD_TO_CONSIDER_PRICE_STILL_FRESH) > DateTime.UtcNow then - return Fresh someValue - else + let private RetrieveOnline currency = + async { + let coinGeckoJob = QueryCoinGecko currency + let coinCapJob = QueryCoinCap currency + let bothJobs = FSharpUtil.AsyncExtensions.MixedParallel2 coinGeckoJob coinCapJob + let! maybeUsdPriceFromCoinGecko, maybeUsdPriceFromCoinCap = bothJobs + + if maybeUsdPriceFromCoinCap.IsSome && currency = Currency.ETC then + Infrastructure.ReportWarningMessage "Currency ETC can now be queried from CoinCap provider?" + + let result = + match maybeUsdPriceFromCoinGecko, maybeUsdPriceFromCoinCap with + | None, None -> None + | Some usdPriceFromCoinGecko, None -> Some usdPriceFromCoinGecko + | None, Some usdPriceFromCoinCap -> Some usdPriceFromCoinCap + | Some usdPriceFromCoinGecko, Some usdPriceFromCoinCap -> + let average = (usdPriceFromCoinGecko + usdPriceFromCoinCap) / 2m + Some average + + let realResult = + match result with + | Some price -> + let realPrice = + if currency = Currency.SAI then + let ethMultiplied = price * 0.0053m + ethMultiplied + else + price + + Caching.Instance.StoreLastFiatUsdPrice (currency, realPrice) + realPrice |> Some + | None -> None + + return realResult + } + + let UsdValue (currency: Currency): Async> = + async { + let maybeUsdPrice = Caching.Instance.RetrieveLastKnownUsdPrice currency + match maybeUsdPrice with + | NotAvailable -> let! maybeOnlineUsdPrice = RetrieveOnline currency + match maybeOnlineUsdPrice with - | None -> - return NotFresh (Cached(someValue,someDate)) - | Some freshValue -> - return Fresh freshValue - } + | None -> return NotFresh NotAvailable + | Some value -> return Fresh value + | Cached (someValue, someDate) -> + if (someDate + PERIOD_TO_CONSIDER_PRICE_STILL_FRESH) > DateTime.UtcNow then + return Fresh someValue + else + let! maybeOnlineUsdPrice = RetrieveOnline currency + match maybeOnlineUsdPrice with + | None -> return NotFresh (Cached (someValue, someDate)) + | Some freshValue -> return Fresh freshValue + } diff --git a/src/GWallet.Backend/Formatting.fs b/src/GWallet.Backend/Formatting.fs index 179a31022..6058d4f24 100644 --- a/src/GWallet.Backend/Formatting.fs +++ b/src/GWallet.Backend/Formatting.fs @@ -5,7 +5,8 @@ open System open GWallet.Backend.FSharpUtil.UwpHacks type CurrencyType = - Fiat | Crypto + | Fiat + | Crypto module Formatting = @@ -14,16 +15,16 @@ module Formatting = date.ToString "dd-MMM-yyyy" let DecimalAmountRounding currencyType (amount: decimal): string = - let amountOfDecimalsToShow,formattingStrategy = + let amountOfDecimalsToShow, formattingStrategy = match currencyType with | CurrencyType.Fiat -> let twoDecimals = 2 - twoDecimals,SPrintF1 "N%i" twoDecimals + twoDecimals, SPrintF1 "N%i" twoDecimals | CurrencyType.Crypto -> let fiveDecimals = 5 - fiveDecimals,SPrintF1 "#,0.%s" (String('#', fiveDecimals)) + fiveDecimals, SPrintF1 "#,0.%s" (String ('#', fiveDecimals)) - let rounded = Math.Round(amount, amountOfDecimalsToShow) + let rounded = Math.Round (amount, amountOfDecimalsToShow) if rounded = 0m && amount > 0m then let tiny = 1m / decimal (pown 10 amountOfDecimalsToShow) @@ -31,15 +32,16 @@ module Formatting = else rounded.ToString formattingStrategy - let DecimalAmountTruncating (currencyType: CurrencyType) (amount: decimal) (maxAmount: decimal) - : string = + let DecimalAmountTruncating (currencyType: CurrencyType) (amount: decimal) (maxAmount: decimal): string = let amountOfDecimalsToShow = match currencyType with | CurrencyType.Fiat -> 2 | CurrencyType.Crypto -> 5 // https://stackoverflow.com/a/25451689/544947 let truncated = amount - (amount % (1m / decimal (pown 10 amountOfDecimalsToShow))) + if (truncated > maxAmount) then - failwith <| SPrintF2 "how can %s be higher than %s?" (truncated.ToString()) (maxAmount.ToString()) + failwith + <| SPrintF2 "how can %s be higher than %s?" (truncated.ToString ()) (maxAmount.ToString ()) DecimalAmountRounding currencyType truncated diff --git a/src/GWallet.Backend/IBlockchainFeeInfo.fs b/src/GWallet.Backend/IBlockchainFeeInfo.fs index c07ecd74a..c77d19ac4 100644 --- a/src/GWallet.Backend/IBlockchainFeeInfo.fs +++ b/src/GWallet.Backend/IBlockchainFeeInfo.fs @@ -3,7 +3,6 @@ open System type IBlockchainFeeInfo = - abstract member FeeEstimationTime: DateTime with get - abstract member FeeValue: decimal with get - abstract member Currency: Currency with get - + abstract FeeEstimationTime: DateTime + abstract FeeValue: decimal + abstract Currency: Currency diff --git a/src/GWallet.Backend/Infrastructure.fs b/src/GWallet.Backend/Infrastructure.fs index 44aef9166..404ea3871 100644 --- a/src/GWallet.Backend/Infrastructure.fs +++ b/src/GWallet.Backend/Infrastructure.fs @@ -10,8 +10,10 @@ open GWallet.Backend.FSharpUtil.UwpHacks module Infrastructure = - let private sentryUrl = "https://4d1c6170ee37412fab20f8c63a2ade24:fc5e2c50990e48929d190fc283513f87@sentry.io/187797" - let private ravenClient = RavenClient(sentryUrl, Release = VersionHelper.CURRENT_VERSION) + let private sentryUrl = + "https://4d1c6170ee37412fab20f8c63a2ade24:fc5e2c50990e48929d190fc283513f87@sentry.io/187797" + + let private ravenClient = RavenClient (sentryUrl, Release = VersionHelper.CURRENT_VERSION) let private ReportInner (sentryEvent: SentryEvent) = ravenClient.Capture sentryEvent |> ignore @@ -35,30 +37,32 @@ 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 - let sentryEvent = SentryEvent(SentryMessage message, Level = errorLevel) + let sentryEvent = SentryEvent (SentryMessage message, Level = errorLevel) ReportInner sentryEvent #endif 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 @@ -68,7 +72,7 @@ module Infrastructure = #if DEBUG raise ex #else - let ev = SentryEvent(ex, Level = errorLevel) + let ev = SentryEvent (ex, Level = errorLevel) ReportInner ev #endif diff --git a/src/GWallet.Backend/JsonRpcTcpClient.fs b/src/GWallet.Backend/JsonRpcTcpClient.fs index b6e3f5c69..4b209ea44 100644 --- a/src/GWallet.Backend/JsonRpcTcpClient.fs +++ b/src/GWallet.Backend/JsonRpcTcpClient.fs @@ -9,91 +9,103 @@ open GWallet.Backend.FSharpUtil.UwpHacks type ProtocolGlitchException = inherit CommunicationUnsuccessfulException - new (message) = { inherit CommunicationUnsuccessfulException (message) } - new (message: string, innerException: Exception) = { - inherit CommunicationUnsuccessfulException (message, innerException) - } + new(message) = { inherit CommunicationUnsuccessfulException(message) } + + new(message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException(message, innerException) } type ServerCannotBeResolvedException = inherit CommunicationUnsuccessfulException new(message) = { inherit CommunicationUnsuccessfulException(message) } - new(message:string, innerException: Exception) = { inherit CommunicationUnsuccessfulException(message, innerException) } -type ServerNameResolvedToInvalidAddressException(message: string) = - inherit CommunicationUnsuccessfulException (message) + new(message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException(message, innerException) } + +type ServerNameResolvedToInvalidAddressException (message: string) = + inherit CommunicationUnsuccessfulException(message) type JsonRpcTcpClient (host: string, port: uint32) = - let ResolveAsync (hostName: string): Async> = async { - // FIXME: loop over all addresses? - let! hostEntry = Dns.GetHostEntryAsync hostName |> Async.AwaitTask - return hostEntry.AddressList |> Array.tryHead - } + let ResolveAsync (hostName: string): Async> = + async { + // FIXME: loop over all addresses? + let! hostEntry = Dns.GetHostEntryAsync hostName |> Async.AwaitTask + return hostEntry.AddressList |> Array.tryHead + } let exceptionMsg = "JsonRpcSharp faced some problem when trying communication" - let ResolveHost(): Async = async { - try - let! maybeTimedOutipAddress = ResolveAsync host |> FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT - match maybeTimedOutipAddress with - | Some ipAddressOption -> - match ipAddressOption with - | Some ipAddress -> - if ipAddress.ToString().StartsWith("127.0.0.") then - let msg = SPrintF2 "Server '%s' resolved to localhost IP '%s'" host (ipAddress.ToString()) - return raise <| ServerNameResolvedToInvalidAddressException (msg) - else - return ipAddress - | None -> 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)) - | ex -> - match FSharpUtil.FindException ex with - | None -> - return raise <| FSharpUtil.ReRaise ex - | Some socketException -> - if socketException.ErrorCode = int SocketError.HostNotFound || - socketException.ErrorCode = int SocketError.NoData || - socketException.ErrorCode = int SocketError.TryAgain then - return raise <| ServerCannotBeResolvedException(exceptionMsg, ex) - return raise <| UnhandledSocketException(socketException.ErrorCode, ex) - } + let ResolveHost (): Async = + async { + try + let! maybeTimedOutipAddress = ResolveAsync host |> FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT + + match maybeTimedOutipAddress with + | Some ipAddressOption -> + match ipAddressOption with + | Some ipAddress -> + if ipAddress.ToString().StartsWith("127.0.0.") then + let msg = + SPrintF2 "Server '%s' resolved to localhost IP '%s'" host (ipAddress.ToString ()) + + return raise <| ServerNameResolvedToInvalidAddressException (msg) + else + return ipAddress + | None -> + 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)) + | ex -> + match FSharpUtil.FindException ex with + | None -> return raise <| FSharpUtil.ReRaise ex + | Some socketException -> + if socketException.ErrorCode = int SocketError.HostNotFound + || socketException.ErrorCode = int SocketError.NoData + || socketException.ErrorCode = int SocketError.TryAgain then + return raise <| ServerCannotBeResolvedException (exceptionMsg, ex) + + return raise <| UnhandledSocketException (socketException.ErrorCode, ex) + } let rpcTcpClientInnerRequest = - let tcpClient = - JsonRpcSharp.TcpClient.JsonRpcClient(ResolveHost, int port, Config.DEFAULT_NETWORK_CONNECT_TIMEOUT) - fun jsonRequest -> tcpClient.RequestAsync jsonRequest - - member __.Host with get() = host - - member __.Request (request: string): Async = async { - try - let! stringOption = rpcTcpClientInnerRequest request |> FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT - let str = - match stringOption with - | Some s -> s - | None -> raise <| ServerTimedOutException("Timeout when trying to communicate with UtxoCoin server") - return str - with - | :? CommunicationUnsuccessfulException as ex -> - return raise <| FSharpUtil.ReRaise ex - | :? JsonRpcSharp.TcpClient.CommunicationUnsuccessfulException as ex -> - return raise <| CommunicationUnsuccessfulException(ex.Message, ex) - - // FIXME: we should log this one on Sentry as a warning because it's really strange, I bet it's a bug - // on Mono that could maybe go away with higher versions of it (higher versions of Xamarin-Android), see - // git blame to look at the whole stacktrace (ex.ToString()) - | :? NotSupportedException as nse -> - return raise <| ProtocolGlitchException(exceptionMsg, nse) - | ex -> - match Networking.FindExceptionToRethrow ex exceptionMsg with - | None -> - return raise <| FSharpUtil.ReRaise ex - | Some rewrappedSocketException -> - return raise rewrappedSocketException - } + let tcpClient = + JsonRpcSharp.TcpClient.JsonRpcClient (ResolveHost, int port, Config.DEFAULT_NETWORK_CONNECT_TIMEOUT) + + fun jsonRequest -> tcpClient.RequestAsync jsonRequest + + member __.Host = host + + member __.Request (request: string): Async = + async { + try + let! stringOption = + rpcTcpClientInnerRequest request + |> FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT + + let str = + match stringOption with + | Some s -> s + | None -> + raise + <| ServerTimedOutException ("Timeout when trying to communicate with UtxoCoin server") + + return str + with + | :? CommunicationUnsuccessfulException as ex -> return raise <| FSharpUtil.ReRaise ex + | :? JsonRpcSharp.TcpClient.CommunicationUnsuccessfulException as ex -> + return raise <| CommunicationUnsuccessfulException (ex.Message, ex) + + // FIXME: we should log this one on Sentry as a warning because it's really strange, I bet it's a bug + // on Mono that could maybe go away with higher versions of it (higher versions of Xamarin-Android), see + // git blame to look at the whole stacktrace (ex.ToString()) + | :? NotSupportedException as nse -> return raise <| ProtocolGlitchException (exceptionMsg, nse) + | ex -> + match Networking.FindExceptionToRethrow ex exceptionMsg with + | None -> return raise <| FSharpUtil.ReRaise ex + | Some rewrappedSocketException -> return raise rewrappedSocketException + } diff --git a/src/GWallet.Backend/Marshalling.fs b/src/GWallet.Backend/Marshalling.fs index 66186166a..370fb568e 100644 --- a/src/GWallet.Backend/Marshalling.fs +++ b/src/GWallet.Backend/Marshalling.fs @@ -15,15 +15,14 @@ type DeserializationException = new(message: string, innerException: Exception) = { inherit Exception(message, innerException) } new(message: string) = { inherit Exception(message) } -type SerializationException(message:string, innerException: Exception) = - inherit Exception (message, innerException) +type SerializationException (message: string, innerException: Exception) = + inherit Exception(message, innerException) -type VersionMismatchDuringDeserializationException (message:string, innerException: Exception) = - inherit DeserializationException (message, innerException) +type VersionMismatchDuringDeserializationException (message: string, innerException: Exception) = + 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> = { @@ -31,6 +30,7 @@ type MarshallingWrapper<'T> = TypeName: string Value: 'T } + static member New value = { Value = value @@ -38,31 +38,33 @@ type MarshallingWrapper<'T> = TypeName = typeof<'T>.FullName } -type private PascalCase2LowercasePlusUnderscoreContractResolver() = +type private PascalCase2LowercasePlusUnderscoreContractResolver () = inherit DefaultContractResolver() // https://stackoverflow.com/a/20952003/544947 - let pascalToUnderScoreRegex = Regex("((?<=.)[A-Z][a-zA-Z]*)|((?<=[a-zA-Z])\d+)", RegexOptions.Multiline) + let pascalToUnderScoreRegex = Regex ("((?<=.)[A-Z][a-zA-Z]*)|((?<=[a-zA-Z])\d+)", RegexOptions.Multiline) let pascalToUnderScoreReplacementExpression = "_$1$2" + override __.ResolvePropertyName (propertyName: string) = 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) -type RequireAllPropertiesContractResolver() = +type RequireAllPropertiesContractResolver () = inherit DefaultContractResolver() - override __.CreateObjectContract(objectType: Type) = + override __.CreateObjectContract (objectType: Type) = let contract = base.CreateObjectContract objectType contract.ItemRequired <- Nullable Required.Always contract - override __.CreateProperty(memberInfo: MemberInfo, memberSerialization: MemberSerialization) = - let property = base.CreateProperty(memberInfo, memberSerialization) + override __.CreateProperty (memberInfo: MemberInfo, memberSerialization: MemberSerialization) = + let property = base.CreateProperty (memberInfo, memberSerialization) // https://stackoverflow.com/questions/20696262/reflection-to-find-out-if-property-is-of-option-type let isOption = - property.PropertyType.IsGenericType && - property.PropertyType.GetGenericTypeDefinition() = typedefof> + property.PropertyType.IsGenericType + && property.PropertyType.GetGenericTypeDefinition () = typedefof> + if isOption then property.Required <- Required.AllowNull property @@ -77,65 +79,71 @@ module Marshalling = #endif let internal PascalCase2LowercasePlusUnderscoreConversionSettings = - JsonSerializerSettings(ContractResolver = PascalCase2LowercasePlusUnderscoreContractResolver()) + JsonSerializerSettings (ContractResolver = PascalCase2LowercasePlusUnderscoreContractResolver ()) let internal DefaultSettings = - JsonSerializerSettings(MissingMemberHandling = MissingMemberHandling.Error, - ContractResolver = RequireAllPropertiesContractResolver(), - DateTimeZoneHandling = DateTimeZoneHandling.Utc) + JsonSerializerSettings + (MissingMemberHandling = MissingMemberHandling.Error, + ContractResolver = RequireAllPropertiesContractResolver (), + DateTimeZoneHandling = DateTimeZoneHandling.Utc) let private currentVersion = VersionHelper.CURRENT_VERSION - let ExtractType(json: string): Type = + let ExtractType (json: string): Type = let fullTypeName = (JsonConvert.DeserializeObject> json).TypeName - Type.GetType(fullTypeName) + Type.GetType (fullTypeName) - let DeserializeCustom<'T>(json: string, settings: JsonSerializerSettings): 'T = + 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")) + raise (ArgumentNullException ("json")) + if (String.IsNullOrWhiteSpace (json)) then + raise (ArgumentException ("empty or whitespace json", "json")) let deserialized = try - JsonConvert.DeserializeObject>(json, settings) - with - | ex -> + 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 (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 "Incompatible marshalling version found (%s vs. current %s) while trying to deserialize JSON" - version currentVersion - raise <| VersionMismatchDuringDeserializationException(msg, ex) - raise <| DeserializationException(SPrintF1 "Exception when trying to deserialize '%s'" json, ex) - - - if Object.ReferenceEquals(deserialized, null) then - 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) + let msg = + SPrintF2 + "Incompatible marshalling version found (%s vs. current %s) while trying to deserialize JSON" + version + currentVersion + + raise <| VersionMismatchDuringDeserializationException (msg, ex) + raise + <| DeserializationException (SPrintF1 "Exception when trying to deserialize '%s'" json, ex) + + + if Object.ReferenceEquals (deserialized, null) then + 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 = - DeserializeCustom(json, DefaultSettings) + let Deserialize<'T> (json: string): 'T = + DeserializeCustom (json, DefaultSettings) - let private SerializeInternal<'T>(value: 'T) (settings: JsonSerializerSettings): string = - JsonConvert.SerializeObject(MarshallingWrapper<'T>.New value, - DefaultFormatting, - settings) + let private SerializeInternal<'T> (value: 'T) (settings: JsonSerializerSettings): string = + JsonConvert.SerializeObject (MarshallingWrapper<'T>.New value, DefaultFormatting, settings) - let SerializeCustom<'T>(value: 'T, settings: JsonSerializerSettings): string = + let SerializeCustom<'T> (value: 'T, settings: JsonSerializerSettings): string = try SerializeInternal value settings - with - | exn -> - raise (SerializationException(SPrintF2 "Could not serialize object of type '%s' and value '%A'" - (typeof<'T>.FullName) value, exn)) + with exn -> + raise + (SerializationException + (SPrintF2 "Could not serialize object of type '%s' and value '%A'" (typeof<'T>.FullName) value, exn)) - let Serialize<'T>(value: 'T): string = - SerializeCustom(value, DefaultSettings) + let Serialize<'T> (value: 'T): string = + SerializeCustom (value, DefaultSettings) diff --git a/src/GWallet.Backend/Networking.fs b/src/GWallet.Backend/Networking.fs index d83926f3b..3ecc7a47d 100644 --- a/src/GWallet.Backend/Networking.fs +++ b/src/GWallet.Backend/Networking.fs @@ -18,7 +18,7 @@ type internal UnhandledSocketException = new(socketErrorCode: int, innerException: Exception) = { inherit Exception(SPrintF1 "Backend not prepared for this SocketException with ErrorCode[%i]" socketErrorCode, - innerException) } + innerException) } type CommunicationUnsuccessfulException = inherit Exception @@ -27,93 +27,87 @@ type CommunicationUnsuccessfulException = new(message: string) = { inherit Exception(message) } new() = { inherit Exception() } -type ServerDiscardedException(message: string, innerException: CommunicationUnsuccessfulException) = - inherit Exception (message, innerException) +type ServerDiscardedException (message: string, innerException: CommunicationUnsuccessfulException) = + inherit Exception(message, innerException) type BuggyExceptionFromOldMonoVersion (message: string, innerException: Exception) = - inherit CommunicationUnsuccessfulException (message, innerException) + inherit CommunicationUnsuccessfulException(message, innerException) -type ServerClosedConnectionEarlyException(message: string, innerException: Exception) = - inherit CommunicationUnsuccessfulException (message, innerException) +type ServerClosedConnectionEarlyException (message: string, innerException: Exception) = + inherit CommunicationUnsuccessfulException(message, innerException) -type ServerRefusedException(message:string, innerException: Exception) = - inherit CommunicationUnsuccessfulException (message, innerException) +type ServerRefusedException (message: string, innerException: Exception) = + inherit CommunicationUnsuccessfulException(message, innerException) type ServerTimedOutException = inherit CommunicationUnsuccessfulException new(message: string, innerException: Exception) = { inherit CommunicationUnsuccessfulException(message, innerException) } - new(message) = - { inherit CommunicationUnsuccessfulException(message) } + + new(message) = { inherit CommunicationUnsuccessfulException(message) } type ServerUnreachableException = inherit CommunicationUnsuccessfulException new(message: string, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(message, innerException) - } + { inherit CommunicationUnsuccessfulException(message, innerException) } + new(message: string, httpStatusCode: HttpStatusCode, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(SPrintF2 "%s (HttpErr: %s)" message (httpStatusCode.ToString()), - innerException) - } + { inherit CommunicationUnsuccessfulException(SPrintF2 "%s (HttpErr: %s)" message (httpStatusCode.ToString ()), + innerException) } + new(message: string, cloudFlareError: CloudFlareError, innerException: Exception) = - { - inherit CommunicationUnsuccessfulException(SPrintF2 "%s (CfErr: %s)" message (cloudFlareError.ToString()), - innerException) - } + { inherit CommunicationUnsuccessfulException(SPrintF2 "%s (CfErr: %s)" message (cloudFlareError.ToString ()), + innerException) } type ServerMisconfiguredException = inherit CommunicationUnsuccessfulException - new (message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException (message, innerException) } - new (message: string) = - { inherit CommunicationUnsuccessfulException (message) } + new(message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException(message, innerException) } + + new(message: string) = { inherit CommunicationUnsuccessfulException(message) } module Networking = let FindExceptionToRethrow (ex: Exception) (newExceptionMsg): Option = match FSharpUtil.FindException ex with - | None -> - None + | None -> None | Some socketException -> if socketException.ErrorCode = int SocketError.ConnectionRefused then - ServerRefusedException(newExceptionMsg, ex) :> Exception |> Some + ServerRefusedException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.ConnectionReset then - ServerRefusedException(newExceptionMsg, ex) :> Exception |> Some + ServerRefusedException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.TimedOut then - ServerTimedOutException(newExceptionMsg, ex) :> Exception |> Some + ServerTimedOutException (newExceptionMsg, ex) :> Exception |> Some // probably misleading errorCode (see fixed mono bug: https://github.com/mono/mono/pull/8041 ) // TODO: remove this when Mono X.Y (where X.Y=version to introduce this bugfix) is stable // everywhere (probably 8 years from now?), and see if we catch it again in sentry elif socketException.ErrorCode = int SocketError.AddressFamilyNotSupported then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some // -1!?! WTF, mono bug in v6.4.0? see https://sentry.io/organizations/nblockchain/issues/1261821968/ - elif socketException.ErrorCode = int SocketError.SocketError && - socketException.Message.Contains "mono-io-layer-error" then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + elif socketException.ErrorCode = int SocketError.SocketError + && socketException.Message.Contains "mono-io-layer-error" then + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.HostUnreachable then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.NetworkUnreachable then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.AddressNotAvailable then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.NetworkDown then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.Shutdown then - ServerClosedConnectionEarlyException(newExceptionMsg, ex) :> Exception |> Some + ServerClosedConnectionEarlyException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.ProtocolOption then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some elif socketException.ErrorCode = int SocketError.HostNotFound then - ServerUnreachableException(newExceptionMsg, ex) :> Exception |> Some + ServerUnreachableException (newExceptionMsg, ex) :> Exception |> Some else - UnhandledSocketException(socketException.ErrorCode, ex) :> Exception |> Some - + UnhandledSocketException (socketException.ErrorCode, ex) :> Exception |> Some diff --git a/src/GWallet.Backend/Properties/AssemblyInfo.fs b/src/GWallet.Backend/Properties/AssemblyInfo.fs index be7a4e862..6aad0ab41 100644 --- a/src/GWallet.Backend/Properties/AssemblyInfo.fs +++ b/src/GWallet.Backend/Properties/AssemblyInfo.fs @@ -3,22 +3,21 @@ open System.Reflection open System.Runtime.InteropServices -// General Information about an assembly is controlled through the following +// 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 +// 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 - () \ No newline at end of file +do () diff --git a/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs b/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs index 0a37006ce..059059c91 100644 --- a/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs +++ b/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs @@ -1,11 +1,11 @@ - namespace GWallet open System.Reflection -[] -[] -[] +[] +[] +[] + // Version information for an assembly consists of the following four values: // @@ -17,9 +17,7 @@ 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 - () +do () diff --git a/src/GWallet.Backend/Server.fs b/src/GWallet.Backend/Server.fs index 4fa611322..8b629922e 100644 --- a/src/GWallet.Backend/Server.fs +++ b/src/GWallet.Backend/Server.fs @@ -3,8 +3,10 @@ open System type ExceptionInfo = - { TypeFullName: string - Message: string } + { + TypeFullName: string + Message: string + } type FaultInfo = { @@ -17,8 +19,10 @@ type Status = | Success type HistoryInfo = - { TimeSpan: TimeSpan - Status: Status } + { + TimeSpan: TimeSpan + Status: Status + } type Protocol = | Http @@ -31,7 +35,7 @@ type ConnectionType = } type ICommunicationHistory = - abstract member CommunicationHistory: Option with get + abstract CommunicationHistory: Option type HistoryFact = { @@ -51,87 +55,96 @@ type ServerDetails = ServerInfo: ServerInfo CommunicationHistory: Option> } + member private self.EqualsInternal (yObj: obj) = match yObj with - | :? ServerDetails as y -> - self.ServerInfo.Equals y.ServerInfo + | :? ServerDetails as y -> self.ServerInfo.Equals y.ServerInfo | _ -> false + override self.Equals yObj = self.EqualsInternal yObj + override self.GetHashCode () = - self.ServerInfo.GetHashCode() + self.ServerInfo.GetHashCode () + interface ICommunicationHistory with - member self.CommunicationHistory - with get() = - match self.CommunicationHistory with - | None -> None - | Some (h,_) -> Some h + member self.CommunicationHistory = + match self.CommunicationHistory with + | None -> None + | Some (h, _) -> Some h -type ServerRanking = Map> +type ServerRanking = Map> 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 - | (currency, servers)::tail -> + | (currency, servers) :: tail -> match Seq.tryFind serverPredicate servers with | None -> tryFind tail server | Some foundServer -> Some (currency, foundServer) + let listMap = Map.toList map tryFind listMap serverPredicate let internal RemoveDupes (servers: seq) = - let rec removeDupesInternal (servers: seq) (serversMap: Map) = + let rec removeDupesInternal (servers: seq) (serversMap: Map) = match Seq.tryHead servers with | None -> Seq.empty | Some server -> let tail = Seq.tail servers match serversMap.TryGetValue server.ServerInfo.NetworkPath with - | false,_ -> - removeDupesInternal tail serversMap - | true,serverInMap -> + | false, _ -> removeDupesInternal tail serversMap + | true, serverInMap -> let serverToAppend = - match server.CommunicationHistory,serverInMap.CommunicationHistory with - | None,_ -> serverInMap - | _,None -> server - | Some (_, lastComm),Some (_, lastCommInMap) -> + match server.CommunicationHistory, serverInMap.CommunicationHistory with + | None, _ -> serverInMap + | _, None -> server + | Some (_, lastComm), Some (_, lastCommInMap) -> if lastComm > lastCommInMap then server else serverInMap + let newMap = serversMap.Remove serverToAppend.ServerInfo.NetworkPath Seq.append (seq { yield serverToAppend }) (removeDupesInternal tail newMap) let initialServersMap = servers - |> Seq.map (fun server -> server.ServerInfo.NetworkPath, server) - |> Map.ofSeq + |> Seq.map (fun server -> server.ServerInfo.NetworkPath, server) + |> Map.ofSeq + removeDupesInternal servers initialServersMap - let internal RemoveBlackListed (cs: Currency*seq): seq = + let internal RemoveBlackListed (cs: Currency * seq): seq = let isBlackListed currency server = // as these servers can only serve very limited set of queries (e.g. only balance?) their stats are skewed and // they create exception when being queried for advanced ones (e.g. latest block) - server.ServerInfo.NetworkPath.Contains "blockscout" || + server.ServerInfo.NetworkPath.Contains "blockscout" // there was a mistake when adding this server to geewallet's JSON: it was added in the ETC currency instead of ETH - (currency = Currency.ETC && server.ServerInfo.NetworkPath.Contains "ethrpc.mewapi.io") + || (currency = Currency.ETC + && server.ServerInfo.NetworkPath.Contains "ethrpc.mewapi.io") - let currency,servers = cs + let currency, servers = cs Seq.filter (fun server -> not (isBlackListed currency server)) servers - let RemoveCruft (cs: Currency*seq): seq = + let RemoveCruft (cs: Currency * seq): seq = cs |> RemoveBlackListed |> RemoveDupes let internal Sort (servers: seq): seq = let sort server = let invertOrder (timeSpan: TimeSpan): int = 0 - int timeSpan.TotalMilliseconds + match server.CommunicationHistory with | None -> None | Some (history, lastComm) -> @@ -147,25 +160,27 @@ module ServerRegistry = Seq.sortByDescending sort servers - let Serialize(servers: ServerRanking): string = + let Serialize (servers: ServerRanking): string = let rearrangedServers = servers |> Map.toSeq - |> Seq.map (fun (currency, servers) -> currency, ((currency,servers) |> RemoveCruft |> Sort)) + |> Seq.map (fun (currency, servers) -> currency, ((currency, servers) |> RemoveCruft |> Sort)) |> Map.ofSeq + Marshalling.Serialize rearrangedServers - let Deserialize(json: string): ServerRanking = + let Deserialize (json: string): ServerRanking = Marshalling.Deserialize json let Merge (ranking1: ServerRanking) (ranking2: ServerRanking): ServerRanking = let allKeys = seq { - for KeyValue(key, _) in ranking1 do + for KeyValue (key, _) in ranking1 do yield key - for KeyValue(key, _) in ranking2 do + for KeyValue (key, _) in ranking2 do yield key - } |> Set.ofSeq + } + |> Set.ofSeq seq { for currency in allKeys do @@ -173,17 +188,17 @@ module ServerRegistry = match ranking1.TryFind currency with | None -> Seq.empty | Some servers -> servers + let allServersFrom2 = match ranking2.TryFind currency with | None -> Seq.empty - | Some servers -> - servers - let allServers = (currency, Seq.append allServersFrom1 allServersFrom2) - |> RemoveCruft - |> Sort + | Some servers -> servers + + let allServers = (currency, Seq.append allServersFrom1 allServersFrom2) |> RemoveCruft |> Sort yield currency, allServers - } |> Map.ofSeq + } + |> Map.ofSeq let private ServersRankingBaseline = Deserialize (Config.ExtractEmbeddedResourceFileContents ServersEmbeddedResourceFileName) @@ -192,13 +207,16 @@ module ServerRegistry = Merge ranking ServersRankingBaseline [] -type Server<'K,'R when 'K: equality and 'K :> ICommunicationHistory> = - { Details: 'K - Retrieval: Async<'R> } +type Server<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = + { + Details: 'K + Retrieval: Async<'R> + } + override self.Equals yObj = match yObj with - | :? Server<'K,'R> as y -> - self.Details.Equals y.Details + | :? Server<'K, 'R> as y -> self.Details.Equals y.Details | _ -> false + override self.GetHashCode () = - self.Details.GetHashCode() + self.Details.GetHashCode () diff --git a/src/GWallet.Backend/ServerManager.fs b/src/GWallet.Backend/ServerManager.fs index a132da498..a71fdccc9 100644 --- a/src/GWallet.Backend/ServerManager.fs +++ b/src/GWallet.Backend/ServerManager.fs @@ -10,8 +10,10 @@ module ServerManager = let UpdateServersFile () = Infrastructure.LogInfo "INPUT:" - let baseLineServers = Config.ExtractEmbeddedResourceFileContents ServerRegistry.ServersEmbeddedResourceFileName - |> ServerRegistry.Deserialize + + let baseLineServers = + Config.ExtractEmbeddedResourceFileContents ServerRegistry.ServersEmbeddedResourceFileName + |> ServerRegistry.Deserialize let fromElectrumServerToGenericServerDetails (es: UtxoCoin.ElectrumServer) = match es.UnencryptedPort with @@ -21,7 +23,11 @@ module ServerManager = ServerInfo = { NetworkPath = es.Fqdn - ConnectionType = { Encrypted = false; Protocol = Tcp unencryptedPort } + ConnectionType = + { + Encrypted = false + Protocol = Tcp unencryptedPort + } } CommunicationHistory = None } @@ -32,14 +38,13 @@ module ServerManager = let baseLineBtcServers = match baseLineServers.TryGetValue btc with - | true,baseLineBtcServers -> - baseLineBtcServers - | false,_ -> - failwith <| SPrintF1 "There should be some %A servers as baseline" btc + | true, baseLineBtcServers -> baseLineBtcServers + | false, _ -> failwith <| SPrintF1 "There should be some %A servers as baseline" btc - let allBtcServers = Seq.append electrumBtcServers eyeBtcServers - |> Seq.map fromElectrumServerToGenericServerDetails - |> Seq.append baseLineBtcServers + let allBtcServers = + Seq.append electrumBtcServers eyeBtcServers + |> Seq.map fromElectrumServerToGenericServerDetails + |> Seq.append baseLineBtcServers let ltc = Currency.LTC let electrumLtcServers = UtxoCoin.ElectrumServerSeedList.ExtractServerListFromElectrumRepository ltc @@ -47,42 +52,41 @@ module ServerManager = let baseLineLtcServers = match baseLineServers.TryGetValue ltc with - | true,baseLineLtcServers -> - baseLineLtcServers - | false,_ -> - failwith <| SPrintF1 "There should be some %A servers as baseline" ltc + | true, baseLineLtcServers -> baseLineLtcServers + | false, _ -> failwith <| SPrintF1 "There should be some %A servers as baseline" ltc - let allLtcServers = Seq.append electrumLtcServers eyeLtcServers - |> Seq.map fromElectrumServerToGenericServerDetails - |> Seq.append baseLineLtcServers + let allLtcServers = + Seq.append electrumLtcServers eyeLtcServers + |> Seq.map fromElectrumServerToGenericServerDetails + |> Seq.append baseLineLtcServers - for KeyValue(currency,servers) in baseLineServers do - Infrastructure.LogInfo (SPrintF2 "%i %A servers from baseline JSON file" (servers.Count()) currency) + for KeyValue (currency, servers) in baseLineServers do + Infrastructure.LogInfo (SPrintF2 "%i %A servers from baseline JSON file" (servers.Count ()) currency) match currency with | Currency.BTC -> - Infrastructure.LogInfo (SPrintF1 "%i BTC servers from electrum repository" (electrumBtcServers.Count())) - Infrastructure.LogInfo (SPrintF1 "%i BTC servers from bitcoin-eye" (eyeBtcServers.Count())) + 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())) - | _ -> - () + 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) + 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) + for KeyValue (currency, servers) in filteredOutServers do + Infrastructure.LogInfo (SPrintF2 "%i %A servers total" (servers.Count ()) currency) let private tester = - FaultTolerantParallelClient + FaultTolerantParallelClient Caching.Instance.SaveServerLastStat let private testingSettings = @@ -101,7 +105,7 @@ module ServerManager = let private GetDummyBalanceAction (currency: Currency) servers = let retrievalFuncs = - if (currency.IsUtxo()) then + if (currency.IsUtxo ()) then let scriptHash = match currency with | Currency.BTC -> @@ -113,16 +117,17 @@ module ServerManager = // https://medium.com/@SatoshiLite/satoshilite-1e2dad89a017 let LTC_GENESIS_BLOCK_ADDRESS = "Ler4HNAEfwYhBmGXcFP2Po1NpRUEiK8km2" UtxoCoin.Account.GetElectrumScriptHashFromPublicAddress currency LTC_GENESIS_BLOCK_ADDRESS - | _ -> - failwith <| SPrintF1 "Currency %A not UTXO?" currency + | _ -> failwith <| SPrintF1 "Currency %A not UTXO?" currency + let utxoFunc electrumServer = async { let! bal = UtxoCoin.ElectrumClient.GetBalance scriptHash electrumServer return bal.Confirmed |> decimal } + UtxoCoin.Server.GetServerFuncs utxoFunc servers |> Some - elif currency.IsEther() then + elif currency.IsEther () then let ETH_GENESISBLOCK_ADDRESS = "0x0000000000000000000000000000000000000000" let web3Func (web3: Ether.SomeWeb3): Async = @@ -140,36 +145,31 @@ module ServerManager = | Some queryFuncs -> async { try - let! _ = tester.Query testingSettings - (queryFuncs |> List.ofSeq) + let! _ = tester.Query testingSettings (queryFuncs |> List.ofSeq) return () - with - | :? NoneAvailableException -> - return () - } |> Some - | _ -> - None + with :? NoneAvailableException -> return () + } + |> Some + | _ -> None - let private UpdateBaseline() = - match Caching.Instance.ExportServers() with + let private UpdateBaseline () = + match Caching.Instance.ExportServers () with | None -> failwith "After updating servers, cache should not be empty" - | Some serversInJson -> - File.WriteAllText(ServerRegistry.ServersEmbeddedResourceFileName, serversInJson) + | Some serversInJson -> File.WriteAllText (ServerRegistry.ServersEmbeddedResourceFileName, serversInJson) let UpdateServersStats () = - let jobs = seq { - for currency in Currency.GetAll() do - - // 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 - } - Async.Parallel jobs - |> Async.RunSynchronously - |> ignore + let jobs = + seq { + for currency in Currency.GetAll () do + + // 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 + } - UpdateBaseline() + Async.Parallel jobs |> Async.RunSynchronously |> ignore + UpdateBaseline () diff --git a/src/GWallet.Backend/Shuffler.fs b/src/GWallet.Backend/Shuffler.fs index d64afd2be..a37051f46 100644 --- a/src/GWallet.Backend/Shuffler.fs +++ b/src/GWallet.Backend/Shuffler.fs @@ -4,28 +4,28 @@ type UnsafeRandom = System.Random module Shuffler = - let private random = UnsafeRandom() + let private random = UnsafeRandom () let Unsort aSeq = - aSeq |> Seq.sortBy (fun _ -> random.Next()) + aSeq |> Seq.sortBy (fun _ -> random.Next ()) - let private ListRemove<'T when 'T: equality> (list: List<'T>) (elementToRemove: 'T) = + let private ListRemove<'T when 'T: equality> (list: List<'T>) (elementToRemove: 'T) = List.filter (fun element -> element <> elementToRemove) list let RandomizeEveryNthElement<'T when 'T: equality> (list: List<'T>) (offset: uint32) = let rec RandomizeInternal (list: List<'T>) (offset: uint32) acc (currentIndex: uint32) = match list with | [] -> List.rev acc - | head::tail -> + | head :: tail -> let nextIndex = (currentIndex + 1u) if currentIndex % offset <> 0u || tail = [] then - RandomizeInternal tail offset (head::acc) nextIndex + RandomizeInternal tail offset (head :: acc) nextIndex else let randomizedRest = Unsort tail |> List.ofSeq match randomizedRest with | [] -> failwith "should have fallen under previous 'if' case" - | randomizedHead::_ -> - let newRest = head::(ListRemove tail randomizedHead) - RandomizeInternal newRest offset (randomizedHead::acc) nextIndex + | randomizedHead :: _ -> + let newRest = head :: (ListRemove tail randomizedHead) + RandomizeInternal newRest offset (randomizedHead :: acc) nextIndex RandomizeInternal list offset [] 1u diff --git a/src/GWallet.Backend/Transaction.fs b/src/GWallet.Backend/Transaction.fs index 3c07def77..d8b6fd5dc 100644 --- a/src/GWallet.Backend/Transaction.fs +++ b/src/GWallet.Backend/Transaction.fs @@ -2,33 +2,35 @@ type UnsignedTransactionProposal = { - OriginAddress: string; - Amount: TransferAmount; - DestinationAddress: string; + OriginAddress: string + Amount: TransferAmount + DestinationAddress: string } // NOTE: I wanted to mark this type below `internal`, however that breaks JSON serialization // in two possible ways: 1. silently (just returning {}), 2. with an exception -type UnsignedTransaction<'T when 'T:> IBlockchainFeeInfo> = +type UnsignedTransaction<'T when 'T :> IBlockchainFeeInfo> = { - Proposal: UnsignedTransactionProposal; - Metadata: 'T; - Cache: DietCache; + Proposal: UnsignedTransactionProposal + Metadata: 'T + Cache: DietCache } - member self.ToAbstract(): UnsignedTransaction = + + member self.ToAbstract (): UnsignedTransaction = { - Metadata = self.Metadata :> IBlockchainFeeInfo; - Cache = self.Cache; - Proposal = self.Proposal; + Metadata = self.Metadata :> IBlockchainFeeInfo + Cache = self.Cache + Proposal = self.Proposal } -type SignedTransaction<'T when 'T:> IBlockchainFeeInfo> = +type SignedTransaction<'T when 'T :> IBlockchainFeeInfo> = { - TransactionInfo: UnsignedTransaction<'T>; - RawTransaction: string; + TransactionInfo: UnsignedTransaction<'T> + RawTransaction: string } - member self.ToAbstract(): SignedTransaction = + + member self.ToAbstract (): SignedTransaction = { - TransactionInfo = self.TransactionInfo.ToAbstract(); - RawTransaction = self.RawTransaction; + TransactionInfo = self.TransactionInfo.ToAbstract () + RawTransaction = self.RawTransaction } diff --git a/src/GWallet.Backend/TransferAmount.fs b/src/GWallet.Backend/TransferAmount.fs index 6639e131e..17c749e97 100644 --- a/src/GWallet.Backend/TransferAmount.fs +++ b/src/GWallet.Backend/TransferAmount.fs @@ -2,19 +2,15 @@ open System -type TransferAmount(valueToSend: decimal, balanceAtTheMomentOfSending: decimal, currency: Currency) = +type TransferAmount (valueToSend: decimal, balanceAtTheMomentOfSending: decimal, currency: Currency) = do if valueToSend <= 0m then invalidArg "valueToSend" "Amount has to be above zero" if balanceAtTheMomentOfSending < valueToSend then invalidArg "balanceAtTheMomentOfSending" "balance has to be equal or higher than valueToSend" - member __.ValueToSend - with get() = Math.Round(valueToSend, currency.DecimalPlaces()) + member __.ValueToSend = Math.Round (valueToSend, currency.DecimalPlaces ()) - member __.BalanceAtTheMomentOfSending - with get() = balanceAtTheMomentOfSending - - member __.Currency - with get() = currency + member __.BalanceAtTheMomentOfSending = balanceAtTheMomentOfSending + member __.Currency = currency diff --git a/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs b/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs index bfecda1cc..381d5573e 100644 --- a/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs +++ b/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs @@ -27,20 +27,28 @@ module ElectrumClient = let! versionSupportedByServer = try stratumClient.ServerVersion CLIENT_NAME_SENT_TO_STRATUM_SERVER_WHEN_HELLO PROTOCOL_VERSION_SUPPORTED - with - | :? ElectrumServerReturningErrorException as ex -> - if (ex.ErrorCode = 1 && ex.Message.StartsWith "unsupported protocol version" && - ex.Message.EndsWith (PROTOCOL_VERSION_SUPPORTED.ToString())) then + with :? ElectrumServerReturningErrorException as ex -> + if (ex.ErrorCode = 1 + && ex.Message.StartsWith "unsupported protocol version" + && ex.Message.EndsWith (PROTOCOL_VERSION_SUPPORTED.ToString ())) then // FIXME: even if this ex is already handled to ignore the server, we should report to sentry as WARN - raise <| ServerTooNewException(SPrintF1 "Version of server rejects our client version (%s)" - (PROTOCOL_VERSION_SUPPORTED.ToString())) + raise + <| ServerTooNewException + (SPrintF1 + "Version of server rejects our client version (%s)" + (PROTOCOL_VERSION_SUPPORTED.ToString ())) else - reraise() + reraise () + if versionSupportedByServer < PROTOCOL_VERSION_SUPPORTED then - raise (ServerTooOldException (SPrintF2 "Version of server is older (%s) than the client (%s)" - (versionSupportedByServer.ToString()) - (PROTOCOL_VERSION_SUPPORTED.ToString()))) + raise + (ServerTooOldException + (SPrintF2 + "Version of server is older (%s) than the client (%s)" + (versionSupportedByServer.ToString ()) + (PROTOCOL_VERSION_SUPPORTED.ToString ()))) + return stratumClient } @@ -48,55 +56,63 @@ module ElectrumClient = 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 - - let GetBalance (scriptHash: string) (stratumServer: Async) = async { - // FIXME: we should rather implement this method in terms of: - // - querying all unspent transaction outputs (X) -> block heights included - // - querying transaction history (Y) -> block heights included - // - check the difference between X and Y (e.g. Y - X = Z) - // - query details of each element in Z to see their block heights - // - query the current blockheight (H) -> pick the highest among all servers queried - // -> having H, we now know which elements of X, Y, and Z are confirmed or not - // Doing it this way has two advantages: - // 1) We can configure GWallet with a number of confirmations to consider some balance confirmed (instead - // of trusting what "confirmed" means from the point of view of the Electrum Server) - // 2) and most importantly: we could verify each of the transactions supplied in X, Y, Z to verify their - // integrity (in a similar fashion as Electrum Wallet client already does), to not have to trust servers* - // [ see https://www.youtube.com/watch?v=hjYCXOyDy7Y&feature=youtu.be&t=1171 for more information ] - // * -> although that would be fixing only half of the problem, we also need proof of completeness - let! stratumClient = stratumServer - let! balanceResult = stratumClient.BlockchainScriptHashGetBalance scriptHash - return balanceResult.Result - } - - let GetUnspentTransactionOutputs scriptHash (stratumServer: Async) = async { - let! stratumClient = stratumServer - let! unspentListResult = stratumClient.BlockchainScriptHashListUnspent scriptHash - return unspentListResult.Result - } - - let GetBlockchainTransaction txHash (stratumServer: Async) = async { - let! stratumClient = stratumServer - let! blockchainTransactionResult = stratumClient.BlockchainTransactionGet txHash - return blockchainTransactionResult.Result - } - - let EstimateFee (numBlocksTarget: int) (stratumServer: Async): Async = async { - let! stratumClient = stratumServer - let! estimateFeeResult = stratumClient.BlockchainEstimateFee numBlocksTarget - if estimateFeeResult.Result = -1m then - 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 estimateFeeResult.Result - } - - let BroadcastTransaction (transactionInHex: string) (stratumServer: Async) = async { - let! stratumClient = stratumServer - let! blockchainTransactionBroadcastResult = stratumClient.BlockchainTransactionBroadcast transactionInHex - return blockchainTransactionBroadcastResult.Result - } + | { Encrypted = false; Protocol = Tcp port } -> Init electrumServer.ServerInfo.NetworkPath port + + let GetBalance (scriptHash: string) (stratumServer: Async) = + async { + // FIXME: we should rather implement this method in terms of: + // - querying all unspent transaction outputs (X) -> block heights included + // - querying transaction history (Y) -> block heights included + // - check the difference between X and Y (e.g. Y - X = Z) + // - query details of each element in Z to see their block heights + // - query the current blockheight (H) -> pick the highest among all servers queried + // -> having H, we now know which elements of X, Y, and Z are confirmed or not + // Doing it this way has two advantages: + // 1) We can configure GWallet with a number of confirmations to consider some balance confirmed (instead + // of trusting what "confirmed" means from the point of view of the Electrum Server) + // 2) and most importantly: we could verify each of the transactions supplied in X, Y, Z to verify their + // integrity (in a similar fashion as Electrum Wallet client already does), to not have to trust servers* + // [ see https://www.youtube.com/watch?v=hjYCXOyDy7Y&feature=youtu.be&t=1171 for more information ] + // * -> although that would be fixing only half of the problem, we also need proof of completeness + let! stratumClient = stratumServer + let! balanceResult = stratumClient.BlockchainScriptHashGetBalance scriptHash + return balanceResult.Result + } + let GetUnspentTransactionOutputs scriptHash (stratumServer: Async) = + async { + let! stratumClient = stratumServer + let! unspentListResult = stratumClient.BlockchainScriptHashListUnspent scriptHash + return unspentListResult.Result + } + + let GetBlockchainTransaction txHash (stratumServer: Async) = + async { + let! stratumClient = stratumServer + let! blockchainTransactionResult = stratumClient.BlockchainTransactionGet txHash + return blockchainTransactionResult.Result + } + + let EstimateFee (numBlocksTarget: int) (stratumServer: Async): Async = + async { + let! stratumClient = stratumServer + let! estimateFeeResult = stratumClient.BlockchainEstimateFee numBlocksTarget + + if estimateFeeResult.Result = -1m then + 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 estimateFeeResult.Result + } + + let BroadcastTransaction (transactionInHex: string) (stratumServer: Async) = + async { + let! stratumClient = stratumServer + let! blockchainTransactionBroadcastResult = stratumClient.BlockchainTransactionBroadcast transactionInHex + return blockchainTransactionBroadcastResult.Result + } diff --git a/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs b/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs index ec2b3c102..4906ef131 100644 --- a/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs +++ b/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs @@ -10,47 +10,47 @@ open HtmlAgilityPack open GWallet.Backend open GWallet.Backend.FSharpUtil.UwpHacks -type IncompatibleServerException(message) = +type IncompatibleServerException (message) = inherit CommunicationUnsuccessfulException(message) -type IncompatibleProtocolException(message) = +type IncompatibleProtocolException (message) = inherit IncompatibleServerException(message) -type ServerTooNewException(message) = +type ServerTooNewException (message) = inherit IncompatibleProtocolException(message) -type ServerTooOldException(message) = +type ServerTooOldException (message) = inherit IncompatibleProtocolException(message) -type TlsNotSupportedYetInGWalletException(message) = +type TlsNotSupportedYetInGWalletException (message) = inherit IncompatibleServerException(message) -type TorNotSupportedYetInGWalletException(message) = +type TorNotSupportedYetInGWalletException (message) = inherit IncompatibleServerException(message) type ElectrumServer = { - Fqdn: string; + Fqdn: string PrivatePort: Option UnencryptedPort: Option } + member self.CheckCompatibility (): unit = if self.UnencryptedPort.IsNone then - raise(TlsNotSupportedYetInGWalletException("TLS not yet supported")) + raise (TlsNotSupportedYetInGWalletException ("TLS not yet supported")) if self.Fqdn.EndsWith ".onion" then - raise(TorNotSupportedYetInGWalletException("Tor(onion) not yet supported")) + raise (TorNotSupportedYetInGWalletException ("Tor(onion) not yet supported")) module ElectrumServerSeedList = let private FilterCompatibleServer (electrumServer: ElectrumServer) = try - electrumServer.CheckCompatibility() + electrumServer.CheckCompatibility () true - with - | :? IncompatibleServerException -> false + with :? IncompatibleServerException -> false let ExtractServerListFromWebPage (currency: Currency): seq = - if not (currency.IsUtxo()) then + if not (currency.IsUtxo ()) then failwith "This method is only compatible with UTXO currencies" let currencyMnemonic = @@ -60,13 +60,13 @@ module ElectrumServerSeedList = | _ -> failwith <| SPrintF1 "UTXO currency unknown to this algorithm: %A" currency let url = SPrintF1 "https://1209k.com/bitcoin-eye/ele.php?chain=%s" currencyMnemonic - let web = HtmlWeb() + let web = HtmlWeb () let doc = web.Load url 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 + for i in 0 .. (servers.Count - 1) do let server = servers.[i] let serverProperties = server.SelectNodes "td" @@ -75,11 +75,13 @@ module ElectrumServerSeedList = let fqdn = serverProperties.[0].InnerText if serverProperties.Count < 2 then - failwith <| SPrintF2 "Unexpected property count in server %s: %i" fqdn serverProperties.Count + 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 + failwith + <| SPrintF3 "Unexpected property count in server %s:%i: %i" fqdn port serverProperties.Count let portType = serverProperties.[2].InnerText let encrypted = @@ -87,49 +89,58 @@ module ElectrumServerSeedList = | "ssl" -> true | "tcp" -> false | _ -> failwith <| SPrintF1 "Got new unexpected port type: %s" portType + let privatePort = if encrypted then Some port else None + let unencryptedPort = if encrypted then None else Some port - yield - { - Fqdn = fqdn - PrivatePort = privatePort - UnencryptedPort = unencryptedPort - } - } |> Seq.filter FilterCompatibleServer + yield { + Fqdn = fqdn + PrivatePort = privatePort + UnencryptedPort = unencryptedPort + } + } + |> Seq.filter FilterCompatibleServer let private ExtractServerListFromElectrumJsonFile jsonContents = let serversParsed = JsonValue.Parse jsonContents + let servers = seq { - for (key,value) in serversParsed.Properties do + for (key, value) in serversParsed.Properties do let maybeUnencryptedPort = value.TryGetProperty "t" + let unencryptedPort = match maybeUnencryptedPort with | None -> None - | Some portAsString -> Some (UInt32.Parse (portAsString.AsString())) + | Some portAsString -> Some (UInt32.Parse (portAsString.AsString ())) + let maybeEncryptedPort = value.TryGetProperty "s" + let encryptedPort = match maybeEncryptedPort with | None -> None - | Some portAsString -> Some (UInt32.Parse (portAsString.AsString())) - yield { Fqdn = key; - PrivatePort = encryptedPort; - UnencryptedPort = unencryptedPort; + | Some portAsString -> Some (UInt32.Parse (portAsString.AsString ())) + + yield { + Fqdn = key + PrivatePort = encryptedPort + UnencryptedPort = unencryptedPort } } + servers |> List.ofSeq let ExtractServerListFromElectrumRepository (currency: Currency) = - if not (currency.IsUtxo()) then + if not (currency.IsUtxo ()) then failwith "This method is only compatible with UTXO currencies" let urlToElectrumJsonFile = @@ -141,15 +152,11 @@ module ElectrumServerSeedList = use webClient = new WebClient() let serverListInJson = webClient.DownloadString urlToElectrumJsonFile ExtractServerListFromElectrumJsonFile serverListInJson - |> Seq.filter FilterCompatibleServer + |> Seq.filter FilterCompatibleServer - let DefaultBtcList = - Caching.Instance.GetServers Currency.BTC - |> List.ofSeq + let DefaultBtcList = Caching.Instance.GetServers Currency.BTC |> List.ofSeq - let DefaultLtcList = - Caching.Instance.GetServers Currency.LTC - |> List.ofSeq + let DefaultLtcList = Caching.Instance.GetServers Currency.LTC |> List.ofSeq let Randomize currency = let serverList = @@ -157,4 +164,5 @@ module ElectrumServerSeedList = | BTC -> DefaultBtcList | LTC -> DefaultLtcList | _ -> failwith <| SPrintF1 "Currency %A is not UTXO" currency + Shuffler.Unsort serverList diff --git a/src/GWallet.Backend/UtxoCoin/StratumClient.fs b/src/GWallet.Backend/UtxoCoin/StratumClient.fs index dc94b1d6e..e15c85e5c 100644 --- a/src/GWallet.Backend/UtxoCoin/StratumClient.fs +++ b/src/GWallet.Backend/UtxoCoin/StratumClient.fs @@ -10,69 +10,71 @@ open GWallet.Backend.FSharpUtil.UwpHacks // can't make this type below private, or else Newtonsoft.Json will serialize it incorrectly type Request = { - Id: int; - Method: string; - Params: seq; + Id: int + Method: string + Params: seq } type ServerVersionResult = { - Id: int; - Result: array; + Id: int + Result: array } type BlockchainScriptHashGetBalanceInnerResult = { - Confirmed: Int64; - Unconfirmed: Int64; + Confirmed: Int64 + Unconfirmed: Int64 } + type BlockchainScriptHashGetBalanceResult = { - Id: int; + Id: int Result: BlockchainScriptHashGetBalanceInnerResult } type BlockchainScriptHashListUnspentInnerResult = { - TxHash: string; - TxPos: int; - Value: Int64; - Height: Int64; + TxHash: string + TxPos: int + Value: Int64 + Height: Int64 } + type BlockchainScriptHashListUnspentResult = { - Id: int; + Id: int Result: array } type BlockchainTransactionGetResult = { - Id: int; - Result: string; + Id: int + Result: string } type BlockchainEstimateFeeResult = { - Id: int; - Result: decimal; + Id: int + Result: decimal } type BlockchainTransactionBroadcastResult = { - Id: int; - Result: string; + Id: int + Result: string } type ErrorInnerResult = { - Message: string; - Code: int; + Message: string + Code: int } type ErrorResult = { - Id: int; - Error: ErrorInnerResult; + Id: int + Error: ErrorInnerResult } type RpcErrorCode = @@ -88,179 +90,219 @@ type RpcErrorCode = // see https://gitlab.gnome.org/World/geewallet/issues/112 | UnknownMethod = -32601 -type public ElectrumServerReturningErrorInJsonResponseException(message: string, code: int) = +type public ElectrumServerReturningErrorInJsonResponseException (message: string, code: int) = inherit CommunicationUnsuccessfulException(message) - member val ErrorCode: int = - code with get + member val ErrorCode: int = code -type public ElectrumServerReturningErrorException(message: string, code: int, - originalRequest: string, originalResponse: string) = +type public ElectrumServerReturningErrorException (message: string, + code: int, + originalRequest: string, + originalResponse: string) = inherit ElectrumServerReturningErrorInJsonResponseException(message, code) - member val OriginalRequest: string = - originalRequest with get + member val OriginalRequest: string = originalRequest - member val OriginalResponse: string = - originalResponse with get + member val OriginalResponse: string = originalResponse -type public ElectrumServerReturningInternalErrorException(message: string, code: int, - originalRequest: string, originalResponse: string) = +type public ElectrumServerReturningInternalErrorException (message: string, + code: int, + originalRequest: string, + originalResponse: string) = inherit ElectrumServerReturningErrorException(message, code, originalRequest, originalResponse) type StratumClient (jsonRpcClient: JsonRpcTcpClient) = - let Serialize(req: Request): string = - JsonConvert.SerializeObject(req, Formatting.None, - Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) + let Serialize (req: Request): string = + JsonConvert.SerializeObject + (req, Formatting.None, Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) // TODO: add 'T as incoming request type, leave 'R as outgoing response type - member private self.Request<'R> (jsonRequest: string): Async<'R*string> = async { - let! rawResponse = jsonRpcClient.Request jsonRequest + member private self.Request<'R> (jsonRequest: string): Async<'R * string> = + async { + let! rawResponse = jsonRpcClient.Request jsonRequest - // 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) + // 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) - 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)) - 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)) - } + 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)) + 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)) + } static member public Deserialize<'T> (result: string): 'T = - let resultTrimmed = result.Trim() + let resultTrimmed = result.Trim () + let maybeError = try - JsonConvert.DeserializeObject(resultTrimmed, - Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) - with - | ex -> raise <| Exception(SPrintF2 "Failed deserializing JSON response (to check for error) '%s' to type '%s'" - resultTrimmed typedefof<'T>.FullName, ex) - - if (not (Object.ReferenceEquals(maybeError, null))) && (not (Object.ReferenceEquals(maybeError.Error, null))) then - raise(ElectrumServerReturningErrorInJsonResponseException(maybeError.Error.Message, maybeError.Error.Code)) + JsonConvert.DeserializeObject + (resultTrimmed, Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) + with ex -> + raise + <| Exception + (SPrintF2 + "Failed deserializing JSON response (to check for error) '%s' to type '%s'" + resultTrimmed + typedefof<'T>.FullName, + ex) + + if (not (Object.ReferenceEquals (maybeError, null))) + && (not (Object.ReferenceEquals (maybeError.Error, null))) then + raise + (ElectrumServerReturningErrorInJsonResponseException (maybeError.Error.Message, maybeError.Error.Code)) let deserializedValue = try - JsonConvert.DeserializeObject<'T>(resultTrimmed, - Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) - with - | ex -> raise <| Exception(SPrintF2 "Failed deserializing JSON response '%s' to type '%s'" - 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 + JsonConvert.DeserializeObject<'T> + (resultTrimmed, Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) + with ex -> + raise + <| Exception + (SPrintF2 + "Failed deserializing JSON response '%s' to type '%s'" + 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 deserializedValue member self.BlockchainScriptHashGetBalance address: Async = - let obj = { - Id = 0; - Method = "blockchain.scripthash.get_balance"; - Params = [address] - } + let obj = + { + Id = 0 + Method = "blockchain.scripthash.get_balance" + Params = [ address ] + } + let json = Serialize obj async { - let! resObj,_ = self.Request json + let! resObj, _ = self.Request json return resObj } - static member private CreateVersion(versionStr: string): Version = + static member private CreateVersion (versionStr: string): Version = let correctedVersion = - if (versionStr.EndsWith("+")) then - versionStr.Substring(0, versionStr.Length - 1) + if (versionStr.EndsWith ("+")) then + versionStr.Substring (0, versionStr.Length - 1) else versionStr - try - Version(correctedVersion) - with - | exn -> raise(Exception("Electrum Server's version disliked by .NET Version class: " + versionStr, exn)) - - member self.ServerVersion (clientName: string) (protocolVersion: Version): Async = async { - let obj = { - Id = 0; - Method = "server.version"; - Params = [clientName; protocolVersion.ToString()] - } - // this below serializes to: - // (SPrintF2 "{ \"id\": 0, \"method\": \"server.version\", \"params\": [ \"%s\", \"%s\" ] }" - // CURRENT_ELECTRUM_FAKED_VERSION PROTOCOL_VERSION) - let json = Serialize obj - let! resObj, rawResponse = self.Request json - if Object.ReferenceEquals (resObj, null) then - failwith <| SPrintF1 "resObj is null?? raw response was %s" rawResponse - - if Object.ReferenceEquals (resObj.Result, null) then - failwith <| SPrintF1 "resObj.Result is null?? raw response was %s" rawResponse - - // resObj.Result.[0] is e.g. "ElectrumX 1.4.3" - // e.g. "1.1" - let serverProtocolVersion = resObj.Result.[1] + try + Version (correctedVersion) + with exn -> raise (Exception ("Electrum Server's version disliked by .NET Version class: " + versionStr, exn)) - return StratumClient.CreateVersion(serverProtocolVersion) - } + member self.ServerVersion (clientName: string) (protocolVersion: Version): Async = + async { + let obj = + { + Id = 0 + Method = "server.version" + Params = + [ + clientName + protocolVersion.ToString () + ] + } + // this below serializes to: + // (SPrintF2 "{ \"id\": 0, \"method\": \"server.version\", \"params\": [ \"%s\", \"%s\" ] }" + // CURRENT_ELECTRUM_FAKED_VERSION PROTOCOL_VERSION) + let json = Serialize obj + let! resObj, rawResponse = self.Request json + + if Object.ReferenceEquals (resObj, null) then + failwith <| SPrintF1 "resObj is null?? raw response was %s" rawResponse + + if Object.ReferenceEquals (resObj.Result, null) then + failwith <| SPrintF1 "resObj.Result is null?? raw response was %s" rawResponse + + // resObj.Result.[0] is e.g. "ElectrumX 1.4.3" + // e.g. "1.1" + let serverProtocolVersion = resObj.Result.[1] + + return StratumClient.CreateVersion (serverProtocolVersion) + } member self.BlockchainScriptHashListUnspent address: Async = - let obj = { - Id = 0; - Method = "blockchain.scripthash.listunspent"; - Params = [address] - } + let obj = + { + Id = 0 + Method = "blockchain.scripthash.listunspent" + Params = [ address ] + } + let json = Serialize obj async { - let! resObj,_ = self.Request json + let! resObj, _ = self.Request json return resObj } member self.BlockchainTransactionGet txHash: Async = - let obj = { - Id = 0; - Method = "blockchain.transaction.get"; - Params = [txHash] - } + let obj = + { + Id = 0 + Method = "blockchain.transaction.get" + Params = [ txHash ] + } + let json = Serialize obj async { - let! resObj,_ = self.Request json + let! resObj, _ = self.Request json return resObj } member self.BlockchainEstimateFee (numBlocksTarget: int): Async = - let obj = { - Id = 0; - Method = "blockchain.estimatefee"; - Params = [numBlocksTarget] - } + let obj = + { + Id = 0 + Method = "blockchain.estimatefee" + Params = [ numBlocksTarget ] + } + let json = Serialize obj async { - let! resObj,_ = self.Request json + let! resObj, _ = self.Request json return resObj } member self.BlockchainTransactionBroadcast txInHex: Async = - let obj = { - Id = 0; - Method = "blockchain.transaction.broadcast"; - Params = [txInHex] - } + let obj = + { + Id = 0 + Method = "blockchain.transaction.broadcast" + Params = [ txInHex ] + } + let json = Serialize obj async { - let! resObj,_ = self.Request json + let! resObj, _ = self.Request json return resObj } diff --git a/src/GWallet.Backend/UtxoCoin/TransactionTypes.fs b/src/GWallet.Backend/UtxoCoin/TransactionTypes.fs index 098219630..fb623acbc 100644 --- a/src/GWallet.Backend/UtxoCoin/TransactionTypes.fs +++ b/src/GWallet.Backend/UtxoCoin/TransactionTypes.fs @@ -6,21 +6,21 @@ open NBitcoin type TransactionInputOutpointInfo = { - TransactionHash: string; - OutputIndex: int; - ValueInSatoshis: int64; - DestinationInHex: string; + TransactionHash: string + OutputIndex: int + ValueInSatoshis: int64 + DestinationInHex: string } type TransactionMetadata = { - Fee: MinerFee; - Inputs: List; + Fee: MinerFee + Inputs: List } + interface IBlockchainFeeInfo with - member self.FeeEstimationTime with get() = self.Fee.EstimationTime - member self.FeeValue - with get() = - (Money.Satoshis self.Fee.EstimatedFeeInSatoshis).ToUnit MoneyUnit.BTC - member self.Currency with get() = self.Fee.Currency + member self.FeeEstimationTime = self.Fee.EstimationTime + + member self.FeeValue = (Money.Satoshis self.Fee.EstimatedFeeInSatoshis).ToUnit MoneyUnit.BTC + member self.Currency = self.Fee.Currency diff --git a/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs b/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs index 24b5da279..229fae5f5 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs @@ -14,183 +14,196 @@ open GWallet.Backend.FSharpUtil.UwpHacks type internal TransactionOutpoint = { - Transaction: Transaction; - OutputIndex: int; + Transaction: Transaction + 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 - abstract member PublicKey: PubKey with get + abstract PublicKey: PubKey -type NormalUtxoAccount(currency: Currency, accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string, - fromAccountFileToPublicKey: FileRepresentation -> PubKey) = +type NormalUtxoAccount (currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string, + fromAccountFileToPublicKey: FileRepresentation -> PubKey) = inherit GWallet.Backend.NormalAccount(currency, accountFile, fromAccountFileToPublicAddress) interface IUtxoAccount with - member val PublicKey = fromAccountFileToPublicKey accountFile with get + member val PublicKey = fromAccountFileToPublicKey accountFile -type ReadOnlyUtxoAccount(currency: Currency, accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string, - fromAccountFileToPublicKey: FileRepresentation -> PubKey) = +type ReadOnlyUtxoAccount (currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string, + fromAccountFileToPublicKey: FileRepresentation -> PubKey) = inherit GWallet.Backend.ReadOnlyAccount(currency, accountFile, fromAccountFileToPublicAddress) interface IUtxoAccount with - member val PublicKey = fromAccountFileToPublicKey accountFile with get + member val PublicKey = fromAccountFileToPublicKey accountFile -type ArchivedUtxoAccount(currency: Currency, accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string, - fromAccountFileToPublicKey: FileRepresentation -> PubKey) = +type ArchivedUtxoAccount (currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string, + fromAccountFileToPublicKey: FileRepresentation -> PubKey) = inherit GWallet.Backend.ArchivedAccount(currency, accountFile, fromAccountFileToPublicAddress) interface IUtxoAccount with - member val PublicKey = fromAccountFileToPublicKey accountFile with get + member val PublicKey = fromAccountFileToPublicKey accountFile module Account = let internal GetNetwork (currency: Currency) = - if not (currency.IsUtxo()) then - failwith <| SPrintF1 "Assertion failed: currency %A should be UTXO-type" currency + 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 - | _ -> failwith <| SPrintF1 "Assertion failed: UTXO currency %A not supported?" currency + | _ -> + failwith + <| SPrintF1 "Assertion failed: UTXO currency %A not supported?" currency // technique taken from https://electrumx.readthedocs.io/en/latest/protocol-basics.html#script-hashes let private GetElectrumScriptHashFromAddress (address: BitcoinAddress): string = - let sha = NBitcoin.Crypto.Hashes.SHA256(address.ScriptPubKey.ToBytes()) + let sha = NBitcoin.Crypto.Hashes.SHA256 (address.ScriptPubKey.ToBytes ()) let reversedSha = sha.Reverse().ToArray() NBitcoin.DataEncoders.Encoders.Hex.EncodeData reversedSha let public GetElectrumScriptHashFromPublicAddress currency (publicAddress: string) = // TODO: measure how long does it take to get the script hash and if it's too long, cache it at app startup? - BitcoinAddress.Create(publicAddress, GetNetwork currency) |> GetElectrumScriptHashFromAddress + BitcoinAddress.Create (publicAddress, GetNetwork currency) + |> GetElectrumScriptHashFromAddress let internal GetPublicAddressFromPublicKey currency (publicKey: PubKey) = (publicKey.GetSegwitAddress (GetNetwork currency)).GetScriptAddress().ToString() let internal GetPublicAddressFromNormalAccountFile (currency: Currency) (accountFile: FileRepresentation): string = - let pubKey = PubKey(accountFile.Name) + let pubKey = PubKey (accountFile.Name) GetPublicAddressFromPublicKey currency pubKey let internal GetPublicKeyFromNormalAccountFile (accountFile: FileRepresentation): PubKey = PubKey accountFile.Name let internal GetPublicKeyFromReadOnlyAccountFile (accountFile: FileRepresentation): PubKey = - accountFile.Content() |> PubKey + accountFile.Content () |> PubKey let internal GetPublicAddressFromUnencryptedPrivateKey (currency: Currency) (privateKey: string) = - let privateKey = Key.Parse(privateKey, GetNetwork currency) + let privateKey = Key.Parse (privateKey, GetNetwork currency) GetPublicAddressFromPublicKey currency privateKey.PubKey let internal GetAccountFromFile (accountFile: FileRepresentation) (currency: Currency) kind: IAccount = - if not (currency.IsUtxo()) then - failwith <| SPrintF1 "Assertion failed: currency %A should be UTXO-type" currency + 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 + ReadOnlyUtxoAccount + (currency, accountFile, (fun accountFile -> accountFile.Name), GetPublicKeyFromReadOnlyAccountFile) :> IAccount | AccountKind.Normal -> let fromAccountFileToPublicAddress = GetPublicAddressFromNormalAccountFile currency let fromAccountFileToPublicKey = GetPublicKeyFromNormalAccountFile - NormalUtxoAccount(currency, accountFile, - fromAccountFileToPublicAddress, fromAccountFileToPublicKey) - :> IAccount - | _ -> - failwith <| SPrintF1 "Kind (%A) not supported for this API" kind + NormalUtxoAccount (currency, accountFile, fromAccountFileToPublicAddress, fromAccountFileToPublicKey) :> IAccount + | _ -> failwith <| SPrintF1 "Kind (%A) not supported for this API" kind let private BalanceToShow (balances: BlockchainScriptHashGetBalanceInnerResult) = let unconfirmedPlusConfirmed = balances.Unconfirmed + balances.Confirmed + let amountToShowInSatoshis = if unconfirmedPlusConfirmed < balances.Confirmed then unconfirmedPlusConfirmed else balances.Confirmed + 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 match Caching.Instance.TryRetrieveLastCompoundBalance address currency with | None -> false - | Some balance -> - BalanceToShow someRetrievedBalance = balance - - let private GetBalances (account: IUtxoAccount) - (mode: ServerSelectionMode) - (cancelSourceOption: Option) - : Async = + | Some balance -> BalanceToShow someRetrievedBalance = balance + + let private GetBalances + (account: IUtxoAccount) + (mode: ServerSelectionMode) + (cancelSourceOption: Option) + : Async + = let scriptHashHex = GetElectrumScriptHashFromPublicAddress account.Currency account.PublicAddress let querySettings = - QuerySettings.Balance(mode,(BalanceMatchWithCacheOrInitialBalance account.PublicAddress account.Currency)) + QuerySettings.Balance (mode, (BalanceMatchWithCacheOrInitialBalance account.PublicAddress account.Currency)) + 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 + match maybeBalances with - | Some balances -> - return Some (BalanceToShow balances) - | None -> - return None + | Some balances -> return Some (BalanceToShow balances) + | None -> return None } let private ConvertToICoin (account: IUtxoAccount) (inputOutpointInfo: TransactionInputOutpointInfo): ICoin = let txHash = uint256 inputOutpointInfo.TransactionHash let scriptPubKeyInBytes = NBitcoin.DataEncoders.Encoders.Hex.DecodeData inputOutpointInfo.DestinationInHex - let scriptPubKey = Script(scriptPubKeyInBytes) + let scriptPubKey = Script (scriptPubKeyInBytes) + let coin = - Coin(txHash, uint32 inputOutpointInfo.OutputIndex, Money(inputOutpointInfo.ValueInSatoshis), scriptPubKey) + 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() transactionBuilder.AddCoins coins |> ignore let currency = account.Currency - let destAddress = BitcoinAddress.Create(destination, GetNetwork currency) + let destAddress = BitcoinAddress.Create (destination, GetNetwork currency) if amount.BalanceAtTheMomentOfSending <> amount.ValueToSend then - let moneyAmount = Money(amount.ValueToSend, MoneyUnit.BTC) - transactionBuilder.Send(destAddress, moneyAmount) |> ignore + let moneyAmount = Money (amount.ValueToSend, MoneyUnit.BTC) + transactionBuilder.Send (destAddress, moneyAmount) |> ignore let originAddress = (account :> IAccount).PublicAddress - let changeAddress = BitcoinAddress.Create(originAddress, GetNetwork currency) + let changeAddress = BitcoinAddress.Create (originAddress, GetNetwork currency) transactionBuilder.SetChange changeAddress |> ignore else transactionBuilder.SendAll destAddress |> ignore @@ -203,191 +216,224 @@ module Account = type internal UnspentTransactionOutputInfo = { - TransactionId: string; - OutputIndex: int; - Value: Int64; + TransactionId: string + OutputIndex: int + 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 - let transaction = Transaction.Parse(transRaw, GetNetwork currency) + let! transRaw = Server.Query currency (QuerySettings.Default ServerSelectionMode.Fast) job None + let transaction = Transaction.Parse (transRaw, GetNetwork currency) let txOut = transaction.Outputs.[utxo.OutputIndex] // should suggest a ToHex() method to NBitcoin's TxOut type? - let destination = txOut.ScriptPubKey.ToHex() - let ret = { - TransactionHash = transaction.GetHash().ToString(); - OutputIndex = utxo.OutputIndex; - ValueInSatoshis = txOut.Value.Satoshi; - DestinationInHex = destination; - } + let destination = txOut.ScriptPubKey.ToHex () + + let ret = + { + TransactionHash = transaction.GetHash().ToString() + OutputIndex = utxo.OutputIndex + ValueInSatoshis = txOut.Value.Satoshi + DestinationInHex = destination + } + 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 - return fees,usedInputsSoFar - with - | :? NBitcoin.NotEnoughFundsException as ex -> + return fees, usedInputsSoFar + with :? NBitcoin.NotEnoughFundsException as ex -> match unusedUtxos with | [] -> return raise <| FSharpUtil.ReRaise ex - | head::tail -> + | head :: tail -> let! newInput = head |> ConvertToInputOutpointInfo account.Currency + let newCoin = newInput |> ConvertToICoin account - let newTxBuilder = txBuilder.AddCoins [newCoin] - let newInputs = newInput::usedInputsSoFar + + 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 = async { - 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()) - | utxoInfo::tail -> - let newAcc = - // Avoid querying for zero-value UTXOs, which would make many unnecessary parallel - // connections to Electrum servers. (there's no need to use/consolidate zero-value UTXOs) - - // This can be triggered on e.g. RegTest (by mining to Geewallet directly) - // because the block subsidy falls quickly. (it will be 0 after 7000 blocks) - - // Zero-value OP_RETURN outputs are valid and standard: - // https://bitcoin.stackexchange.com/a/57103 - if utxoInfo.Value > 0L then - utxoInfo::acc + let internal EstimateFee + (account: IUtxoAccount) + (amount: TransferAmount) + (destination: string) + : Async + = + async { + 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 ()) + | utxoInfo :: tail -> + let newAcc = + // Avoid querying for zero-value UTXOs, which would make many unnecessary parallel + // connections to Electrum servers. (there's no need to use/consolidate zero-value UTXOs) + + // This can be triggered on e.g. RegTest (by mining to Geewallet directly) + // because the block subsidy falls quickly. (it will be 0 after 7000 blocks) + + // Zero-value OP_RETURN outputs are valid and standard: + // https://bitcoin.stackexchange.com/a/57103 + if utxoInfo.Value > 0L then + utxoInfo :: acc + else + acc + + let newSoFar = soFarInSatoshis + utxoInfo.Value + if (newSoFar < amount) then + addInputsUntilAmount tail newSoFar amount newAcc else - acc - - let newSoFar = soFarInSatoshis + utxoInfo.Value - if (newSoFar < amount) then - addInputsUntilAmount tail newSoFar amount newAcc - else - newAcc,tail - - let job = GetElectrumScriptHashFromPublicAddress account.Currency account.PublicAddress - |> ElectrumClient.GetUnspentTransactionOutputs - let! utxos = Server.Query account.Currency (QuerySettings.Default ServerSelectionMode.Fast) job None - - if not (utxos.Any()) then - failwith "No UTXOs found!" - let possibleInputs = - seq { - for utxo in utxos do - yield { TransactionId = utxo.TxHash; OutputIndex = utxo.TxPos; Value = utxo.Value } - } + newAcc, tail + + let job = + GetElectrumScriptHashFromPublicAddress account.Currency account.PublicAddress + |> ElectrumClient.GetUnspentTransactionOutputs + + let! utxos = Server.Query account.Currency (QuerySettings.Default ServerSelectionMode.Fast) job None + + if not (utxos.Any ()) then + failwith "No UTXOs found!" + + let possibleInputs = + seq { + for utxo in utxos do + yield { + TransactionId = utxo.TxHash + OutputIndex = utxo.TxPos + Value = utxo.Value + } + } - // first ones are the smallest ones - let inputsOrderedByAmount = possibleInputs.OrderBy(fun utxo -> utxo.Value) |> List.ofSeq + // first ones are the smallest ones + let inputsOrderedByAmount = possibleInputs.OrderBy (fun utxo -> utxo.Value) |> List.ofSeq - let amountInSatoshis = Money(amount.ValueToSend, MoneyUnit.BTC).Satoshi - let utxosToUse,unusedInputs = - addInputsUntilAmount inputsOrderedByAmount 0L amountInSatoshis List.Empty + let amountInSatoshis = Money(amount.ValueToSend, MoneyUnit.BTC).Satoshi - let asyncInputs = List.map (ConvertToInputOutpointInfo account.Currency) utxosToUse - let! inputs = Async.Parallel asyncInputs + let utxosToUse, unusedInputs = addInputsUntilAmount inputsOrderedByAmount 0L amountInSatoshis List.Empty - let initiallyUsedInputs = inputs |> List.ofArray + let asyncInputs = List.map (ConvertToInputOutpointInfo account.Currency) utxosToUse - let averageFee (feesFromDifferentServers: List): decimal = - let avg = feesFromDifferentServers.Sum() / decimal feesFromDifferentServers.Length - avg + let! inputs = Async.Parallel asyncInputs - //querying for 1 will always return -1 surprisingly... - let estimateFeeJob = ElectrumClient.EstimateFee 2 - let! btcPerKiloByteForFastTrans = - Server.Query account.Currency (QuerySettings.FeeEstimation averageFee) estimateFeeJob None + let initiallyUsedInputs = inputs |> List.ofArray + + let averageFee (feesFromDifferentServers: List): decimal = + let avg = feesFromDifferentServers.Sum () / decimal feesFromDifferentServers.Length + + avg + + //querying for 1 will always return -1 surprisingly... + let estimateFeeJob = ElectrumClient.EstimateFee 2 + + let! btcPerKiloByteForFastTrans = + Server.Query account.Currency (QuerySettings.FeeEstimation averageFee) estimateFeeJob None + + let feeRate = + try + Money (btcPerKiloByteForFastTrans, MoneyUnit.BTC) |> FeeRate + with ex -> + // we need more info in case this bug shows again: https://gitlab.com/knocte/geewallet/issues/43 + raise + <| Exception + (SPrintF1 + "Could not create fee rate from %s btc per KB" + (btcPerKiloByteForFastTrans.ToString ()), + ex) + + let transactionBuilder = + CreateTransactionAndCoinsToBeSigned account initiallyUsedInputs destination amount - let feeRate = try - Money(btcPerKiloByteForFastTrans, MoneyUnit.BTC) |> FeeRate - with - | ex -> - // we need more info in case this bug shows again: https://gitlab.com/knocte/geewallet/issues/43 - raise <| Exception(SPrintF1 "Could not create fee rate from %s btc per KB" - (btcPerKiloByteForFastTrans.ToString()), ex) - - let transactionBuilder = CreateTransactionAndCoinsToBeSigned account - initiallyUsedInputs - destination - amount + let! estimatedMinerFee, allUsedInputs = + EstimateFees transactionBuilder feeRate account initiallyUsedInputs unusedInputs - try - let! estimatedMinerFee,allUsedInputs = - EstimateFees transactionBuilder feeRate account initiallyUsedInputs unusedInputs + let estimatedMinerFeeInSatoshis = estimatedMinerFee.Satoshi - let estimatedMinerFeeInSatoshis = estimatedMinerFee.Satoshi - let minerFee = MinerFee(estimatedMinerFeeInSatoshis, DateTime.UtcNow, account.Currency) + let minerFee = MinerFee (estimatedMinerFeeInSatoshis, DateTime.UtcNow, account.Currency) - return { Inputs = allUsedInputs; Fee = minerFee } - with - | :? NBitcoin.NotEnoughFundsException -> - return raise <| InsufficientBalanceForFee None - } + 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 + finalTransactionBuilder.SendFees (Money.Satoshis (btcMinerFee.EstimatedFeeInSatoshis)) + |> ignore let finalTransaction = finalTransactionBuilder.BuildTransaction true - let transCheckResultAfterSigning = finalTransaction.Check() + let transCheckResultAfterSigning = finalTransaction.Check () if (transCheckResultAfterSigning <> TransactionCheckResult.Success) then - failwith <| SPrintF1 "Transaction check failed after signing with %A" transCheckResultAfterSigning + 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 = - let encryptedPrivateKey = account.GetEncryptedPrivateKey() - let encryptedSecret = BitcoinEncryptedSecretNoEC(encryptedPrivateKey, GetNetwork (account:>IAccount).Currency) + let encryptedPrivateKey = account.GetEncryptedPrivateKey () + + let encryptedSecret = + BitcoinEncryptedSecretNoEC (encryptedPrivateKey, GetNetwork (account :> IAccount).Currency) + try - encryptedSecret.GetKey(password) - with - | :? SecurityException -> - raise (InvalidPassword) + 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 - let signedTransaction = SignTransactionWithPrivateKey - account - txMetadata - destination - amount - privateKey - let rawTransaction = signedTransaction.ToHex() + let signedTransaction = SignTransactionWithPrivateKey account txMetadata destination amount privateKey + let rawTransaction = signedTransaction.ToHex () rawTransaction let internal CheckValidPassword (account: NormalAccount) (password: string) = @@ -402,14 +448,15 @@ 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 + if (baseAccount.PublicAddress.Equals (destination, StringComparison.InvariantCultureIgnoreCase)) then raise DestinationEqualToOrigin let finalTransaction = SignTransaction account txMetadata destination amount password @@ -419,44 +466,50 @@ 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; - Metadata = txMetadata; + Proposal = transProposal + Cache = Caching.Instance.GetLastCachedData().ToDietCache readOnlyAccounts + Metadata = txMetadata } + ExportUnsignedTransactionToJson unsignedTransaction - let internal SweepArchivedFunds (account: ArchivedUtxoAccount) - (balance: decimal) - (destination: IAccount) - (txMetadata: TransactionMetadata) - = - let currency = (account:>IAccount).Currency + 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) - let privateKey = Key.Parse(account.GetUnencryptedPrivateKey(), network) - let signedTrans = SignTransactionWithPrivateKey - account txMetadata destination.PublicAddress amount privateKey - BroadcastRawTransaction currency (signedTrans.ToHex()) + let amount = TransferAmount (balance, balance, currency) + let privateKey = Key.Parse (account.GetUnencryptedPrivateKey (), network) + + let signedTrans = + SignTransactionWithPrivateKey account txMetadata destination.PublicAddress amount privateKey + + BroadcastRawTransaction currency (signedTrans.ToHex ()) let internal Create currency (password: string) (seed: array): Async = async { let privKey = Key seed let network = GetNetwork currency let secret = privKey.GetBitcoinSecret network - let encryptedSecret = secret.PrivateKey.GetEncryptedBitcoinSecret(password, network) - let encryptedPrivateKey = encryptedSecret.ToWif() - let publicKey = secret.PubKey.ToString() + let encryptedSecret = secret.PrivateKey.GetEncryptedBitcoinSecret (password, network) + let encryptedPrivateKey = encryptedSecret.ToWif () + let publicKey = secret.PubKey.ToString () return { - Name = publicKey - Content = fun _ -> encryptedPrivateKey - } + Name = publicKey + Content = fun _ -> encryptedPrivateKey + } } let internal ValidateAddress (currency: Currency) (address: string) = @@ -478,31 +531,35 @@ module Account = | LTC -> let LITECOIN_ADDRESS_PUBKEYHASH_PREFIX = "L" let LITECOIN_ADDRESS_SCRIPTHASH_PREFIX = "M" - [ LITECOIN_ADDRESS_PUBKEYHASH_PREFIX; LITECOIN_ADDRESS_SCRIPTHASH_PREFIX ] + [ + LITECOIN_ADDRESS_PUBKEYHASH_PREFIX + LITECOIN_ADDRESS_SCRIPTHASH_PREFIX + ] | _ -> failwith <| SPrintF1 "Unknown UTXO currency %A" currency - if not (utxoCoinValidAddressPrefixes.Any(fun prefix -> address.StartsWith prefix)) then - raise (AddressMissingProperPrefix(utxoCoinValidAddressPrefixes)) + if not (utxoCoinValidAddressPrefixes.Any (fun prefix -> address.StartsWith prefix)) then + raise (AddressMissingProperPrefix (utxoCoinValidAddressPrefixes)) - let minLength,lenghtInBetweenAllowed,maxLength = + let minLength, lenghtInBetweenAllowed, maxLength = if currency = Currency.BTC && (address.StartsWith BITCOIN_ADDRESS_BECH32_PREFIX) then // taken from https://github.com/bitcoin/bips/blob/master/bip-0173.mediawiki // (FIXME: this is only valid for the first version of segwit, fix it!) - 42,false,62 + 42, false, 62 else - 27,true,34 + 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 + if not lenghtInBetweenAllowed + && (address.Length <> minLength && address.Length <> maxLength) then raise <| AddressWithInvalidLength limits let network = GetNetwork currency try - BitcoinAddress.Create(address, network) |> ignore + BitcoinAddress.Create (address, network) |> ignore with // TODO: propose to NBitcoin upstream to generate an NBitcoin exception instead - | :? FormatException -> - raise (AddressWithInvalidChecksum None) + :? FormatException -> raise (AddressWithInvalidChecksum None) diff --git a/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs b/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs index 2452cda8b..80f6801ea 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs @@ -5,13 +5,10 @@ open System open GWallet.Backend //FIXME: convert to record? -type MinerFee(estimatedFeeInSatoshis: int64, - estimationTime: DateTime, - currency: Currency) = +type MinerFee (estimatedFeeInSatoshis: int64, estimationTime: DateTime, currency: Currency) = - member val EstimatedFeeInSatoshis = estimatedFeeInSatoshis with get + member val EstimatedFeeInSatoshis = estimatedFeeInSatoshis - member val EstimationTime = estimationTime with get - - member val Currency = currency with get + member val EstimationTime = estimationTime + member val Currency = currency diff --git a/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs b/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs index c4488df56..6348ba20c 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs @@ -10,8 +10,8 @@ open GWallet.Backend.FSharpUtil.UwpHacks type QuerySettings<'R> = | Default of mode: ServerSelectionMode - | Balance of ServerSelectionMode*('R->bool) - | FeeEstimation of (List<'R>->'R) + | Balance of ServerSelectionMode * ('R -> bool) + | FeeEstimation of (List<'R> -> 'R) | Broadcast module Server = @@ -21,8 +21,7 @@ module Server = | ServerSelectionMode.Fast -> 3u | ServerSelectionMode.Analysis -> 2u - let private FaultTolerantParallelClientDefaultSettings (mode: ServerSelectionMode) - maybeConsistencyConfig = + let private FaultTolerantParallelClientDefaultSettings (mode: ServerSelectionMode) maybeConsistencyConfig = let consistencyConfig = match maybeConsistencyConfig with | None -> SpecificNumberOfConsistentResponsesRequired 2u @@ -42,86 +41,98 @@ module Server = } } - let private FaultTolerantParallelClientSettingsForBroadcast() = - FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast - (Some (SpecificNumberOfConsistentResponsesRequired 1u)) + let private FaultTolerantParallelClientSettingsForBroadcast () = + FaultTolerantParallelClientDefaultSettings + 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) else None + FaultTolerantParallelClientDefaultSettings mode consistencyConfig let private faultTolerantElectrumClient = - FaultTolerantParallelClient Caching.Instance.SaveServerLastStat + FaultTolerantParallelClient Caching.Instance.SaveServerLastStat // 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> = async { - try - let stratumClient = ElectrumClient.StratumServer server - return! electrumClientFunc stratumClient - - // NOTE: try to make this 'with' block be in sync with the one in EtherServer:GetWeb3Funcs() - with - | :? CommunicationUnsuccessfulException as ex -> - 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) - } - let ElectrumServerToGenericServer (electrumClientFunc: Async->Async<'R>) - (electrumServer: ServerDetails) - : Server = + 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 + return! electrumClientFunc stratumClient + + // NOTE: try to make this 'with' block be in sync with the one in EtherServer:GetWeb3Funcs() + with + | :? CommunicationUnsuccessfulException as ex -> + 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) + } + + let ElectrumServerToGenericServer + (electrumClientFunc: Async -> Async<'R>) + (electrumServer: ServerDetails) + : Server + = { Details = electrumServer Retrieval = ElectrumServerToRetrievalFunc electrumServer electrumClientFunc } - let serverFuncs = - Seq.map (ElectrumServerToGenericServer electrumClientFunc) - electrumServers + 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> = + 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 = match cancelSourceOption with - | None -> - faultTolerantElectrumClient.Query - | Some cancelSource -> - faultTolerantElectrumClient.QueryWithCancellation cancelSource + | None -> faultTolerantElectrumClient.Query + | Some cancelSource -> faultTolerantElectrumClient.QueryWithCancellation cancelSource + let querySettings = match settings with | Default mode -> FaultTolerantParallelClientDefaultSettings mode None - | Balance (mode,predicate) -> FaultTolerantParallelClientSettingsForBalanceCheck mode predicate + | Balance (mode, predicate) -> FaultTolerantParallelClientSettingsForBalanceCheck mode predicate | FeeEstimation averageFee -> let minResponsesRequired = 3u FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast (Some (AverageBetweenResponses (minResponsesRequired, averageFee))) - | Broadcast -> FaultTolerantParallelClientSettingsForBroadcast() - query - querySettings - (GetRandomizedFuncs currency job) + | Broadcast -> FaultTolerantParallelClientSettingsForBroadcast () + + query querySettings (GetRandomizedFuncs currency job) diff --git a/src/GWallet.Backend/WarpKey.fs b/src/GWallet.Backend/WarpKey.fs index 7786aa71c..06f2f6f74 100644 --- a/src/GWallet.Backend/WarpKey.fs +++ b/src/GWallet.Backend/WarpKey.fs @@ -14,7 +14,7 @@ module WarpKey = let XOR (a: array) (b: array): array = if (a.Length <> b.Length) then - raise (ArgumentException()) + raise (ArgumentException ()) else let result = Array.create a.Length (byte 0) for i = 0 to (a.Length - 1) do @@ -23,40 +23,42 @@ module WarpKey = let Scrypt (passphrase: string) (salt: string): array = // FIXME: stop using mutable collections - let passphraseByteList = System.Collections.Generic.List() - passphraseByteList.AddRange (Encoding.UTF8.GetBytes(passphrase)) + let passphraseByteList = System.Collections.Generic.List () + passphraseByteList.AddRange (Encoding.UTF8.GetBytes (passphrase)) passphraseByteList.Add (byte 1) - let saltByteList = System.Collections.Generic.List() - saltByteList.AddRange (Encoding.UTF8.GetBytes(salt)) + let saltByteList = System.Collections.Generic.List () + saltByteList.AddRange (Encoding.UTF8.GetBytes (salt)) saltByteList.Add (byte 1) - NBitcoin.Crypto.SCrypt.ComputeDerivedKey(passphraseByteList.ToArray(), - saltByteList.ToArray(), - 262144, 8, 1, Nullable(), 32) + NBitcoin.Crypto.SCrypt.ComputeDerivedKey + (passphraseByteList.ToArray (), saltByteList.ToArray (), 262144, 8, 1, Nullable (), 32) let PBKDF2 (passphrase: string) (salt: string): array = // FIXME: stop using mutable collections - let passphraseByteList = System.Collections.Generic.List() - passphraseByteList.AddRange (Encoding.UTF8.GetBytes(passphrase)) + let passphraseByteList = System.Collections.Generic.List () + passphraseByteList.AddRange (Encoding.UTF8.GetBytes (passphrase)) passphraseByteList.Add (byte 2) - let saltByteList = System.Collections.Generic.List() - saltByteList.AddRange (Encoding.UTF8.GetBytes(salt)) + let saltByteList = System.Collections.Generic.List () + saltByteList.AddRange (Encoding.UTF8.GetBytes (salt)) saltByteList.Add (byte 2) - use hashAlgo = new HMACSHA256(passphraseByteList.ToArray()) + use hashAlgo = new HMACSHA256(passphraseByteList.ToArray ()) // TODO: remove nowarn when we switch to .NET BCL's impl instead of NBitcoin.Crypto - NBitcoin.Crypto.Pbkdf2.ComputeDerivedKey(hashAlgo, saltByteList.ToArray(), 65536, 32) + NBitcoin.Crypto.Pbkdf2.ComputeDerivedKey (hashAlgo, saltByteList.ToArray (), 65536, 32) let private LENGTH_OF_PRIVATE_KEYS = 32 + let CreatePrivateKey (passphrase: string) (salt: string) = 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 + failwith + <| SPrintF2 + "Something went horribly wrong because length of privKey was not %i but %i" + LENGTH_OF_PRIVATE_KEYS + privKeyBytes.Length privKeyBytes -