diff --git a/src/GWallet.Backend/Account.fs b/src/GWallet.Backend/Account.fs index d2c977718..835b978e3 100644 --- a/src/GWallet.Backend/Account.fs +++ b/src/GWallet.Backend/Account.fs @@ -13,40 +13,49 @@ module Account = (account: IAccount) (mode: ServerSelectionMode) (cancelSourceOption: Option) - : 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 (balance)" account.Currency + <| SPrintF1 + "Currency %A not Utxo-type but account is? report this bug (balance)" + account.Currency - UtxoCoin.Account.GetShowableBalance utxoAccount mode cancelSourceOption + 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 + account.Currency + Ether.Account.GetShowableBalance account mode cancelSourceOption let GetShowableBalance (account: IAccount) (mode: ServerSelectionMode) (cancelSourceOption: Option) - : Async> - = + : Async> = async { if Config.NoNetworkBalanceForDebuggingPurposes then return Fresh 1m else - let! maybeBalance = GetShowableBalanceInternal account mode cancelSourceOption + let! maybeBalance = + GetShowableBalanceInternal account mode cancelSourceOption match maybeBalance with | None -> - return NotFresh - (Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency) + return + NotFresh ( + Caching.Instance.RetrieveLastCompoundBalance + account.PublicAddress + account.Currency + ) | Some balance -> let compoundBalance, _ = Caching.Instance.RetrieveAndUpdateLastCompoundBalance @@ -57,13 +66,18 @@ module Account = return Fresh compoundBalance } - let internal GetAccountFromFile accountFile (currency: Currency) kind: IAccount = + let internal GetAccountFromFile + accountFile + (currency: Currency) + kind + : IAccount = if currency.IsUtxo () then UtxoCoin.Account.GetAccountFromFile accountFile currency kind elif currency.IsEtherBased () then Ether.Account.GetAccountFromFile accountFile currency kind else - failwith <| SPrintF1 "Currency (%A) not supported for this API" currency + failwith + <| SPrintF1 "Currency (%A) not supported for this API" currency let GetAllActiveAccounts (): seq = Config.PropagateEthAccountInfoToMissingTokensAccounts () @@ -88,26 +102,40 @@ module Account = 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 + 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 utxoCoinPublicKey = UtxoCoin.Account.GetPublicKeyFromNormalAccountFile firstUtxoAccountFile + + let utxoCoinPublicKey = + UtxoCoin.Account.GetPublicKeyFromNormalAccountFile + firstUtxoAccountFile + let firstEtherAccountFile = etherCurrencyAccountFiles.First () - let etherPublicAddress = Ether.Account.GetPublicAddressFromNormalAccountFile firstEtherAccountFile + + let etherPublicAddress = + Ether.Account.GetPublicAddressFromNormalAccountFile + firstEtherAccountFile + Some { UtxoCoinPublicKey = utxoCoinPublicKey.ToString () EtherPublicAddress = etherPublicAddress } - let GetArchivedAccountsWithPositiveBalance (cancelSourceOption: Option): Async> = + let GetArchivedAccountsWithPositiveBalance + (cancelSourceOption: Option) + : Async> = let asyncJobs = seq>> { let allCurrencies = Currency.GetAll () @@ -115,47 +143,67 @@ module Account = for currency in allCurrencies do let fromUnencryptedPrivateKeyToPublicAddressFunc = if currency.IsUtxo () then - UtxoCoin.Account.GetPublicAddressFromUnencryptedPrivateKey currency + 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 + let fromConfigAccountFileToPublicAddressFunc + (accountConfigFile: FileRepresentation) + = + let privateKeyFromConfigFile = + accountConfigFile.Content () + + fromUnencryptedPrivateKeyToPublicAddressFunc + privateKeyFromConfigFile - for accountFile in Config.GetAccountFiles [ currency ] AccountKind.Archived do + 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 - } + 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 - | _ -> () - } + return + seq { + for account, maybePositiveBalance in accountAndPositiveBalances do + match maybePositiveBalance with + | Some positiveBalance -> yield account, positiveBalance + | _ -> () + } } // TODO: add tests for these (just in case address validation breaks after upgrading our dependencies) @@ -170,7 +218,11 @@ module Account = } - let EstimateFee (account: IAccount) (amount: TransferAmount) destination: Async = + let EstimateFee + (account: IAccount) + (amount: TransferAmount) + destination + : Async = async { match account with | :? UtxoCoin.IUtxoAccount as utxoAccount -> @@ -178,20 +230,28 @@ module Account = failwith <| SPrintF1 "Currency %A not Utxo-type but account is? report this bug (estimatefee)" - account.Currency - let! fee = UtxoCoin.Account.EstimateFee utxoAccount amount destination + 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 + account.Currency + let! fee = Ether.Account.EstimateFee account amount destination return fee :> IBlockchainFeeInfo } - let private SaveOutgoingTransactionInCache transactionProposal (fee: IBlockchainFeeInfo) txId = + let private SaveOutgoingTransactionInCache + transactionProposal + (fee: IBlockchainFeeInfo) + txId + = let amountTransferredPlusFeeIfCurrencyFeeMatches = if transactionProposal.Amount.BalanceAtTheMomentOfSending = transactionProposal.Amount.ValueToSend || transactionProposal.Amount.Currency <> fee.Currency then @@ -209,23 +269,33 @@ 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 + Ether.Server.IsOutOfGas + transactionMetadata.Currency + txHash + etherTxMetadata.Fee.GasLimit if outOfGas then - return failwith <| SPrintF1 "Transaction ran out of gas: %s" txHash + return + failwith + <| SPrintF1 "Transaction ran out of gas: %s" txHash with ex -> - return raise - <| Exception - (SPrintF1 - "An issue occurred while trying to check if the following transaction ran out of gas: %s" - txHash, - ex) + return + raise + <| Exception ( + SPrintF1 + "An issue occurred while trying to check if the following transaction ran out of gas: %s" + txHash, + ex + ) | _ -> () } @@ -246,7 +316,10 @@ module Account = do! CheckIfOutOfGas trans.TransactionInfo.Metadata txId - SaveOutgoingTransactionInCache trans.TransactionInfo.Proposal trans.TransactionInfo.Metadata txId + SaveOutgoingTransactionInCache + trans.TransactionInfo.Proposal + trans.TransactionInfo.Metadata + txId let uri = BlockExplorer.GetTransaction currency txId @@ -263,12 +336,24 @@ module Account = 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" @@ -276,38 +361,54 @@ module Account = let checkJobs = seq { for account in GetAllActiveAccounts().OfType () do - yield async { - if (account :> IAccount).Currency.IsEtherBased() then - try - Ether.Account.CheckValidPassword account password - return true - with :? InvalidPassword -> return false - else - try - UtxoCoin.Account.CheckValidPassword account password - return true - with :? InvalidPassword -> return false - } + yield + async { + if (account :> IAccount).Currency.IsEtherBased() then + try + Ether.Account.CheckValidPassword + account + password + + return true + with :? InvalidPassword -> return false + else + try + UtxoCoin.Account.CheckValidPassword + account + password + + return true + with :? InvalidPassword -> return false + } } Async.Parallel checkJobs - let private CreateArchivedAccount (currency: Currency) (unencryptedPrivateKey: string): ArchivedAccount = + let private CreateArchivedAccount + (currency: Currency) + (unencryptedPrivateKey: string) + : ArchivedAccount = let fromUnencryptedPrivateKeyToPublicAddressFunc = if currency.IsUtxo () then - UtxoCoin.Account.GetPublicAddressFromUnencryptedPrivateKey currency + UtxoCoin.Account.GetPublicAddressFromUnencryptedPrivateKey + currency elif currency.IsEther () then Ether.Account.GetPublicAddressFromUnencryptedPrivateKey else failwith <| SPrintF1 "Unknown currency %A" currency - let fromConfigFileToPublicAddressFunc (accountConfigFile: FileRepresentation) = + 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 () - fromUnencryptedPrivateKeyToPublicAddressFunc privateKeyFromConfigFile - let fileName = fromUnencryptedPrivateKeyToPublicAddressFunc unencryptedPrivateKey + fromUnencryptedPrivateKeyToPublicAddressFunc + privateKeyFromConfigFile + + let fileName = + fromUnencryptedPrivateKeyToPublicAddressFunc unencryptedPrivateKey let conceptAccount = { @@ -317,11 +418,18 @@ module Account = Name = fileName Content = fun _ -> unencryptedPrivateKey } - ExtractPublicAddressFromConfigFileFunc = fromConfigFileToPublicAddressFunc + ExtractPublicAddressFromConfigFileFunc = + fromConfigFileToPublicAddressFunc } - let newAccountFile = Config.AddAccount conceptAccount AccountKind.Archived - ArchivedAccount (currency, newAccountFile, fromConfigFileToPublicAddressFunc) + let newAccountFile = + Config.AddAccount conceptAccount AccountKind.Archived + + ArchivedAccount ( + currency, + newAccountFile, + fromConfigFileToPublicAddressFunc + ) let Archive (account: NormalAccount) (password: string): unit = let currency = (account :> IAccount).Currency @@ -329,7 +437,10 @@ module Account = let privateKeyAsString = if currency.IsUtxo () then let privKey = UtxoCoin.Account.GetPrivateKey account password - privKey.GetWif(UtxoCoin.Account.GetNetwork currency).ToWif() + + privKey + .GetWif(UtxoCoin.Account.GetNetwork currency) + .ToWif() elif currency.IsEther () then let privKey = Ether.Account.GetPrivateKey account password privKey.GetPrivateKey () @@ -347,12 +458,22 @@ module Account = = match txMetadata with | :? Ether.TransactionMetadata as etherTxMetadata -> - Ether.Account.SweepArchivedFunds account balance destination etherTxMetadata + Ether.Account.SweepArchivedFunds + account + balance + destination + etherTxMetadata | :? UtxoCoin.TransactionMetadata as utxoTxMetadata -> 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" + UtxoCoin.Account.SweepArchivedFunds + utxoAccount + balance + destination + utxoTxMetadata + | _ -> + failwith + "If tx metadata is UTXO type, archived account should be too" | _ -> failwith "tx metadata type unknown" let SendPayment @@ -361,10 +482,13 @@ module Account = (destination: string) (amount: TransferAmount) (password: string) - : Async - = + : 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 @@ -379,16 +503,31 @@ module Account = failwith <| SPrintF1 "Currency %A not Utxo-type but tx metadata is? report this bug (sendpayment)" - currency + currency + match account with | :? UtxoCoin.NormalUtxoAccount as utxoAccount -> - UtxoCoin.Account.SendPayment utxoAccount btcTxMetadata destination amount password - | _ -> failwith "Account not Utxo-type but tx metadata is? report this bug (sendpayment)" + UtxoCoin.Account.SendPayment + utxoAccount + btcTxMetadata + destination + amount + password + | _ -> + failwith + "Account not Utxo-type but tx metadata is? report this bug (sendpayment)" | :? Ether.TransactionMetadata as etherTxMetadata -> if not (currency.IsEtherBased ()) then - failwith "Account not ether-type but tx metadata is? report this bug (sendpayment)" - Ether.Account.SendPayment account etherTxMetadata destination amount password + failwith + "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" do! CheckIfOutOfGas txMetadata txId @@ -407,7 +546,11 @@ module Account = return uri } - let SignUnsignedTransaction (account) (unsignedTrans: UnsignedTransaction) password = + let SignUnsignedTransaction + (account) + (unsignedTrans: UnsignedTransaction) + password + = let rawTransaction = SignTransaction account @@ -431,7 +574,9 @@ module Account = | t when t = typeof -> let unsignedEthTx = { - Metadata = box trans.TransactionInfo.Metadata :?> Ether.TransactionMetadata + Metadata = + box trans.TransactionInfo.Metadata + :?> Ether.TransactionMetadata Proposal = trans.TransactionInfo.Proposal Cache = trans.TransactionInfo.Cache } @@ -446,7 +591,9 @@ module Account = | t when t = typeof -> let unsignedBtcTx = { - Metadata = box trans.TransactionInfo.Metadata :?> UtxoCoin.TransactionMetadata + Metadata = + box trans.TransactionInfo.Metadata + :?> UtxoCoin.TransactionMetadata Proposal = trans.TransactionInfo.Proposal Cache = trans.TransactionInfo.Cache } @@ -464,8 +611,13 @@ module Account = let CreateReadOnlyAccounts (watchWalletInfo: WatchWalletInfo): Async = async { - for etherCurrency in Currency.GetAll().Where(fun currency -> currency.IsEtherBased ()) do - do! ValidateAddress etherCurrency watchWalletInfo.EtherPublicAddress + for etherCurrency in Currency + .GetAll() + .Where(fun currency -> currency.IsEtherBased ()) do + do! + ValidateAddress + etherCurrency + watchWalletInfo.EtherPublicAddress let conceptAccountForReadOnlyAccount = { @@ -475,13 +627,18 @@ module Account = Name = watchWalletInfo.EtherPublicAddress Content = fun _ -> String.Empty } - ExtractPublicAddressFromConfigFileFunc = (fun file -> file.Name) + ExtractPublicAddressFromConfigFileFunc = + (fun file -> file.Name) } - Config.AddAccount conceptAccountForReadOnlyAccount AccountKind.ReadOnly + Config.AddAccount + conceptAccountForReadOnlyAccount + AccountKind.ReadOnly |> ignore - for utxoCurrency in Currency.GetAll().Where(fun currency -> currency.IsUtxo ()) do + for utxoCurrency in Currency + .GetAll() + .Where(fun currency -> currency.IsUtxo ()) do let address = UtxoCoin.Account.GetPublicAddressFromPublicKey utxoCurrency @@ -495,12 +652,16 @@ module Account = FileRepresentation = { Name = address - Content = fun _ -> watchWalletInfo.UtxoCoinPublicKey + Content = + fun _ -> watchWalletInfo.UtxoCoinPublicKey } - ExtractPublicAddressFromConfigFileFunc = (fun file -> file.Name) + ExtractPublicAddressFromConfigFileFunc = + (fun file -> file.Name) } - Config.AddAccount conceptAccountForReadOnlyAccount AccountKind.ReadOnly + Config.AddAccount + conceptAccountForReadOnlyAccount + AccountKind.ReadOnly |> ignore } @@ -510,23 +671,28 @@ module Account = let private CreateConceptEtherAccountInternal (password: string) (seed: array) - : Async string)> - = + : Async string)> = async { let! virtualFile = Ether.Account.Create password seed - return virtualFile, Ether.Account.GetPublicAddressFromNormalAccountFile + + return + virtualFile, Ether.Account.GetPublicAddressFromNormalAccountFile } let private CreateConceptAccountInternal (currency: Currency) (password: string) (seed: array) - : Async string)> - = + : Async string)> = async { if currency.IsUtxo () then - let! virtualFile = UtxoCoin.Account.Create currency password seed - return virtualFile, UtxoCoin.Account.GetPublicAddressFromNormalAccountFile currency + let! virtualFile = + UtxoCoin.Account.Create currency password seed + + return + virtualFile, + UtxoCoin.Account.GetPublicAddressFromNormalAccountFile + currency elif currency.IsEtherBased () then return! CreateConceptEtherAccountInternal password seed else @@ -534,76 +700,111 @@ module Account = } - 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 - FileRepresentation = virtualFile - ExtractPublicAddressFromConfigFileFunc = fromEncPrivKeyToPublicAddressFunc - } + return + { + Currency = currency + FileRepresentation = virtualFile + ExtractPublicAddressFromConfigFileFunc = + fromEncPrivKeyToPublicAddressFunc + } } let private CreateConceptAccountAux (currency: Currency) (password: string) (seed: array) - : Async> - = + : Async> = async { let! singleAccount = CreateConceptAccount currency password seed return singleAccount :: List.Empty } - let CreateEtherNormalAccounts (password: string) (seed: array): Async> = - let supportedEtherCurrencies = Currency.GetAll().Where(fun currency -> currency.IsEtherBased ()) + let 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! 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) + + NormalAccount ( + conceptAccount.Currency, + newAccountFile, + conceptAccount.ExtractPublicAddressFromConfigFileFunc + ) let GenerateMasterPrivateKey (passphrase: string) (dobPartOfSalt: DateTime) (emailPartOfSalt: string) - : Async> - = + : Async> = async { let salt = - SPrintF2 "%s+%s" (dobPartOfSalt.Date.ToString ("yyyyMMdd")) (emailPartOfSalt.ToLower ()) + SPrintF2 + "%s+%s" + (dobPartOfSalt.Date.ToString ("yyyyMMdd")) + (emailPartOfSalt.ToLower ()) let privateKeyBytes = WarpKey.CreatePrivateKey passphrase salt return privateKeyBytes } - let CreateAllConceptAccounts (privateKeyBytes: array) (encryptionPassword: string): Async> = + let CreateAllConceptAccounts + (privateKeyBytes: array) + (encryptionPassword: string) + : Async> = async { - let etherAccounts = CreateEtherNormalAccounts encryptionPassword privateKeyBytes - let nonEthCurrencies = Currency.GetAll().Where(fun currency -> not (currency.IsEtherBased ())) + let 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 + yield + CreateConceptAccountAux + nonEthCurrency + encryptionPassword + privateKeyBytes } |> List.ofSeq @@ -623,29 +824,50 @@ module Account = return allConceptAccounts } - let CreateAllAccounts (masterPrivateKeyTask: Task>) (encryptionPassword: string): Async = + let CreateAllAccounts + (masterPrivateKeyTask: Task>) + (encryptionPassword: string) + : Async = async { let! privateKeyBytes = Async.AwaitTask masterPrivateKeyTask - let! allConceptAccounts = CreateAllConceptAccounts privateKeyBytes encryptionPassword + + let! allConceptAccounts = + CreateAllConceptAccounts privateKeyBytes encryptionPassword for conceptAccount in allConceptAccounts do CreateNormalAccount conceptAccount |> ignore } - let CheckValidSeed (passphrase: string) (dobPartOfSalt: DateTime) (emailPartOfSalt: string) = + 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)) + 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) + ) } let WipeAll () = @@ -658,15 +880,20 @@ module Account = let private SerializeUnsignedTransactionPlain (transProposal: UnsignedTransactionProposal) (txMetadata: IBlockchainFeeInfo) - : string - = + : string = let readOnlyAccounts = GetAllActiveAccounts().OfType () match txMetadata with | :? Ether.TransactionMetadata as etherTxMetadata -> - Ether.Account.SaveUnsignedTransaction transProposal etherTxMetadata readOnlyAccounts + Ether.Account.SaveUnsignedTransaction + transProposal + etherTxMetadata + readOnlyAccounts | :? UtxoCoin.TransactionMetadata as btcTxMetadata -> - UtxoCoin.Account.SaveUnsignedTransaction transProposal btcTxMetadata readOnlyAccounts + UtxoCoin.Account.SaveUnsignedTransaction + transProposal + btcTxMetadata + readOnlyAccounts | _ -> failwith "fee type unknown" let SaveUnsignedTransaction @@ -677,47 +904,67 @@ module Account = let json = SerializeUnsignedTransactionPlain transProposal txMetadata File.WriteAllText (filePath, json) - let public ImportUnsignedTransactionFromJson (json: string): UnsignedTransaction = + let public ImportUnsignedTransactionFromJson + (json: string) + : UnsignedTransaction = let transType = Marshalling.ExtractType json match transType with - | _ when transType = typeof> -> + | _ when + transType = typeof> -> let deserializedBtcTransaction: UnsignedTransaction = Marshalling.Deserialize json deserializedBtcTransaction.ToAbstract () - | _ when transType = typeof> -> + | _ when + transType = typeof> -> let deserializedBtcTransaction: UnsignedTransaction = Marshalling.Deserialize json deserializedBtcTransaction.ToAbstract () | unexpectedType -> raise - <| Exception (SPrintF1 "Unknown unsignedTransaction subtype: %s" unexpectedType.FullName) - - let public ImportSignedTransactionFromJson (json: string): SignedTransaction = + <| Exception ( + SPrintF1 + "Unknown unsignedTransaction subtype: %s" + unexpectedType.FullName + ) + + let public ImportSignedTransactionFromJson + (json: string) + : SignedTransaction = let transType = Marshalling.ExtractType json match transType with - | _ when transType = typeof> -> + | _ when + transType = typeof> -> let deserializedBtcTransaction: SignedTransaction = Marshalling.Deserialize json deserializedBtcTransaction.ToAbstract () - | _ when transType = typeof> -> - let deserializedBtcTransaction: SignedTransaction = Marshalling.Deserialize json + | _ when + transType = typeof> -> + let deserializedBtcTransaction: SignedTransaction = + Marshalling.Deserialize json + deserializedBtcTransaction.ToAbstract () | unexpectedType -> raise - <| Exception (SPrintF1 "Unknown signedTransaction subtype: %s" unexpectedType.FullName) + <| Exception ( + SPrintF1 + "Unknown signedTransaction subtype: %s" + unexpectedType.FullName + ) let LoadSignedTransactionFromFile (filePath: string) = let signedTransInJson = File.ReadAllText (filePath) ImportSignedTransactionFromJson signedTransInJson - let LoadUnsignedTransactionFromFile (filePath: string): UnsignedTransaction = + let LoadUnsignedTransactionFromFile + (filePath: string) + : UnsignedTransaction = let unsignedTransInJson = File.ReadAllText (filePath) ImportUnsignedTransactionFromJson unsignedTransInJson diff --git a/src/GWallet.Backend/AccountTypes.fs b/src/GWallet.Backend/AccountTypes.fs index be5cbdf1d..399f2ff82 100644 --- a/src/GWallet.Backend/AccountTypes.fs +++ b/src/GWallet.Backend/AccountTypes.fs @@ -44,9 +44,12 @@ type IAccount = abstract PublicAddress: string [] -type BaseAccount (currency: Currency, - accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string) = +type BaseAccount + ( + currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string + ) = member val AccountFile = accountFile abstract Kind: AccountKind @@ -56,27 +59,36 @@ type BaseAccount (currency: Currency, member val PublicAddress = fromAccountFileToPublicAddress accountFile -type NormalAccount (currency: Currency, - accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string) = - inherit BaseAccount(currency, accountFile, fromAccountFileToPublicAddress) +type NormalAccount + ( + currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string + ) = + inherit BaseAccount (currency, accountFile, fromAccountFileToPublicAddress) member internal __.GetEncryptedPrivateKey () = accountFile.Content () override __.Kind = AccountKind.Normal -type ReadOnlyAccount (currency: Currency, - accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string) = - inherit BaseAccount(currency, accountFile, fromAccountFileToPublicAddress) +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) = - inherit BaseAccount(currency, accountFile, fromAccountFileToPublicAddress) +type ArchivedAccount + ( + currency: Currency, + accountFile: FileRepresentation, + fromAccountFileToPublicAddress: FileRepresentation -> string + ) = + inherit BaseAccount (currency, accountFile, fromAccountFileToPublicAddress) member internal __.GetUnencryptedPrivateKey () = accountFile.Content () diff --git a/src/GWallet.Backend/BlockExplorer.fs b/src/GWallet.Backend/BlockExplorer.fs index b178155cc..6b9341e6d 100644 --- a/src/GWallet.Backend/BlockExplorer.fs +++ b/src/GWallet.Backend/BlockExplorer.fs @@ -25,7 +25,9 @@ module BlockExplorer = "https://gastracker.io/addr/" | Currency.SAI | Currency.DAI -> - SPrintF1 "https://etherscan.io/token/%s?a=" (TokenManager.GetTokenContractAddress account.Currency) + SPrintF1 + "https://etherscan.io/token/%s?a=" + (TokenManager.GetTokenContractAddress account.Currency) Uri (baseUrl + account.PublicAddress) diff --git a/src/GWallet.Backend/Caching.fs b/src/GWallet.Backend/Caching.fs index d50ff4f93..380df57e6 100644 --- a/src/GWallet.Backend/Caching.fs +++ b/src/GWallet.Backend/Caching.fs @@ -37,7 +37,10 @@ type CachedNetworkData = for currencyStr in currencies do match dietCache.Balances.TryFind currencyStr with | None -> () - | Some balance -> yield (Currency.Parse currencyStr), Map.empty.Add (address, (balance, now)) + | Some balance -> + yield + (Currency.Parse currencyStr), + Map.empty.Add (address, (balance, now)) } |> Map.ofSeq @@ -51,8 +54,7 @@ type CachedNetworkData = let rec extractAddressesFromAccounts (acc: Map>) (accounts: List) - : Map> - = + : Map> = match accounts with | [] -> acc | head :: tail -> @@ -62,26 +64,34 @@ type CachedNetworkData = | Some currencies -> currencies let newAcc = - acc.Add (head.PublicAddress, head.Currency.ToString () :: existingCurrenciesForHeadAddress) + acc.Add ( + head.PublicAddress, + head.Currency.ToString () + :: existingCurrenciesForHeadAddress + ) extractAddressesFromAccounts newAcc tail let fiatPrices = [ - for (KeyValue (currency, (price, _))) in self.UsdPrice -> currency.ToString (), price + 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)) + (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 + if readOnlyAccounts.Any (fun account -> + (account :> IAccount).PublicAddress = address + ) then yield (currency.ToString (), balance) } |> Map.ofSeq @@ -103,15 +113,25 @@ module Caching = let private GetCacheDir () = let configPath = Config.GetConfigDirForThisProgram().FullName let configDir = DirectoryInfo (Path.Combine (configPath, "cache")) + if not configDir.Exists then configDir.Create () + configDir let private defaultCacheFiles = { - CachedNetworkData = FileInfo (Path.Combine (GetCacheDir().FullName, "networkdata.json")) + CachedNetworkData = + FileInfo ( + Path.Combine (GetCacheDir().FullName, "networkdata.json") + ) ServerStats = - FileInfo (Path.Combine (GetCacheDir().FullName, ServerRegistry.ServersEmbeddedResourceFileName)) + FileInfo ( + Path.Combine ( + GetCacheDir().FullName, + ServerRegistry.ServersEmbeddedResourceFileName + ) + ) } let public ImportFromJson<'T> (cacheData: string): 'T = @@ -119,12 +139,14 @@ module Caching = let private LoadFromDiskInner (file: FileInfo): Option = let json = File.ReadAllText file.FullName + if String.IsNullOrWhiteSpace json then None else Some json - let droppedCachedMsgWarning = "Warning: cleaning incompatible cache data found from different GWallet version" + let droppedCachedMsgWarning = + "Warning: cleaning incompatible cache data found from different GWallet version" let private LoadFromDiskInternal<'T> (file: FileInfo): Option<'T> = try @@ -140,8 +162,13 @@ module Caching = None | :? DeserializationException -> // FIXME: report a warning to sentry here... - Infrastructure.LogError "Warning: cleaning incompatible cache data found" - Infrastructure.LogDebug (SPrintF1 "JSON content: <<<%s>>>" json) + Infrastructure.LogError + "Warning: cleaning incompatible cache data found" + + Infrastructure.LogDebug ( + SPrintF1 "JSON content: <<<%s>>>" json + ) + None with :? FileNotFoundException -> None @@ -150,20 +177,26 @@ module Caching = let private WeirdNullCheckToDetectVersionConflicts x = Object.ReferenceEquals (x, null) - let private LoadFromDisk (files: CacheFiles): bool * CachedNetworkData * ServerRanking = - let maybeNetworkData = LoadFromDiskInternal files.CachedNetworkData + let private LoadFromDisk + (files: CacheFiles) + : bool * CachedNetworkData * ServerRanking = + let maybeNetworkData = + LoadFromDiskInternal files.CachedNetworkData let maybeFirstRun, resultingNetworkData = match maybeNetworkData with | None -> true, CachedNetworkData.Empty | Some networkData -> - if WeirdNullCheckToDetectVersionConflicts networkData.OutgoingTransactions then + if WeirdNullCheckToDetectVersionConflicts + networkData.OutgoingTransactions then Infrastructure.LogError droppedCachedMsgWarning true, CachedNetworkData.Empty else false, networkData - let maybeServerStats = LoadFromDiskInternal files.ServerStats + let maybeServerStats = + LoadFromDiskInternal files.ServerStats + match maybeServerStats with | None -> maybeFirstRun, resultingNetworkData, Map.empty | Some serverStats -> false, resultingNetworkData, serverStats @@ -178,6 +211,7 @@ module Caching = | [] -> accumulator | address :: tail -> let maybeCachedBalance = Map.tryFind address oldMap + match maybeCachedBalance with | None -> let newCachedBalance = newMap.[address] @@ -194,7 +228,10 @@ module Caching = MergeRatesInternal oldMap newMap tail newAcc - let private MergeRates (oldMap: Map<'K, CachedValue<'V>>) (newMap: Map<'K, CachedValue<'V>>) = + 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 @@ -203,25 +240,39 @@ module Caching = (newMap: Map>>) (addressList: List) (accumulator: Map>>) - : Map>> - = + : Map>> = match addressList with | [] -> accumulator | (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) -> let accBalancesForThisCurrency = accumulator.[currency] - let maybeCachedBalance = Map.tryFind address balancesMapForCurrency + + let maybeCachedBalance = + Map.tryFind address balancesMapForCurrency + match maybeCachedBalance with | None -> let newCachedBalance = newMap.[currency].[address] - let newAccBalances = accBalancesForThisCurrency.Add (address, newCachedBalance) + + let newAccBalances = + accBalancesForThisCurrency.Add ( + address, + newCachedBalance + ) + let newAcc = accumulator.Add (currency, newAccBalances) MergeBalancesInternal oldMap newMap tail newAcc | Some (_, time) -> @@ -229,7 +280,12 @@ module Caching = let newAcc = if (newTime > time) then - let newAccBalances = accBalancesForThisCurrency.Add (address, (newBalance, newTime)) + let newAccBalances = + accBalancesForThisCurrency.Add ( + address, + (newBalance, newTime) + ) + accumulator.Add (currency, newAccBalances) else accumulator @@ -239,8 +295,7 @@ module Caching = let private MergeBalances (oldMap: Map>>) (newMap: Map>>) - : Map>> - = + : Map>> = let addressList = seq { for currency, subMap in Map.toList newMap do @@ -263,10 +318,16 @@ module Caching = 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 @@ -276,7 +337,10 @@ module Caching = let networkDataInJson = Marshalling.Serialize newCachedData // it is assumed that SaveToDisk is being run under a lock() block - File.WriteAllText (cacheFiles.CachedNetworkData.FullName, networkDataInJson) + File.WriteAllText ( + cacheFiles.CachedNetworkData.FullName, + networkDataInJson + ) // we return back the rankings because the serialization process could remove dupes (and deserialization time // is basically negligible, i.e. took 15 milliseconds max in my MacBook in Debug mode) @@ -284,7 +348,10 @@ module Caching = let serverStatsInJson = ServerRegistry.Serialize serverStats // it is assumed that SaveToDisk is being run under a lock() block - File.WriteAllText (cacheFiles.ServerStats.FullName, serverStatsInJson) + File.WriteAllText ( + cacheFiles.ServerStats.FullName, + serverStatsInJson + ) match LoadFromDiskInternal cacheFiles.ServerStats with | None -> failwith "should return something after having saved it" @@ -293,17 +360,22 @@ module Caching = let InitServers (lastServerStats: ServerRanking) = let mergedServers = ServerRegistry.MergeWithBaseline lastServerStats let mergedAndSaved = SaveServerRankingsToDisk mergedServers + for KeyValue (currency, servers) in mergedAndSaved do for server in servers do if server.CommunicationHistory.IsNone then - Infrastructure.LogError - (SPrintF2 + Infrastructure.LogError ( + SPrintF2 "WARNING: no history stats about %A server %s" - currency - server.ServerInfo.NetworkPath) + currency + server.ServerInfo.NetworkPath + ) + mergedServers - let firstRun, initialSessionCachedNetworkData, lastServerStats = LoadFromDisk cacheFiles + let firstRun, initialSessionCachedNetworkData, lastServerStats = + LoadFromDisk cacheFiles + let initialServerStats = InitServers lastServerStats let mutable sessionCachedNetworkData = initialSessionCachedNetworkData @@ -313,14 +385,15 @@ module Caching = (trans: Map>>>) currency address - : decimal - = + : decimal = let now = DateTime.UtcNow let currencyTrans = trans.TryFind currency + match currencyTrans with | None -> 0m | Some someMap -> let addressTrans = someMap.TryFind address + match addressTrans with | None -> 0m | Some someMap -> @@ -330,299 +403,468 @@ module Caching = if (now < txDate + unconfTxExpirationSpan) then txAmount else - 0m) + 0m + ) let rec RemoveRangeFromMap (map: Map<'K, 'V>) (list: List<'K * 'V>) = match list with | [] -> map | (key, _) :: tail -> RemoveRangeFromMap (map.Remove key) tail - let GatherDebuggingInfo (previousBalance) (currency) (address) (newCache) = + 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) - let ReportProblem (negativeBalance: decimal) (previousBalance) (currency) (address) (newCache) = - Infrastructure.ReportError - (SPrintF2 + let ReportProblem + (negativeBalance: decimal) + (previousBalance) + (currency) + (address) + (newCache) + = + Infrastructure.ReportError ( + SPrintF2 "Negative balance '%s'. Details: %s" - (negativeBalance.ToString ()) - (GatherDebuggingInfo previousBalance currency address newCache)) + (negativeBalance.ToString ()) + (GatherDebuggingInfo + previousBalance + currency + address + newCache) + ) member __.ClearAll () = SaveNetworkDataToDisk CachedNetworkData.Empty SaveServerRankingsToDisk Map.empty |> ignore 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 - } + let newCachedData = + CachedNetworkData.FromDietCache newDietCachedData + + lock + cacheFiles.CachedNetworkData + (fun _ -> + let newSessionCachedNetworkData = + let mergedBalances = + MergeBalances + sessionCachedNetworkData.Balances + newCachedData.Balances + + let mergedUsdPrices = + MergeRates + sessionCachedNetworkData.UsdPrice + newCachedData.UsdPrice + + { sessionCachedNetworkData with + UsdPrice = mergedUsdPrices + Balances = mergedBalances + } - sessionCachedNetworkData <- newSessionCachedNetworkData - SaveNetworkDataToDisk newSessionCachedNetworkData) + sessionCachedNetworkData <- 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) - with - // FIXME: rather use tryFind func instead of using a try-with block - :? 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 <- newCachedValue - - SaveNetworkDataToDisk newCachedValue) - - member __.RetrieveLastCompoundBalance (address: PublicAddress) (currency: Currency): NotFresh = - lock cacheFiles.CachedNetworkData (fun _ -> - let balance = + lock + cacheFiles.CachedNetworkData + (fun _ -> try - Cached ((sessionCachedNetworkData.Balances.Item currency).Item address) + Cached (sessionCachedNetworkData.UsdPrice.Item currency) with - // FIXME: rather use tryFind func instead of using a try-with block - :? System.Collections.Generic.KeyNotFoundException -> NotAvailable + // FIXME: rather use tryFind func instead of using a try-with block + :? 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) + ) + } - match balance with - | NotAvailable -> NotAvailable - | Cached (balance, time) -> - let allTransSum = - GetSumOfAllTransactions sessionCachedNetworkData.OutgoingTransactions currency address + sessionCachedNetworkData <- newCachedValue + + SaveNetworkDataToDisk newCachedValue + ) + + member __.RetrieveLastCompoundBalance + (address: PublicAddress) + (currency: Currency) + : NotFresh = + lock + cacheFiles.CachedNetworkData + (fun _ -> + let balance = + try + Cached ( + (sessionCachedNetworkData.Balances.Item currency).Item + address + ) + with + // FIXME: rather use tryFind func instead of using a try-with block + :? System.Collections.Generic.KeyNotFoundException -> + NotAvailable + + match balance with + | NotAvailable -> NotAvailable + | Cached (balance, time) -> + let allTransSum = + GetSumOfAllTransactions + sessionCachedNetworkData.OutgoingTransactions + currency + address + + let compoundBalance = balance - allTransSum + + if (compoundBalance < 0.0m) then + ReportProblem + compoundBalance + None + currency + address + sessionCachedNetworkData + + Cached (0.0m, time) + else + Cached (compoundBalance, time) + ) - let compoundBalance = balance - allTransSum - if (compoundBalance < 0.0m) then - ReportProblem compoundBalance None currency address sessionCachedNetworkData - Cached (0.0m, time) - else - Cached (compoundBalance, time)) + member self.TryRetrieveLastCompoundBalance + (address: PublicAddress) + (currency: Currency) + : Option = + let maybeCachedBalance = + self.RetrieveLastCompoundBalance address currency - member self.TryRetrieveLastCompoundBalance (address: PublicAddress) (currency: Currency): Option = - let maybeCachedBalance = self.RetrieveLastCompoundBalance address currency match maybeCachedBalance with | NotAvailable -> None | Cached (cachedBalance, _) -> Some cachedBalance - member __.RetrieveAndUpdateLastCompoundBalance (address: PublicAddress) - (currency: Currency) - (newBalance: decimal) - : CachedValue = + member __.RetrieveAndUpdateLastCompoundBalance + (address: PublicAddress) + (currency: Currency) + (newBalance: decimal) + : CachedValue = let time = DateTime.UtcNow - lock cacheFiles.CachedNetworkData (fun _ -> - let newCachedValueWithNewBalance, previousBalance = - let newCurrencyBalances, previousBalance = - match sessionCachedNetworkData.Balances.TryFind currency with - | None -> Map.empty, None - | Some currencyBalances -> - let maybePreviousBalance = currencyBalances.TryFind address - currencyBalances, maybePreviousBalance - - { sessionCachedNetworkData with - Balances = - sessionCachedNetworkData.Balances.Add - (currency, newCurrencyBalances.Add (address, (newBalance, time))) - }, - previousBalance - - let newCachedValueWithNewBalanceAndMaybeLessTransactions = - let maybeNewValue = - FSharpUtil.option { - let! previousCachedBalance, _ = previousBalance - - do! if newBalance <> previousCachedBalance && previousCachedBalance > newBalance then - Some () - else - None - - let! currencyAddresses = newCachedValueWithNewBalance.OutgoingTransactions.TryFind currency - - let! addressTransactions = currencyAddresses.TryFind address - let allCombinationsOfTransactions = MapCombinations addressTransactions - - let newAddressTransactions = - match List.tryFind (fun combination -> - let txSumAmount = List.sumBy (fun (_, (txAmount, _)) -> txAmount) combination - previousCachedBalance - txSumAmount = newBalance) - allCombinationsOfTransactions with - | None -> addressTransactions - | Some combination -> RemoveRangeFromMap addressTransactions combination - - let newOutgoingTransactions = - newCachedValueWithNewBalance.OutgoingTransactions.Add - (currency, currencyAddresses.Add (address, newAddressTransactions)) - - return { newCachedValueWithNewBalance with - OutgoingTransactions = newOutgoingTransactions - } - } - match maybeNewValue with - | None -> newCachedValueWithNewBalance - | Some x -> x + lock + cacheFiles.CachedNetworkData + (fun _ -> + let newCachedValueWithNewBalance, previousBalance = + let newCurrencyBalances, previousBalance = + match sessionCachedNetworkData.Balances.TryFind + currency with + | None -> Map.empty, None + | Some currencyBalances -> + let maybePreviousBalance = + currencyBalances.TryFind address + + currencyBalances, maybePreviousBalance + + { sessionCachedNetworkData with + Balances = + sessionCachedNetworkData.Balances.Add ( + currency, + newCurrencyBalances.Add ( + address, + (newBalance, time) + ) + ) + }, + previousBalance - sessionCachedNetworkData <- newCachedValueWithNewBalanceAndMaybeLessTransactions + let newCachedValueWithNewBalanceAndMaybeLessTransactions = + let maybeNewValue = + FSharpUtil.option { + let! previousCachedBalance, _ = previousBalance + + do! + if newBalance <> previousCachedBalance + && previousCachedBalance > newBalance then + Some () + else + None + + let! currencyAddresses = + newCachedValueWithNewBalance.OutgoingTransactions.TryFind + currency + + let! addressTransactions = + currencyAddresses.TryFind address + + let allCombinationsOfTransactions = + MapCombinations addressTransactions + + let newAddressTransactions = + match List.tryFind + (fun combination -> + let txSumAmount = + List.sumBy + (fun (_, (txAmount, _)) -> + txAmount + ) + combination + + previousCachedBalance + - txSumAmount = newBalance + ) + allCombinationsOfTransactions with + | None -> addressTransactions + | Some combination -> + RemoveRangeFromMap + addressTransactions + combination + + let newOutgoingTransactions = + newCachedValueWithNewBalance.OutgoingTransactions.Add ( + currency, + currencyAddresses.Add ( + address, + newAddressTransactions + ) + ) + + return + { newCachedValueWithNewBalance with + OutgoingTransactions = + newOutgoingTransactions + } + } + + match maybeNewValue with + | None -> newCachedValueWithNewBalance + | Some x -> x + + sessionCachedNetworkData <- + newCachedValueWithNewBalanceAndMaybeLessTransactions - SaveNetworkDataToDisk newCachedValueWithNewBalanceAndMaybeLessTransactions + SaveNetworkDataToDisk + newCachedValueWithNewBalanceAndMaybeLessTransactions - let allTransSum = - GetSumOfAllTransactions - newCachedValueWithNewBalanceAndMaybeLessTransactions.OutgoingTransactions - currency - address + let allTransSum = + GetSumOfAllTransactions + newCachedValueWithNewBalanceAndMaybeLessTransactions.OutgoingTransactions + currency + address - let compoundBalance = newBalance - allTransSum - if (compoundBalance < 0.0m) then - ReportProblem - compoundBalance - previousBalance - currency - address - newCachedValueWithNewBalanceAndMaybeLessTransactions - 0.0m, time - else - compoundBalance, time) + let compoundBalance = newBalance - allTransSum - member private __.StoreTransactionRecord (address: PublicAddress) - (currency: Currency) - (txId: string) - (amount: decimal) - : unit = + if (compoundBalance < 0.0m) then + ReportProblem + compoundBalance + previousBalance + currency + address + newCachedValueWithNewBalanceAndMaybeLessTransactions + + 0.0m, time + else + compoundBalance, time + ) + + member private __.StoreTransactionRecord + (address: PublicAddress) + (currency: Currency) + (txId: string) + (amount: decimal) + : unit = let time = DateTime.UtcNow - lock cacheFiles.CachedNetworkData (fun _ -> - let newCurrencyAddresses = - match sessionCachedNetworkData.OutgoingTransactions.TryFind currency with - | None -> Map.empty - | Some currencyAddresses -> currencyAddresses - - let newAddressTransactions = - match newCurrencyAddresses.TryFind address with - | None -> Map.empty.Add (txId, (amount, time)) - | Some addressTransactions -> addressTransactions.Add (txId, (amount, time)) - - let newOutgoingTxs = - sessionCachedNetworkData.OutgoingTransactions.Add - (currency, newCurrencyAddresses.Add (address, newAddressTransactions)) - - let newCachedValue = - { sessionCachedNetworkData with - OutgoingTransactions = newOutgoingTxs - } - sessionCachedNetworkData <- newCachedValue + lock + cacheFiles.CachedNetworkData + (fun _ -> + let newCurrencyAddresses = + match sessionCachedNetworkData.OutgoingTransactions.TryFind + currency with + | None -> Map.empty + | Some currencyAddresses -> currencyAddresses + + let newAddressTransactions = + match newCurrencyAddresses.TryFind address with + | None -> Map.empty.Add (txId, (amount, time)) + | Some addressTransactions -> + addressTransactions.Add (txId, (amount, time)) + + let newOutgoingTxs = + sessionCachedNetworkData.OutgoingTransactions.Add ( + currency, + newCurrencyAddresses.Add ( + address, + newAddressTransactions + ) + ) + + let newCachedValue = + { sessionCachedNetworkData with + OutgoingTransactions = newOutgoingTxs + } + + sessionCachedNetworkData <- newCachedValue - SaveNetworkDataToDisk newCachedValue) + SaveNetworkDataToDisk newCachedValue + ) - member self.StoreOutgoingTransaction (address: PublicAddress) - (transactionCurrency: Currency) - (feeCurrency: Currency) - (txId: string) - (amount: decimal) - (feeAmount: decimal) - : unit = + member self.StoreOutgoingTransaction + (address: PublicAddress) + (transactionCurrency: Currency) + (feeCurrency: Currency) + (txId: string) + (amount: decimal) + (feeAmount: decimal) + : unit = self.StoreTransactionRecord address transactionCurrency txId amount - if transactionCurrency - <> feeCurrency + + if transactionCurrency <> feeCurrency && (not Config.EthTokenEstimationCouldBeBuggyAsInNotAccurate) then self.StoreTransactionRecord address feeCurrency txId feeAmount - member __.SaveServerLastStat (serverMatchFunc: ServerDetails -> bool) (stat: HistoryFact): unit = - lock cacheFiles.ServerStats (fun _ -> - let currency, serverInfo, previousLastSuccessfulCommunication = - match ServerRegistry.TryFindValue sessionServerRanking serverMatchFunc with - | None -> failwith "Merge&Save didn't happen before launching the FaultTolerantPClient?" - | Some (currency, server) -> - match server.CommunicationHistory with - | None -> currency, server.ServerInfo, None - | Some (prevHistoryInfo, lastComm) -> - match prevHistoryInfo.Status with - | Success -> currency, server.ServerInfo, Some lastComm - | Fault faultInfo -> currency, server.ServerInfo, faultInfo.LastSuccessfulCommunication - - let now = DateTime.Now - - let newHistoryInfo: CachedValue = - match stat.Fault with - | None -> - ({ - TimeSpan = stat.TimeSpan - Status = Success - }, - now) - | Some exInfo -> - ({ - TimeSpan = stat.TimeSpan - Status = - Fault - { - Exception = exInfo - LastSuccessfulCommunication = previousLastSuccessfulCommunication - } - }, - now) - - let newServerDetails = - { - ServerInfo = serverInfo - CommunicationHistory = Some newHistoryInfo - } + member __.SaveServerLastStat + (serverMatchFunc: ServerDetails -> bool) + (stat: HistoryFact) + : unit = + lock + cacheFiles.ServerStats + (fun _ -> + let (currency, + serverInfo, + previousLastSuccessfulCommunication) = + match ServerRegistry.TryFindValue + sessionServerRanking + serverMatchFunc with + | None -> + failwith + "Merge&Save didn't happen before launching the FaultTolerantPClient?" + | Some (currency, server) -> + match server.CommunicationHistory with + | None -> currency, server.ServerInfo, None + | Some (prevHistoryInfo, lastComm) -> + match prevHistoryInfo.Status with + | Success -> + currency, server.ServerInfo, Some lastComm + | Fault faultInfo -> + currency, + server.ServerInfo, + faultInfo.LastSuccessfulCommunication + + let now = DateTime.Now + + let newHistoryInfo: CachedValue = + match stat.Fault with + | None -> + ({ + TimeSpan = stat.TimeSpan + Status = Success + }, + now) + | Some exInfo -> + ({ + TimeSpan = stat.TimeSpan + Status = + Fault + { + Exception = exInfo + LastSuccessfulCommunication = + previousLastSuccessfulCommunication + } + }, + now) + + let newServerDetails = + { + ServerInfo = serverInfo + CommunicationHistory = Some newHistoryInfo + } - let serversForCurrency = - match sessionServerRanking.TryFind currency with - | None -> Seq.empty - | Some servers -> servers + let serversForCurrency = + match sessionServerRanking.TryFind currency with + | None -> Seq.empty + | Some servers -> servers - let newServersForCurrency = Seq.append (seq { yield newServerDetails }) serversForCurrency + let newServersForCurrency = + Seq.append + (seq { yield newServerDetails }) + serversForCurrency - let newServerList = sessionServerRanking.Add (currency, newServersForCurrency) + let newServerList = + sessionServerRanking.Add ( + currency, + newServersForCurrency + ) - let newCachedValue = SaveServerRankingsToDisk newServerList - sessionServerRanking <- newCachedValue) + let newCachedValue = SaveServerRankingsToDisk newServerList + sessionServerRanking <- newCachedValue + ) member __.GetServers (currency: Currency): seq = - lock cacheFiles.ServerStats (fun _ -> - match sessionServerRanking.TryFind currency with - | None -> - failwith - <| SPrintF1 "Initialization of servers' cache failed? currency %A not found" currency - | Some servers -> servers) + lock + cacheFiles.ServerStats + (fun _ -> + match sessionServerRanking.TryFind currency with + | None -> + failwith + <| SPrintF1 + "Initialization of servers' cache failed? currency %A not found" + currency + | Some servers -> servers + ) member __.ExportServers (): Option = - lock cacheFiles.ServerStats (fun _ -> LoadFromDiskInner cacheFiles.ServerStats) + lock + cacheFiles.ServerStats + (fun _ -> LoadFromDiskInner cacheFiles.ServerStats + ) member __.BootstrapServerStatsFromTrustedSource (): Async = let downloadFile url: Async> = let tryDownloadFile url: Async = async { - use httpClient = new HttpClient() + use httpClient = new HttpClient () let uri = Uri url - let! response = Async.AwaitTask (httpClient.GetAsync uri) + + 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) + Infrastructure.LogError ( + "WARNING: error trying to retrieve server stats: " + + content + ) return failwith content } @@ -632,10 +874,10 @@ module Caching = let! content = tryDownloadFile url return Some content with - // should we specify HttpRequestException? - ex -> - Infrastructure.ReportWarning ex - return None + // should we specify HttpRequestException? + ex -> + Infrastructure.ReportWarning ex + return None } let targetBranch = "frontend" @@ -644,17 +886,41 @@ module Caching = let projName = "geewallet" 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 + "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 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 @@ -667,10 +933,17 @@ module Caching = 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) + let lastServerStats = + ImportFromJson lastServerStatsInJson + + lock + cacheFiles.ServerStats + (fun _ -> + let savedServerStats = + SaveServerRankingsToDisk lastServerStats + + sessionServerRanking <- savedServerStats + ) } member __.FirstRun = firstRun diff --git a/src/GWallet.Backend/Config.fs b/src/GWallet.Backend/Config.fs index 52295f3ee..f13cdd4fa 100644 --- a/src/GWallet.Backend/Config.fs +++ b/src/GWallet.Backend/Config.fs @@ -63,12 +63,16 @@ module Config = 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) + 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 + let simpleVersion = + fullVersion.Substring (0, fullVersion.IndexOf (' ')) |> Version return simpleVersion } @@ -81,17 +85,25 @@ module Config = let internal NUMBER_OF_RETRIES_TO_SAME_SERVERS = 3u let internal GetConfigDirForThisProgram () = - let configPath = Environment.GetFolderPath (Environment.SpecialFolder.ApplicationData) + let configPath = + Environment.GetFolderPath ( + Environment.SpecialFolder.ApplicationData + ) + let configDir = DirectoryInfo (Path.Combine (configPath, "gwallet")) + if not configDir.Exists then configDir.Create () + configDir let private GetConfigDirForAccounts () = let configPath = GetConfigDirForThisProgram().FullName let configDir = DirectoryInfo (Path.Combine (configPath, "accounts")) + if not configDir.Exists then configDir.Create () + configDir let private GetConfigDir (currency: Currency) (accountKind: AccountKind) = @@ -100,13 +112,17 @@ module Config = let baseConfigDir = match accountKind with | AccountKind.Normal -> accountConfigDir - | AccountKind.ReadOnly -> Path.Combine (accountConfigDir, "readonly") - | AccountKind.Archived -> Path.Combine (accountConfigDir, "archived") + | AccountKind.ReadOnly -> + Path.Combine (accountConfigDir, "readonly") + | AccountKind.Archived -> + Path.Combine (accountConfigDir, "archived") - let configDir = Path.Combine (baseConfigDir, currency.ToString ()) |> DirectoryInfo + let configDir = + Path.Combine (baseConfigDir, currency.ToString ()) |> DirectoryInfo if not configDir.Exists then configDir.Create () + configDir // In case a new token was added it will not have a config for an existing user @@ -114,35 +130,59 @@ module Config = let PropagateEthAccountInfoToMissingTokensAccounts () = for accountKind in (AccountKind.All ()) do let ethConfigDir = GetConfigDir Currency.ETH accountKind + 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) + + for ethAccountFilePath in Directory.GetFiles + ethConfigDir.FullName do + let newPath = + ethAccountFilePath.Replace ( + ethConfigDir.FullName, + tokenConfigDir.FullName + ) + if not (File.Exists newPath) then File.Copy (ethAccountFilePath, newPath) - let GetAccountFiles (currencies: seq) (accountKind: AccountKind): seq = + let GetAccountFiles + (currencies: seq) + (accountKind: AccountKind) + : seq = seq { for currency in currencies do - for filePath in Directory.GetFiles (GetConfigDir currency accountKind).FullName do + for filePath in Directory.GetFiles + (GetConfigDir currency accountKind).FullName do yield FileRepresentation.FromFile (FileInfo (filePath)) } let private GetFile (currency: Currency) (account: BaseAccount): FileInfo = - let configDir, fileName = GetConfigDir currency account.Kind, account.AccountFile.Name + let configDir, fileName = + GetConfigDir currency account.Kind, account.AccountFile.Name + Path.Combine (configDir.FullName, fileName) |> FileInfo - let AddAccount (conceptAccount: ConceptAccount) (accountKind: AccountKind): FileRepresentation = + let AddAccount + (conceptAccount: ConceptAccount) + (accountKind: AccountKind) + : FileRepresentation = let configDir = GetConfigDir conceptAccount.Currency accountKind let newAccountFile = - Path.Combine (configDir.FullName, conceptAccount.FileRepresentation.Name) + 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 @@ -156,9 +196,12 @@ module Config = // 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 + if not configFile.Exists then failwith - <| SPrintF1 "File %s doesn't exist. Please report this issue." configFile.FullName + <| SPrintF1 + "File %s doesn't exist. Please report this issue." + configFile.FullName else configFile.Delete () @@ -171,7 +214,9 @@ module Config = let ExtractEmbeddedResourceFileContents resourceName = 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) + + use reader = new StreamReader (stream) reader.ReadToEnd () diff --git a/src/GWallet.Backend/Currency.fs b/src/GWallet.Backend/Currency.fs index 2cca5df30..b57f283fd 100644 --- a/src/GWallet.Backend/Currency.fs +++ b/src/GWallet.Backend/Currency.fs @@ -38,7 +38,9 @@ type Currency = #endif static member Parse (currencyString: string): Currency = - Currency.GetAll().First(fun currency -> currencyString = currency.ToString ()) + Currency + .GetAll() + .First(fun currency -> currencyString = currency.ToString ()) member self.IsEther () = self = Currency.ETC || self = Currency.ETH @@ -60,7 +62,8 @@ type Currency = elif self = Currency.SAI then 18 else - failwith <| SPrintF1 "Unable to determine decimal places for %A" self + failwith + <| SPrintF1 "Unable to determine decimal places for %A" self override self.ToString () = #if STRICTER_COMPILATION_BUT_WITH_REFLECTION_AT_RUNTIME @@ -80,12 +83,17 @@ type Currency = // the reason we have used "and" is because of the circular reference // between StringTypeConverter and Currency and private StringTypeConverter () = - inherit TypeConverter() + inherit TypeConverter () 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 + | :? 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 f44526b0e..cac249ade 100644 --- a/src/GWallet.Backend/Ether/EtherAccount.fs +++ b/src/GWallet.Backend/Ether/EtherAccount.fs @@ -25,9 +25,13 @@ module internal Account = let GetPublicAddressFromUnencryptedPrivateKey (privateKey: string) = EthECKey(privateKey).GetPublicAddress() - let internal GetPublicAddressFromNormalAccountFile (accountFile: FileRepresentation): string = + let internal GetPublicAddressFromNormalAccountFile + (accountFile: FileRepresentation) + : string = let encryptedPrivateKey = accountFile.Content () - let rawPublicAddress = KeyStoreService.GetAddressFromKeyStore encryptedPrivateKey + + let rawPublicAddress = + KeyStoreService.GetAddressFromKeyStore encryptedPrivateKey let publicAddress = if (rawPublicAddress.StartsWith ("0x")) then @@ -37,14 +41,32 @@ module internal Account = publicAddress - let internal GetAccountFromFile (accountFile: FileRepresentation) (currency: Currency) kind: IAccount = + 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 + <| 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 + 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 @@ -56,12 +78,24 @@ module internal Account = async { let! balance = if (account.Currency.IsEther ()) then - Server.GetEtherBalance account.Currency account.PublicAddress balType mode cancelSourceOption + Server.GetEtherBalance + account.Currency + account.PublicAddress + balType + mode + cancelSourceOption elif (account.Currency.IsEthToken ()) then - Server.GetTokenBalance account.Currency account.PublicAddress balType mode cancelSourceOption + Server.GetTokenBalance + account.Currency + account.PublicAddress + balType + mode + cancelSourceOption else failwith - <| SPrintF1 "Assertion failed: currency %A should be Ether or Ether token" account.Currency + <| SPrintF1 + "Assertion failed: currency %A should be Ether or Ether token" + account.Currency return balance } @@ -71,32 +105,47 @@ module internal Account = (balType: BalanceType) (mode: ServerSelectionMode) (cancelSourceOption: Option) - : Async> - = + : Async> = async { try - let! balance = GetBalance account mode balType cancelSourceOption + 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> = + : Async> = + let getBalanceWithoutCaching + (maybeUnconfirmedBalanceTaskAlreadyStarted: Option>>) + : Async> = async { - let! confirmed = GetBalanceFromServer account BalanceType.Confirmed mode cancelSourceOption + 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 -> @@ -111,15 +160,29 @@ module internal Account = if Caching.Instance.FirstRun then return! getBalanceWithoutCaching None else - let unconfirmedJob = GetBalanceFromServer account BalanceType.Confirmed mode cancelSourceOption + let unconfirmedJob = + GetBalanceFromServer + account + BalanceType.Confirmed + mode + cancelSourceOption + let! cancellationToken = Async.CancellationToken - let unconfirmedTask = Async.StartAsTask (unconfirmedJob, ?cancellationToken = Some cancellationToken) + + let unconfirmedTask = + Async.StartAsTask ( + unconfirmedJob, + ?cancellationToken = Some cancellationToken + ) let maybeCachedBalance = - Caching.Instance.RetrieveLastCompoundBalance account.PublicAddress account.Currency + Caching.Instance.RetrieveLastCompoundBalance + account.PublicAddress + account.Currency match maybeCachedBalance with - | NotAvailable -> return! getBalanceWithoutCaching (Some unconfirmedTask) + | NotAvailable -> + return! getBalanceWithoutCaching (Some unconfirmedTask) | Cached (cachedBalance, _) -> let! unconfirmed = Async.AwaitTask unconfirmedTask @@ -128,8 +191,10 @@ module internal Account = 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) = @@ -146,23 +211,33 @@ module internal Account = if (address.Length <> ETHEREUM_ADDRESSES_LENGTH) then raise <| AddressWithInvalidLength [ ETHEREUM_ADDRESSES_LENGTH ] - do! Ether.Server.CheckIfAddressIsAValidPaymentDestination currency address + do! + Ether.Server.CheckIfAddressIsAValidPaymentDestination + currency + address if (not (addressUtil.IsChecksumAddress (address))) then - let validCheckSumAddress = addressUtil.ConvertToChecksumAddress (address) + let validCheckSumAddress = + addressUtil.ConvertToChecksumAddress (address) + raise (AddressWithInvalidChecksum (Some validCheckSumAddress)) } - let private GetTransactionCount (currency: Currency) (publicAddress: string): Async = + let private GetTransactionCount + (currency: Currency) + (publicAddress: string) + : Async = async { - let! result = Ether.Server.GetTransactionCount currency publicAddress + 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 ()) + (result.ToString ()) let int64result: Int64 = BigInteger.op_Explicit value @@ -177,7 +252,7 @@ module internal Account = failwith <| SPrintF1 "Serialization doesn't support such a big integer (%s) for the gas, please report this issue." - (gasPrice.Value.ToString ()) + (gasPrice.Value.ToString ()) let gasPrice64: Int64 = BigInteger.op_Explicit gasPrice.Value @@ -186,30 +261,44 @@ module internal Account = let private GAS_COST_FOR_A_NORMAL_ETHER_TRANSACTION: int64 = 21000L - let EstimateEtherTransferFee (account: IAccount) (amount: TransferAmount): Async = + 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) + 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 + if (amount.ValueToSend <> amount.BalanceAtTheMomentOfSending + && feeValue > (amount.BalanceAtTheMomentOfSending + - amount.ValueToSend)) then raise <| InsufficientBalanceForFee (Some feeValue) - return { - Ether.Fee = ethMinerFee - Ether.TransactionCount = txCount - } + return + { + Ether.Fee = ethMinerFee + Ether.TransactionCount = txCount + } } // FIXME: this should raise InsufficientBalanceForFee - let EstimateTokenTransferFee (account: IAccount) amount destination: Async = + let EstimateTokenTransferFee + (account: IAccount) + amount + destination + : Async = async { let! gasPrice64 = GetGasPrice account.Currency @@ -219,49 +308,69 @@ module internal Account = | SAI -> ETH | _ -> failwith <| SPrintF1 "Unknown token %A" account.Currency - let! tokenTransferFee = Ether.Server.EstimateTokenTransferFee account amount destination + 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 ()) + (tokenTransferFee.Value.ToString ()) let gasCost64: Int64 = BigInteger.op_Explicit tokenTransferFee.Value - let ethMinerFee = MinerFee (gasCost64, gasPrice64, DateTime.UtcNow, baseCurrency) + let ethMinerFee = + MinerFee (gasCost64, gasPrice64, DateTime.UtcNow, baseCurrency) - let! txCount = GetTransactionCount account.Currency account.PublicAddress + let! txCount = + GetTransactionCount account.Currency account.PublicAddress - return { - Ether.Fee = ethMinerFee - Ether.TransactionCount = txCount - } + return + { + Ether.Fee = ethMinerFee + Ether.TransactionCount = txCount + } } - let EstimateFee (account: IAccount) (amount: TransferAmount) destination: Async = + 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 + return! + EstimateTokenTransferFee + account + amount.ValueToSend + destination else - return failwith - <| SPrintF1 "Assertion failed: currency %A should be Ether or Ether token" account.Currency + return + failwith + <| SPrintF1 + "Assertion failed: currency %A should be Ether or Ether token" + account.Currency } let private BroadcastRawTransaction (currency: Currency) trans = 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 privKeyInBytes = try - KeyStoreService.DecryptKeyStoreFromJson (password, encryptedPrivateKey) + KeyStoreService.DecryptKeyStoreFromJson ( + password, + encryptedPrivateKey + ) with :? DecryptionException -> raise (InvalidPassword) EthECKey (privKeyInBytes, true) @@ -269,14 +378,19 @@ module internal Account = let private GetNetwork (currency: Currency) = if not (currency.IsEtherBased ()) then failwith - <| SPrintF1 "Assertion failed: currency %A should be Ether-type" currency + <| 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 + <| SPrintF1 + "Assertion failed: Ether currency %A not supported?" + currency let private SignEtherTransaction (currency: Currency) @@ -287,13 +401,14 @@ module internal Account = = let chain = GetNetwork currency + if (GetNetwork txMetadata.Fee.Currency <> chain) then invalidArg "chain" (SPrintF2 "Assertion failed: fee currency (%A) chain doesn't match with passed chain (%A)" - txMetadata.Fee.Currency - chain) + txMetadata.Fee.Currency + chain) let amountToSendConsideringMinerFee = if (amount.ValueToSend = amount.BalanceAtTheMomentOfSending) then @@ -302,24 +417,28 @@ module internal Account = amount.ValueToSend let amountInWei = - UnitConversion.Convert.ToWei (amountToSendConsideringMinerFee, UnitConversion.EthUnit.Ether) + 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)) + 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 @@ -335,19 +454,36 @@ module internal Account = let chain = GetNetwork currency let privKeyInBytes = privateKey.GetPrivateKeyAsBytes () - let amountInWei = UnitConversion.Convert.ToWei (amount.ValueToSend, UnitConversion.EthUnit.Ether) + 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) + .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) + signer.SignTransaction ( + privKeyInBytes, + chain, + contractAddress, + etherValue, + nonce, + gasPrice, + gasLimit, + data + ) let private SignTransactionWithPrivateKey (account: IAccount) @@ -371,16 +507,26 @@ module internal Account = 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 + txMetadata.Fee.Currency + account.Currency + + SignEtherTransaction + account.Currency + txMetadata + destination + amount + privateKey else failwith - <| SPrintF1 "Assertion failed: Ether currency %A not supported?" account.Currency + <| SPrintF1 + "Assertion failed: Ether currency %A not supported?" + account.Currency let chain = GetNetwork account.Currency + if not (signer.VerifyTransaction (trans, chain)) then failwith "Transaction could not be verified?" + trans let SignTransaction @@ -392,7 +538,13 @@ module internal Account = = let privateKey = GetPrivateKey account password - SignTransactionWithPrivateKey account txMetadata destination amount privateKey + + SignTransactionWithPrivateKey + account + txMetadata + destination + amount + privateKey let CheckValidPassword (account: NormalAccount) (password: string) = GetPrivateKey account password |> ignore @@ -408,7 +560,12 @@ module internal Account = let ecPrivKey = EthECKey (account.GetUnencryptedPrivateKey ()) let signedTrans = - SignTransactionWithPrivateKey account txMetadata destination.PublicAddress amount ecPrivKey + SignTransactionWithPrivateKey + account + txMetadata + destination.PublicAddress + amount + ecPrivKey BroadcastRawTransaction accountFrom.Currency signedTrans @@ -420,32 +577,52 @@ module internal Account = (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 - let trans = SignTransaction account txMetadata destination amount password + let trans = + SignTransaction account txMetadata destination amount password BroadcastRawTransaction currency trans - let private CreateInternal (password: string) (seed: array): FileRepresentation = + let private CreateInternal + (password: string) + (seed: array) + : FileRepresentation = let privateKey = EthECKey (seed, true) let publicAddress = privateKey.GetPublicAddress () + if not (addressUtil.IsChecksumAddress (publicAddress)) then - failwith ("Nethereum's GetPublicAddress gave a non-checksum address: " + publicAddress) + failwith ( + "Nethereum's GetPublicAddress gave a non-checksum address: " + + publicAddress + ) let accountSerializedJson = - KeyStoreService.EncryptAndGenerateDefaultKeyStoreAsJson (password, seed, publicAddress) + KeyStoreService.EncryptAndGenerateDefaultKeyStoreAsJson ( + password, + seed, + publicAddress + ) - let fileNameForAccount = KeyStoreService.GenerateUTCFileName (publicAddress) + let fileNameForAccount = + KeyStoreService.GenerateUTCFileName (publicAddress) { Name = fileNameForAccount Content = fun _ -> accountSerializedJson } - let Create (password: string) (seed: array): Async = + let Create + (password: string) + (seed: array) + : Async = async { return CreateInternal password seed } let public ExportUnsignedTransactionToJson trans = @@ -455,13 +632,15 @@ module internal Account = (transProposal: UnsignedTransactionProposal) (txMetadata: TransactionMetadata) (readOnlyAccounts: seq) - : string - = + : string = let unsignedTransaction = { Proposal = transProposal - Cache = Caching.Instance.GetLastCachedData().ToDietCache readOnlyAccounts + Cache = + Caching + .Instance + .GetLastCachedData().ToDietCache readOnlyAccounts Metadata = txMetadata } diff --git a/src/GWallet.Backend/Ether/EtherExceptions.fs b/src/GWallet.Backend/Ether/EtherExceptions.fs index bc21d172f..a730d73d2 100644 --- a/src/GWallet.Backend/Ether/EtherExceptions.fs +++ b/src/GWallet.Backend/Ether/EtherExceptions.fs @@ -30,38 +30,52 @@ type RpcErrorCode = type ServerCannotBeResolvedException = inherit CommunicationUnsuccessfulException - new(message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException(message, innerException) } + new (message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException (message, innerException) } type ServerUnavailableException = inherit CommunicationUnsuccessfulException - new(message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException(message, innerException) } + new (message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException (message, innerException) } type ServerChannelNegotiationException = inherit CommunicationUnsuccessfulException - new(message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException(message, innerException) } - - new(message: string, webExStatusCode: WebExceptionStatus, innerException: Exception) = - { 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) } + new (message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException (message, innerException) } + + new (message: string, + webExStatusCode: WebExceptionStatus, + innerException: Exception) = + { 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) } 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 8c9f4280e..30ea761fa 100644 --- a/src/GWallet.Backend/Ether/EtherMinerFee.fs +++ b/src/GWallet.Backend/Ether/EtherMinerFee.fs @@ -7,7 +7,13 @@ 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 member val GasPriceInWei = gasPriceInWei @@ -16,5 +22,8 @@ type MinerFee (gasLimit: Int64, gasPriceInWei: Int64, estimationTime: DateTime, member __.CalculateAbsoluteValue () = let gasPriceInWei = BigInteger (gasPriceInWei) - let costInWei = BigInteger.Multiply (gasPriceInWei, BigInteger (gasLimit)) + + 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 4a6808f26..10c3ba39d 100644 --- a/src/GWallet.Backend/Ether/EtherServer.fs +++ b/src/GWallet.Backend/Ether/EtherServer.fs @@ -20,7 +20,7 @@ type BalanceType = | Confirmed type SomeWeb3 (url: string) = - inherit Web3(url) + inherit Web3 (url) member val Url = url @@ -57,7 +57,9 @@ module Web3ServerSeedList = Currency.ETH else failwith - <| SPrintF1 "Assertion failed: Ether currency %A not supported?" currency + <| SPrintF1 + "Assertion failed: Ether currency %A not supported?" + currency Caching.Instance.GetServers baseCurrency |> List.ofSeq @@ -70,20 +72,33 @@ module Server = let private Web3Server (serverDetails: ServerDetails) = match serverDetails.ServerInfo.ConnectionType with - | { Protocol = Tcp _; Encrypted = _ } -> + | { + Protocol = Tcp _ + Encrypted = _ + } -> failwith - <| SPrintF1 "Ether server of TCP connection type?: %s" serverDetails.ServerInfo.NetworkPath - | { Protocol = Http; Encrypted = encrypted } -> + <| 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 + let uri = + SPrintF2 "%s://%s" protocol serverDetails.ServerInfo.NetworkPath + SomeWeb3 uri - let HttpRequestExceptionMatchesErrorCode (ex: Http.HttpRequestException) (errorCode: int): bool = + let HttpRequestExceptionMatchesErrorCode + (ex: Http.HttpRequestException) + (errorCode: int) + : bool = ex.Message.StartsWith (SPrintF1 "%i " errorCode) || ex.Message.Contains (SPrintF1 " %i " errorCode) @@ -91,17 +106,22 @@ module Server = let PerformEtherRemoteCallWithTimeout<'T, 'R> (job: Async<'R>): Async<'R> = async { - let! maybeResult = FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT job + let! maybeResult = + FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT job match maybeResult with | None -> - return raise - <| ServerTimedOutException ("Timeout when trying to communicate with Ether server") + return + raise + <| ServerTimedOutException ( + "Timeout when trying to communicate with Ether server" + ) | Some result -> return result } let MaybeRethrowWebException (ex: Exception): unit = let maybeWebEx = FSharpUtil.FindException ex + match maybeWebEx with | Some webEx -> @@ -111,155 +131,277 @@ module Server = if webEx.Status = WebExceptionStatus.NameResolutionFailure then raise <| ServerCannotBeResolvedException (exMsg, webEx) + if webEx.Status = WebExceptionStatus.ReceiveFailure then raise <| ServerTimedOutException (exMsg, webEx) + if webEx.Status = WebExceptionStatus.ConnectFailure then raise <| ServerUnreachableException (exMsg, webEx) if webEx.Status = WebExceptionStatus.SecureChannelFailure then - raise <| ServerChannelNegotiationException (exMsg, webEx.Status, webEx) + 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) | None -> () let MaybeRethrowHttpRequestException (ex: Exception): unit = - let maybeHttpReqEx = FSharpUtil.FindException ex + let maybeHttpReqEx = + FSharpUtil.FindException ex + match maybeHttpReqEx with | Some httpReqEx -> - if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.ConnectionTimeOut) then + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int CloudFlareError.ConnectionTimeOut) then raise <| ServerTimedOutException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.OriginUnreachable) then + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int CloudFlareError.OriginUnreachable) then raise <| ServerTimedOutException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.OriginSslHandshakeError) then + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int CloudFlareError.OriginSslHandshakeError) then raise - <| ServerChannelNegotiationException (exMsg, CloudFlareError.OriginSslHandshakeError, httpReqEx) - - if HttpRequestExceptionMatchesErrorCode httpReqEx (int CloudFlareError.WebServerDown) then + <| ServerChannelNegotiationException ( + exMsg, + CloudFlareError.OriginSslHandshakeError, + httpReqEx + ) + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int CloudFlareError.WebServerDown) then raise - <| ServerUnreachableException (exMsg, CloudFlareError.WebServerDown, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.BadGateway) then + <| ServerUnreachableException ( + exMsg, + CloudFlareError.WebServerDown, + httpReqEx + ) + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.BadGateway) then raise - <| ServerUnreachableException (exMsg, HttpStatusCode.BadGateway, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.GatewayTimeout) then + <| ServerUnreachableException ( + exMsg, + HttpStatusCode.BadGateway, + httpReqEx + ) + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.GatewayTimeout) then raise - <| ServerUnreachableException (exMsg, HttpStatusCode.GatewayTimeout, httpReqEx) - - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.ServiceUnavailable) then + <| ServerUnreachableException ( + exMsg, + HttpStatusCode.GatewayTimeout, + httpReqEx + ) + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.ServiceUnavailable) then 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 + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.Forbidden) then raise <| ServerMisconfiguredException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.Unauthorized) then + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.Unauthorized) then raise <| ServerMisconfiguredException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.MethodNotAllowed) then + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.MethodNotAllowed) then raise <| ServerMisconfiguredException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.InternalServerError) then + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.InternalServerError) then raise <| ServerUnavailableException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCode.NotFound) then + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCode.NotFound) then raise <| ServerUnavailableException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCodeNotPresentInTheBcl.TooManyRequests) then + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCodeNotPresentInTheBcl.TooManyRequests) then raise <| ServerRestrictiveException (exMsg, httpReqEx) - if HttpRequestExceptionMatchesErrorCode httpReqEx (int HttpStatusCodeNotPresentInTheBcl.FrozenSite) then + + if HttpRequestExceptionMatchesErrorCode + httpReqEx + (int HttpStatusCodeNotPresentInTheBcl.FrozenSite) then raise <| ServerUnavailableException (exMsg, httpReqEx) // weird "IOException: The server returned an invalid or unrecognized response." since Mono 6.4.x (vs16.3) - if (FSharpUtil.FindException httpReqEx).IsSome then + if (FSharpUtil.FindException httpReqEx) + .IsSome then raise <| ServerMisconfiguredException (exMsg, httpReqEx) | _ -> () let MaybeRethrowRpcResponseException (ex: Exception): unit = - let maybeRpcResponseEx = FSharpUtil.FindException ex + let maybeRpcResponseEx = + FSharpUtil.FindException + ex + match maybeRpcResponseEx with | 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 + 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 + <| 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) + (int + RpcErrorCode.StatePruningNodeOrMissingTrieNodeOrHeaderNotFound) + rpcResponseEx.RpcError.Message, + rpcResponseEx + ) else - raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) - if (rpcResponseEx.RpcError.Code = int RpcErrorCode.UnknownBlockNumber) then + raise + <| ServerMisconfiguredException (exMsg, rpcResponseEx) + + if (rpcResponseEx.RpcError.Code = int + RpcErrorCode.UnknownBlockNumber) then raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) + if rpcResponseEx.RpcError.Code = int RpcErrorCode.GatewayTimeout then raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) + if rpcResponseEx.RpcError.Code = int RpcErrorCode.EmptyResponse then raise <| ServerMisconfiguredException (exMsg, rpcResponseEx) + raise - <| Exception - (SPrintF3 + <| Exception ( + SPrintF3 "RpcResponseException with RpcError Code <%i> and Message '%s' (%s)" - rpcResponseEx.RpcError.Code - rpcResponseEx.RpcError.Message - rpcResponseEx.Message, - rpcResponseEx) + 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) + | Some rpcTimeoutEx -> + raise <| ServerTimedOutException (exMsg, rpcTimeoutEx) | None -> () let MaybeRethrowNetworkingException (ex: Exception): unit = - let maybeSocketRewrappedException = Networking.FindExceptionToRethrow ex exMsg + let maybeSocketRewrappedException = + Networking.FindExceptionToRethrow ex exMsg + match maybeSocketRewrappedException with | 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 = - let maybeRpcUnknownEx = FSharpUtil.FindException ex + let maybeRpcUnknownEx = + FSharpUtil.FindException + ex + match maybeRpcUnknownEx with | Some _ -> - let maybeObjectDisposedEx = FSharpUtil.FindException ex + let maybeObjectDisposedEx = + FSharpUtil.FindException ex + match maybeObjectDisposedEx with | Some objectDisposedEx -> if objectDisposedEx.Message.Contains "MobileAuthenticatedStream" then - raise <| ProtocolGlitchException (objectDisposedEx.Message, objectDisposedEx) + raise + <| ProtocolGlitchException ( + objectDisposedEx.Message, + objectDisposedEx + ) | None -> () | None -> () let MaybeRethrowInnerRpcException (ex: Exception): unit = - let maybeRpcUnknownEx = FSharpUtil.FindException ex + let maybeRpcUnknownEx = + FSharpUtil.FindException + ex + match maybeRpcUnknownEx with | Some rpcUnknownEx -> let maybeDeSerializationEx = - FSharpUtil.FindException rpcUnknownEx + FSharpUtil.FindException + rpcUnknownEx match maybeDeSerializationEx with | None -> () - | Some deserEx -> raise <| ServerMisconfiguredException (deserEx.Message, ex) + | 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 + let maybeHttpReqEx = + FSharpUtil.FindException ex + match maybeHttpReqEx with | Some httpReqEx -> if httpReqEx.Message.Contains "SSL" then let maybeIOEx = FSharpUtil.FindException ex + match maybeIOEx with - | Some ioEx -> raise <| ProtocolGlitchException (ioEx.Message, ex) + | Some ioEx -> + raise <| ProtocolGlitchException (ioEx.Message, ex) | None -> let maybeSecEx = - FSharpUtil.FindException ex + FSharpUtil.FindException + ex match maybeSecEx with - | Some secEx -> raise <| ProtocolGlitchException (secEx.Message, ex) + | Some secEx -> + raise <| ProtocolGlitchException (secEx.Message, ex) | None -> () | None -> () | None -> () @@ -294,13 +436,16 @@ module Server = let consistencyConfig = match maybeConsistencyConfig with - | None -> SpecificNumberOfConsistentResponsesRequired numberOfConsistentResponsesRequired + | None -> + SpecificNumberOfConsistentResponsesRequired + numberOfConsistentResponsesRequired | Some specificConsistencyConfig -> specificConsistencyConfig { NumberOfParallelJobsAllowed = NumberOfParallelJobsForMode mode NumberOfRetries = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS - NumberOfRetriesForInconsistency = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS + NumberOfRetriesForInconsistency = + Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS ExceptionHandler = Some (fun ex -> Infrastructure.ReportWarning ex) ResultSelectionMode = Selective @@ -313,14 +458,19 @@ module Server = let etcEcosystemIsMomentarilyCentralized = true - let private FaultTolerantParallelClientDefaultSettings (mode: ServerSelectionMode) (currency: Currency) = + let private FaultTolerantParallelClientDefaultSettings + (mode: ServerSelectionMode) + (currency: Currency) + = let numberOfConsistentResponsesRequired = if etcEcosystemIsMomentarilyCentralized && currency = Currency.ETC then 1u else 2u - FaultTolerantParallelClientInnerSettings numberOfConsistentResponsesRequired mode + FaultTolerantParallelClientInnerSettings + numberOfConsistentResponsesRequired + mode let private FaultTolerantParallelClientSettingsForBalanceCheck (mode: ServerSelectionMode) @@ -331,21 +481,36 @@ module Server = if etcEcosystemIsMomentarilyCentralized && currency = Currency.ETC then None elif mode = ServerSelectionMode.Fast then - Some (OneServerConsistentWithCertainValueOrTwoServers cacheOrInitialBalanceMatchFunc) + Some ( + OneServerConsistentWithCertainValueOrTwoServers + cacheOrInitialBalanceMatchFunc + ) else None - FaultTolerantParallelClientDefaultSettings mode currency consistencyConfig + FaultTolerantParallelClientDefaultSettings + mode + currency + consistencyConfig let private FaultTolerantParallelClientSettingsForBroadcast () = - FaultTolerantParallelClientInnerSettings 1u ServerSelectionMode.Fast None + FaultTolerantParallelClientInnerSettings + 1u + ServerSelectionMode.Fast + None let private faultTolerantEtherClient = - JsonRpcSharp.Client.HttpClient.ConnectionTimeout <- Config.DEFAULT_NETWORK_TIMEOUT - FaultTolerantParallelClient Caching.Instance.SaveServerLastStat + JsonRpcSharp.Client.HttpClient.ConnectionTimeout <- + Config.DEFAULT_NETWORK_TIMEOUT + + 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 { @@ -360,18 +525,26 @@ module Server = async { let web3Server = Web3Server server + try return! HandlePossibleEtherFailures (web3ClientFunc web3Server) // 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 + let msg = + SPrintF2 "%s: %s" (ex.GetType().FullName) ex.Message + return raise <| ServerDiscardedException (msg, ex) | ex -> - return raise - <| Exception - (SPrintF1 "Some problem when connecting to '%s'" server.ServerInfo.NetworkPath, ex) + return + raise + <| Exception ( + SPrintF1 + "Some problem when connecting to '%s'" + server.ServerInfo.NetworkPath, + ex + ) } // FIXME: seems there's some code duplication between this function and UtxoCoinAccount.fs's GetServerFuncs function @@ -379,30 +552,32 @@ module Server = let GetServerFuncs<'R> (web3Func: SomeWeb3 -> Async<'R>) (etherServers: seq) - : seq> - = + : seq> = let Web3ServerToGenericServer (web3ClientFunc: SomeWeb3 -> Async<'R>) (etherServer: ServerDetails) - : Server - = + : 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> - = + : List> = let etherServers = Web3ServerSeedList.Randomize currency 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 = @@ -410,33 +585,50 @@ module Server = let! cancelToken = Async.CancellationToken let task = - web3.Eth.Transactions.GetTransactionCount.SendRequestAsync (address, null, cancelToken) + web3.Eth.Transactions.GetTransactionCount.SendRequestAsync ( + address, + null, + cancelToken + ) return! Async.AwaitTask task } GetRandomizedFuncs currency web3Func - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings + ServerSelectionMode.Fast + currency + None) + web3Funcs } - let private NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED = BigInteger (45) + let private NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED = + BigInteger (45) - let private GetBlockToCheckForConfirmedBalance (web3: Web3): Async = + let private GetBlockToCheckForConfirmedBalance + (web3: Web3) + : Async = async { let! cancelToken = Async.CancellationToken let! latestBlock = - web3.Eth.Blocks.GetBlockNumber.SendRequestAsync (null, cancelToken) + web3.Eth.Blocks.GetBlockNumber.SendRequestAsync ( + null, + cancelToken + ) |> Async.AwaitTask if (latestBlock = null) then failwith "latestBlock somehow is null" let blockToCheck = - BigInteger.Subtract (latestBlock.Value, NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED) + BigInteger.Subtract ( + latestBlock.Value, + NUMBER_OF_CONFIRMATIONS_TO_CONSIDER_BALANCE_CONFIRMED + ) if blockToCheck.Sign < 0 then let errMsg = @@ -450,9 +642,13 @@ module Server = return BlockParameter (HexBigInteger (blockToCheck)) } - let private GetConfirmedEtherBalanceInternal (web3: Web3) (publicAddress: string): Async = + let private GetConfirmedEtherBalanceInternal + (web3: Web3) + (publicAddress: string) + : Async = async { - let! blockForConfirmationReference = GetBlockToCheckForConfirmedBalance web3 + let! blockForConfirmationReference = + GetBlockToCheckForConfirmedBalance web3 (* if (Config.DebugLog) then @@ -465,17 +661,28 @@ module Server = cancelToken.ThrowIfCancellationRequested () let! balance = - web3.Eth.GetBalance.SendRequestAsync (publicAddress, blockForConfirmationReference, null, cancelToken) + web3.Eth.GetBalance.SendRequestAsync ( + publicAddress, + blockForConfirmationReference, + null, + cancelToken + ) |> Async.AwaitTask return balance } - let private BalanceMatchWithCacheOrInitialBalance address currency someRetrievedBalance = + let private BalanceMatchWithCacheOrInitialBalance + address + currency + someRetrievedBalance + = if Caching.Instance.FirstRun then someRetrievedBalance = 0m else - match Caching.Instance.TryRetrieveLastCompoundBalance address currency with + match Caching.Instance.TryRetrieveLastCompoundBalance + address + currency with | None -> false | Some balance -> someRetrievedBalance = balance @@ -485,26 +692,37 @@ module Server = (balType: BalanceType) (mode: ServerSelectionMode) (cancelSourceOption: Option) - : Async - = + : Async = async { let web3Funcs = let web3Func (web3: Web3): Async = async { let! balance = match balType with - | BalanceType.Confirmed -> GetConfirmedEtherBalanceInternal web3 address + | BalanceType.Confirmed -> + GetConfirmedEtherBalanceInternal web3 address | BalanceType.Unconfirmed -> async { let! cancelToken = Async.CancellationToken - let task = web3.Eth.GetBalance.SendRequestAsync (address, null, cancelToken) + + 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) + return + UnitConversion.Convert.FromWei ( + balance.Value, + UnitConversion.EthUnit.Ether + ) } GetRandomizedFuncs currency web3Func @@ -512,22 +730,30 @@ module Server = let query = match cancelSourceOption with | None -> faultTolerantEtherClient.Query - | Some cancelSource -> faultTolerantEtherClient.QueryWithCancellation cancelSource - - return! query - (FaultTolerantParallelClientSettingsForBalanceCheck - mode - currency - (BalanceMatchWithCacheOrInitialBalance address currency)) - web3Funcs + | Some cancelSource -> + faultTolerantEtherClient.QueryWithCancellation cancelSource + + return! + query + (FaultTolerantParallelClientSettingsForBalanceCheck + mode + currency + (BalanceMatchWithCacheOrInitialBalance address currency)) + web3Funcs } - let private GetConfirmedTokenBalanceInternal (web3: Web3) (publicAddress: string) (currency: Currency): Async = + let private GetConfirmedTokenBalanceInternal + (web3: Web3) + (publicAddress: string) + (currency: Currency) + : Async = if (web3 = null) then invalidArg "web3" "web3 argument should not be null" async { - let! blockForConfirmationReference = GetBlockToCheckForConfirmedBalance web3 + let! blockForConfirmationReference = + GetBlockToCheckForConfirmedBalance web3 + let balanceOfFunctionMsg = BalanceOfFunction (Owner = publicAddress) let contractAddress = TokenManager.GetTokenContractAddress currency @@ -541,11 +767,18 @@ module Server = cancelToken.ThrowIfCancellationRequested () let! balance = - contractHandler.QueryAsync - (balanceOfFunctionMsg, blockForConfirmationReference, cancelToken) + contractHandler.QueryAsync ( + balanceOfFunctionMsg, + blockForConfirmationReference, + cancelToken + ) |> Async.AwaitTask - return UnitConversion.Convert.FromWei (balance, UnitConversion.EthUnit.Ether) + return + UnitConversion.Convert.FromWei ( + balance, + UnitConversion.EthUnit.Ether + ) } @@ -555,20 +788,34 @@ module Server = (balType: BalanceType) (mode: ServerSelectionMode) (cancelSourceOption: Option) - : Async - = + : Async = async { let web3Funcs = let web3Func (web3: Web3): Async = match balType with - | BalanceType.Confirmed -> GetConfirmedTokenBalanceInternal web3 address currency + | BalanceType.Confirmed -> + GetConfirmedTokenBalanceInternal web3 address currency | BalanceType.Unconfirmed -> - let tokenService = TokenManager.TokenServiceWrapper (web3, currency) + let tokenService = + TokenManager.TokenServiceWrapper (web3, currency) + async { let! cancelToken = Async.CancellationToken - let task = tokenService.BalanceOfQueryAsync (address, null, cancelToken) + + let task = + tokenService.BalanceOfQueryAsync ( + address, + null, + cancelToken + ) + let! balance = Async.AwaitTask task - return UnitConversion.Convert.FromWei (balance, UnitConversion.EthUnit.Ether) + + return + UnitConversion.Convert.FromWei ( + balance, + UnitConversion.EthUnit.Ether + ) } GetRandomizedFuncs currency web3Func @@ -576,49 +823,82 @@ module Server = let query = match cancelSourceOption with | None -> faultTolerantEtherClient.Query - | Some cancelSource -> faultTolerantEtherClient.QueryWithCancellation cancelSource - - return! query - (FaultTolerantParallelClientSettingsForBalanceCheck - mode - currency - (BalanceMatchWithCacheOrInitialBalance address currency)) - web3Funcs + | Some cancelSource -> + faultTolerantEtherClient.QueryWithCancellation cancelSource + + return! + query + (FaultTolerantParallelClientSettingsForBalanceCheck + 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 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) + TransferFunction ( + FromAddress = account.PublicAddress, + To = destination, + Value = amountInWei + ) async { let! cancelToken = Async.CancellationToken let task = - contractHandler.EstimateGasAsync (transferFunctionMsg, cancelToken) + contractHandler.EstimateGasAsync ( + transferFunctionMsg, + cancelToken + ) return! Async.AwaitTask task } GetRandomizedFuncs account.Currency web3Func - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast account.Currency None) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings + ServerSelectionMode.Fast + account.Currency + None) + web3Funcs } - let private AverageGasPrice (gasPricesFromDifferentServers: List): HexBigInteger = + let private AverageGasPrice + (gasPricesFromDifferentServers: List) + : HexBigInteger = let sum = - gasPricesFromDifferentServers.Select(fun hbi -> hbi.Value) - .Aggregate(fun bi1 bi2 -> BigInteger.Add (bi1, bi2)) + gasPricesFromDifferentServers + .Select(fun hbi -> hbi.Value) + .Aggregate(fun bi1 bi2 -> BigInteger.Add (bi1, bi2)) + + let avg = + BigInteger.Divide ( + sum, + BigInteger (gasPricesFromDifferentServers.Length) + ) - let avg = BigInteger.Divide (sum, BigInteger (gasPricesFromDifferentServers.Length)) HexBigInteger (avg) let GetGasPrice (currency: Currency): Async = @@ -627,27 +907,43 @@ module Server = let web3Func (web3: Web3): Async = async { let! cancelToken = Async.CancellationToken - let task = web3.Eth.GasPrice.SendRequestAsync (null, cancelToken) + + let task = + web3.Eth.GasPrice.SendRequestAsync ( + null, + cancelToken + ) + return! Async.AwaitTask task } GetRandomizedFuncs currency web3Func let minResponsesRequired = - if etcEcosystemIsMomentarilyCentralized && currency = Currency.ETC then + if etcEcosystemIsMomentarilyCentralized + && currency = Currency.ETC then 1u else 2u - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings - ServerSelectionMode.Fast - currency - (Some (AverageBetweenResponses (minResponsesRequired, AverageGasPrice)))) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings + ServerSelectionMode.Fast + currency + (Some ( + AverageBetweenResponses ( + minResponsesRequired, + AverageGasPrice + ) + ))) + web3Funcs } - let BroadcastTransaction (currency: Currency) (transaction: string): Async = + let BroadcastTransaction + (currency: Currency) + (transaction: string) + : Async = let insufficientFundsMsg = "Insufficient funds" async { @@ -657,7 +953,11 @@ module Server = let! cancelToken = Async.CancellationToken let task = - web3.Eth.Transactions.SendRawTransaction.SendRequestAsync (transaction, null, cancelToken) + web3.Eth.Transactions.SendRawTransaction.SendRequestAsync ( + transaction, + null, + cancelToken + ) return! Async.AwaitTask task } @@ -665,14 +965,20 @@ module Server = GetRandomizedFuncs currency web3Func try - return! faultTolerantEtherClient.Query (FaultTolerantParallelClientSettingsForBroadcast ()) web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientSettingsForBroadcast ()) + web3Funcs with ex -> - match FSharpUtil.FindException ex with + match FSharpUtil.FindException + ex with | 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) @@ -681,8 +987,7 @@ module Server = let private GetTransactionDetailsFromTransactionReceipt (currency: Currency) (txHash: string) - : Async - = + : Async = async { let web3Funcs = let web3Func (web3: Web3): Async = @@ -690,50 +995,82 @@ module Server = 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 - } + return + { + GasUsed = transactionReceipt.GasUsed.Value + Status = transactionReceipt.Status.Value + } } GetRandomizedFuncs currency web3Func - return! faultTolerantEtherClient.Query - (FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast currency None) - web3Funcs + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings + ServerSelectionMode.Fast + currency + None) + web3Funcs } - let IsOutOfGas (currency: Currency) (txHash: string) (spentGas: int64): Async = + let IsOutOfGas + (currency: Currency) + (txHash: string) + (spentGas: int64) + : Async = async { - let! transactionStatusDetails = GetTransactionDetailsFromTransactionReceipt currency txHash + 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) + + 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 + return! + faultTolerantEtherClient.Query + (FaultTolerantParallelClientDefaultSettings + ServerSelectionMode.Fast + baseCurrency + None) + web3Funcs } - let CheckIfAddressIsAValidPaymentDestination (currency: Currency) (address: string): Async = + let CheckIfAddressIsAValidPaymentDestination + (currency: Currency) + (address: string) + : Async = async { let! contractCode = GetContractCode currency address let emptyContract = "0x" @@ -742,11 +1079,12 @@ module Server = failwith <| SPrintF2 "GetCode API should always return a string starting with %s, but got: %s" - emptyContract - contractCode + emptyContract + contractCode elif contractCode <> emptyContract then - return raise - <| InvalidDestinationAddress - "Sending to contract addresses is not supported yet. Supply a normal address please." + return + raise + <| InvalidDestinationAddress + "Sending to contract addresses is not supported yet. Supply a normal address please." } diff --git a/src/GWallet.Backend/Ether/TokenManager.fs b/src/GWallet.Backend/Ether/TokenManager.fs index fdee6b6c4..2980fb320 100644 --- a/src/GWallet.Backend/Ether/TokenManager.fs +++ b/src/GWallet.Backend/Ether/TokenManager.fs @@ -16,35 +16,51 @@ module TokenManager = match currency with | Currency.DAI -> "0x6B175474E89094C44Da98b954EedeAC495271d0F" | Currency.SAI -> "0x89d24A6b4CcB1B6fAA2625fE562bDD9a23260359" - | _ -> raise <| invalidOp (SPrintF1 "%A has no contract address" currency) + | _ -> + raise <| invalidOp (SPrintF1 "%A has no contract address" currency) type TokenServiceWrapper (web3, currency: Currency) = - inherit StandardTokenService(web3, GetTokenContractAddress currency) + inherit StandardTokenService (web3, GetTokenContractAddress currency) - member self.ComposeInputDataForTransferTransaction (origin: string, - destination: string, - tokenAmountInWei: BigInteger, - gasLimit: BigInteger) - : string = - let transferFuncBuilder = self.ContractHandler.GetFunction () + member self.ComposeInputDataForTransferTransaction + ( + origin: string, + destination: string, + tokenAmountInWei: BigInteger, + gasLimit: BigInteger + ): 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) + transferFuncBuilder.CreateTransactionInput ( + transferFunctionMsg, + origin, + HexBigInteger (gasLimit), + tokenValue + ) if (transactionInput = null) then - failwith "Assertion failed: transaction input should not be null" + 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" + 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" + transactionInput.Data // this is a dummy instance we need in order to pass it to base class of StandardTokenService, but not @@ -52,4 +68,4 @@ module TokenManager = let private dummyOfflineWeb3 = Web3 () type OfflineTokenServiceWrapper (currency: Currency) = - inherit TokenServiceWrapper(dummyOfflineWeb3, currency) + inherit TokenServiceWrapper (dummyOfflineWeb3, currency) diff --git a/src/GWallet.Backend/FSharpUtil.fs b/src/GWallet.Backend/FSharpUtil.fs index 7082440d5..5548c8c23 100644 --- a/src/GWallet.Backend/FSharpUtil.fs +++ b/src/GWallet.Backend/FSharpUtil.fs @@ -32,12 +32,21 @@ module FSharpUtil = "%A" |] - let formatsFound = supportedFormats.Where (fun format -> innerFmt.IndexOf (format) >= 0) + let formatsFound = + supportedFormats.Where (fun format -> + innerFmt.IndexOf (format) >= 0 + ) + if formatsFound.Any () then - let firstIndexWhereFormatFound = formatsFound.Min (fun format -> innerFmt.IndexOf (format)) + let firstIndexWhereFormatFound = + formatsFound.Min (fun format -> + innerFmt.IndexOf (format) + ) let firstFormat = - formatsFound.First (fun format -> innerFmt.IndexOf (format) = firstIndexWhereFormatFound) + formatsFound.First (fun format -> + innerFmt.IndexOf (format) = firstIndexWhereFormatFound + ) let subEnd = innerFmt.IndexOf (firstFormat) + "%x".Length let sub = innerFmt.Substring (0, subEnd) @@ -61,10 +70,23 @@ module FSharpUtil = let SPrintF3 (fmt: string) (a: Object) (b: Object) (c: Object) = String.Format (ToStringFormat fmt, a, b, c) - let SPrintF4 (fmt: string) (a: Object) (b: Object) (c: Object) (d: Object) = + let SPrintF4 + (fmt: string) + (a: Object) + (b: Object) + (c: Object) + (d: Object) + = String.Format (ToStringFormat fmt, a, b, c, d) - let SPrintF5 (fmt: string) (a: Object) (b: Object) (c: Object) (d: Object) (e: Object) = + let SPrintF5 + (fmt: string) + (a: Object) + (b: Object) + (c: Object) + (d: Object) + (e: Object) + = String.Format (ToStringFormat fmt, a, b, c, d, e) @@ -94,17 +116,30 @@ module FSharpUtil = let SPrintF3 (fmt: string) (a: Object) (b: Object) (c: Object) = ReflectionlessPrint.SPrintF3 fmt a b c - let SPrintF4 (fmt: string) (a: Object) (b: Object) (c: Object) (d: Object) = + let SPrintF4 + (fmt: string) + (a: Object) + (b: Object) + (c: Object) + (d: Object) + = ReflectionlessPrint.SPrintF4 fmt a b c d - let SPrintF5 (fmt: string) (a: Object) (b: Object) (c: Object) (d: Object) (e: Object) = + let SPrintF5 + (fmt: string) + (a: Object) + (b: Object) + (c: Object) + (d: Object) + (e: Object) + = ReflectionlessPrint.SPrintF5 fmt a b c d e #endif type internal ResultWrapper<'T> (value: 'T) = // hack? - inherit Exception() + inherit Exception () member __.Value = value @@ -125,7 +160,11 @@ module FSharpUtil = 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 @@ -177,7 +216,8 @@ module FSharpUtil = } async { - let allJobsInParallel = jobs |> Seq.map wrap |> Async.Parallel |> Async.StartChild + let allJobsInParallel = + jobs |> Seq.map wrap |> Async.Parallel |> Async.StartChild let! allJobsStarted = allJobsInParallel @@ -192,11 +232,25 @@ module FSharpUtil = | _, [] -> 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) - - let ListIntersect<'T> (list1: List<'T>) (list2: List<'T>) (offset: uint32): List<'T> = + 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> = @@ -233,11 +287,14 @@ module FSharpUtil = failwith "Should be unreachable" ex - let rec public FindException<'T when 'T :> Exception> (ex: Exception): Option<'T> = + 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 @@ -248,7 +305,8 @@ module FSharpUtil = else match ex with | :? 'T as specificEx -> Some (specificEx) - | :? AggregateException as aggEx -> findExInSeq aggEx.InnerExceptions + | :? AggregateException as aggEx -> + findExInSeq aggEx.InnerExceptions | _ -> FindException<'T> (ex.InnerException) @@ -262,7 +320,8 @@ module FSharpUtil = (Construct<'T> caseInfo) let GetAllElementsFromDiscriminatedUnion<'T> () = - FSharpType.GetUnionCases (typeof<'T>) |> Seq.map GetUnionCaseInfoAndInstance<'T> + FSharpType.GetUnionCases (typeof<'T>) + |> Seq.map GetUnionCaseInfoAndInstance<'T> #endif type OptionBuilder () = diff --git a/src/GWallet.Backend/FaultTolerantParallelClient.fs b/src/GWallet.Backend/FaultTolerantParallelClient.fs index 9973f8e82..04154aa20 100644 --- a/src/GWallet.Backend/FaultTolerantParallelClient.fs +++ b/src/GWallet.Backend/FaultTolerantParallelClient.fs @@ -8,30 +8,49 @@ open System.Threading.Tasks open GWallet.Backend.FSharpUtil.UwpHacks -type ResourceUnavailabilityException (message: string, innerOrLastException: Exception) = - inherit Exception(message, innerOrLastException) - -type private TaskUnavailabilityException (message: string, innerException: Exception) = - inherit ResourceUnavailabilityException(message, innerException) - -type private ServerUnavailabilityException (message: string, lastException: Exception) = - inherit ResourceUnavailabilityException(message, lastException) +type ResourceUnavailabilityException + ( + message: string, + innerOrLastException: Exception + ) = + inherit Exception (message, innerOrLastException) + +type private TaskUnavailabilityException + ( + message: string, + innerException: Exception + ) = + inherit ResourceUnavailabilityException (message, innerException) + +type private ServerUnavailabilityException + ( + message: string, + lastException: Exception + ) = + inherit ResourceUnavailabilityException (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 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) + 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> = { @@ -96,7 +115,9 @@ type MutableStateUnsafeAccessor<'T> (initialState: 'T) = type MutableStateCapsule<'T> (initialState: 'T) = let state = MutableStateUnsafeAccessor initialState let lockObject = Object () - member __.SafeDo (func: MutableStateUnsafeAccessor<'T> -> 'R): 'R = lock lockObject (fun _ -> func state) + + member __.SafeDo (func: MutableStateUnsafeAccessor<'T> -> 'R): 'R = + lock lockObject (fun _ -> func state) type ServerJob<'K, 'R when 'K: equality and 'K :> ICommunicationHistory> = { @@ -127,12 +148,13 @@ 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: Option unit>) - : 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 @@ -143,21 +165,31 @@ type internal Runner<'Resource when 'Resource: equality> = with ex -> // because if an exception happens roughly at the same time as cancellation, we don't care so much - let isLateEnoughToReportProblem (state: ClientCancelStateInner) = + 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) + && 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 -> @@ -168,19 +200,25 @@ 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: Option unit>) - (cancelState: ClientCancelState) - (updateServer: ('K -> bool) -> HistoryFact -> unit) - (server: Server<'K, 'Resource>) - : ServerJob<'K, 'Resource> = + 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 + Runner.Run<'K, 'Ex> + server + stopwatch + cancelState + shouldReportUncanceledJobs + exceptionHandler match runResult with | SuccessfulValue result -> @@ -208,11 +246,12 @@ type internal Runner<'Resource when 'Resource: equality> = updateServer (fun srv -> srv = server.Details) historyFact - return Failure - { - Server = server - Failure = ex - } + return + Failure + { + Server = server + Failure = ex + } } { @@ -220,13 +259,14 @@ type internal Runner<'Resource when 'Resource: equality> = Server = server } - 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> = + 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 @@ -235,6 +275,7 @@ type internal Runner<'Resource when 'Resource: equality> = updateServerFunc let jobs = funcs |> Seq.map launchFunc |> List.ofSeq + if parallelJobs < uint32 jobs.Length then List.splitAt (int parallelJobs) jobs else @@ -250,18 +291,27 @@ type CustomCancelSource () = let lockObj = Object () member __.Cancel () = - lock lockObj (fun _ -> - if canceledAlready then - raise <| ObjectDisposedException "Already canceled/disposed" - canceledAlready <- true) + lock + lockObj + (fun _ -> + if canceledAlready then + raise <| ObjectDisposedException "Already canceled/disposed" + + canceledAlready <- true + ) + canceled.Trigger () [] member __.Canceled = - lock lockObj (fun _ -> - if canceledAlready then - raise <| AlreadyCanceled - canceled.Publish) + lock + lockObj + (fun _ -> + if canceledAlready then + raise <| AlreadyCanceled + + canceled.Publish + ) interface IDisposable with member self.Dispose () = @@ -271,10 +321,18 @@ type CustomCancelSource () = // 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 @@ -283,14 +341,17 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati |> List.ofSeq let LaunchAsyncJob (job: ServerJob<'K, 'R>): ServerTask<'K, 'R> = - let cancellationSource = new CancellationTokenSource() + let cancellationSource = new CancellationTokenSource () let token = try cancellationSource.Token with :? ObjectDisposedException as ex -> raise - <| TaskUnavailabilityException ("cancellationTokenSource already disposed", ex) + <| TaskUnavailabilityException ( + "cancellationTokenSource already disposed", + ex + ) let task = Async.StartAsTask (job.Job, ?cancellationToken = Some token) @@ -312,25 +373,31 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati (failedFuncsSoFar: List>) (cancellationSource: Option) (cancelState: ClientCancelState) - : Async> - = + : Async> = async { if startedTasks = List.Empty then - return InconsistentOrNotEnoughResults - { - SuccessfulResults = resultsSoFar - UnsuccessfulServers = failedFuncsSoFar - } + return + InconsistentOrNotEnoughResults + { + SuccessfulResults = resultsSoFar + UnsuccessfulServers = failedFuncsSoFar + } else - let jobToWaitForFirstFinishedTask = ServerTask.WhenAny startedTasks + let jobToWaitForFirstFinishedTask = + ServerTask.WhenAny startedTasks + let! fastestTask = jobToWaitForFirstFinishedTask - let restOfTasks = startedTasks.Where (fun task -> not (task = fastestTask)) |> List.ofSeq + 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 + | Failure unsuccessfulServer -> + resultsSoFar, unsuccessfulServer :: failedFuncsSoFar + | SuccessfulResult newResult -> + newResult :: resultsSoFar, failedFuncsSoFar fastestTask.CancellationTokenSource.Dispose () @@ -344,68 +411,94 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati match state.Value with | Alive cancelSources -> let newTask = LaunchAsyncJob head - state.Value <- Alive (newTask.CancellationTokenSource :: cancelSources) + + state.Value <- + Alive ( + newTask.CancellationTokenSource + :: cancelSources + ) + Some newTask | Canceled _ -> None - resultingTask) + resultingTask + ) match maybeNewTask with | Some newTask -> newTask :: restOfTasks, tail | None -> restOfTasks, tail - let returnWithConsistencyOf (minNumberOfConsistentResultsRequired: Option) cacheMatchFunc = + 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 + 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 + || (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!" + 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)) -> + | 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 + return! + WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState | Some (SpecificNumberOfConsistentResponsesRequired number) -> - return! returnWithConsistencyOf (Some number) ((fun _ -> false) |> Some) + return! + returnWithConsistencyOf + (Some number) + ((fun _ -> false) |> Some) | Some (OneServerConsistentWithCertainValueOrTwoServers cacheMatchFunc) -> - return! returnWithConsistencyOf (Some 2u) (Some cacheMatchFunc) + return! + returnWithConsistencyOf (Some 2u) (Some cacheMatchFunc) | None -> if newRestOfTasks.Length = 0 then @@ -413,22 +506,26 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati return! returnWithConsistencyOf None None else - Infrastructure.LogDebug - (SPrintF1 + Infrastructure.LogDebug ( + SPrintF1 "%f%% done (for this currency)" - (100. - * (float (newFailedFuncs.Length + newResults.Length)) - / (float initialServerCount))) - - return! WhenSomeInternal - consistencySettings - initialServerCount - newRestOfTasks - newRestOfJobs - newResults - newFailedFuncs - cancellationSource - cancelState + (100. + * (float ( + newFailedFuncs.Length + newResults.Length + )) + / (float initialServerCount)) + ) + + return! + WhenSomeInternal + consistencySettings + initialServerCount + newRestOfTasks + newRestOfJobs + newResults + newFailedFuncs + cancellationSource + cancelState } let CancelAndDispose (cancelState: ClientCancelState) = @@ -442,7 +539,8 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati cancelSource.Dispose () with :? ObjectDisposedException -> () - state.Value <- Canceled DateTime.UtcNow) + state.Value <- Canceled DateTime.UtcNow + ) // at the time of writing this, I only found a Task.WhenAny() equivalent function in the asyncF# world, called // "Async.WhenAny" in TomasP's tryJoinads source code, however it seemed a bit complex for me to wrap my head around @@ -455,8 +553,7 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati (resultsSoFar: List<'R>) (failedFuncsSoFar: List>) (cancellationSource: Option) - : Async> - = + : Async> = let initialServerCount = funcs.Length |> uint32 @@ -475,34 +572,55 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati Some <| Runner<'R>.CreateJobs<'K, 'E> shouldReportUncanceledJobs - settings.NumberOfParallelJobsAllowed - settings.ExceptionHandler - updateServer - funcs - cancelState) + settings.NumberOfParallelJobsAllowed + settings.ExceptionHandler + updateServer + funcs + cancelState + ) let startedTasks, jobsToLaunchLater = match maybeJobs with - | None -> raise <| TaskCanceledException "Found canceled when about to launch more jobs" + | 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) + customCancelSource.Canceled.Add (fun _ -> + CancelAndDispose cancelState + ) with AlreadyCanceled -> raise - <| TaskCanceledException ("Found canceled when about to subscribe to cancellation") + <| 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 startedTasks = + firstJobsToLaunch + |> List.map (fun job -> LaunchAsyncJob job) - let newCancelSources = startedTasks |> List.map (fun task -> task.CancellationTokenSource) + let newCancelSources = + startedTasks + |> List.map (fun task -> + task.CancellationTokenSource + ) - state.Value <- Alive (List.append currentList newCancelSources) - startedTasks, jobsToLaunchLater) + state.Value <- + Alive (List.append currentList newCancelSources) + + startedTasks, jobsToLaunchLater + ) let job = WhenSomeInternal @@ -535,32 +653,51 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati (retries: uint32) (retriesForInconsistency: uint32) (cancellationSource: Option) - : Async<'R> - = + : Async<'R> = async { if not (funcs.Any ()) then - return raise (ArgumentException ("number of funcs must be higher than zero", "funcs")) + return + raise ( + ArgumentException ( + "number of funcs must be higher than zero", + "funcs" + ) + ) + let howManyFuncs = uint32 funcs.Length - let numberOfParallelJobsAllowed = int settings.NumberOfParallelJobsAllowed + + 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") + return + raise + <| ArgumentException ( + "must be higher than zero", + "numberOfConsistentResponsesRequired" + ) + if (howManyFuncs < numberOfConsistentResponsesRequired) then - return raise - (ArgumentException - ("number of funcs must be equal or higher than numberOfConsistentResponsesRequired", - "funcs")) + return + raise ( + ArgumentException ( + "number of funcs must be equal or higher than numberOfConsistentResponsesRequired", + "funcs" + ) + ) | AverageBetweenResponses (minimumNumberOfResponses, _) -> if (int minimumNumberOfResponses > numberOfParallelJobsAllowed) then - return raise - (ArgumentException - ("numberOfParallelJobsAllowed should be equal or higher than minimumNumberOfResponses for the averageFunc", - "settings")) + return + raise ( + ArgumentException ( + "numberOfParallelJobsAllowed should be equal or higher than minimumNumberOfResponses for the averageFunc", + "settings" + ) + ) | OneServerConsistentWithCertainValueOrTwoServers _ -> () | _ -> () @@ -570,7 +707,13 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati | Selective subSettings -> Some subSettings.ConsistencyConfig let job = - WhenSome settings consistencyConfig funcs resultsSoFar failedFuncsSoFar cancellationSource + WhenSome + settings + consistencyConfig + funcs + resultsSoFar + failedFuncsSoFar + cancellationSource let! result = job @@ -580,144 +723,214 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati | InconsistentOrNotEnoughResults executedServers -> let failedFuncs = executedServers.UnsuccessfulServers - |> List.map (fun unsuccessfulServer -> unsuccessfulServer.Server) + |> 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)) + let firstEx = + executedServers + .UnsuccessfulServers + .First() + .Failure + + return + raise ( + NoneAvailableException ( + "Not available", + firstEx + ) + ) else - return! QueryInternalImplementation - settings - initialFuncCount - failedFuncs - executedServers.SuccessfulResults - List.Empty - (retries + 1u) - retriesForInconsistency - cancellationSource + return! + QueryInternalImplementation + settings + initialFuncCount + failedFuncs + executedServers.SuccessfulResults + List.Empty + (retries + 1u) + retriesForInconsistency + cancellationSource else - let totalNumberOfSuccesfulResultsObtained = executedServers.SuccessfulResults.Length + 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) + Some ( + SpecificNumberOfConsistentResponsesRequired 2u + ) | _ -> consistencyConfig match wrappedSettings with | Some (SpecificNumberOfConsistentResponsesRequired numberOfConsistentResponsesRequired) -> - let resultsOrderedByCount = MeasureConsistency executedServers.SuccessfulResults + let resultsOrderedByCount = + MeasureConsistency executedServers.SuccessfulResults + match resultsOrderedByCount with | [] -> - return failwith - "resultsSoFar.Length != 0 but MeasureConsistency returns None, please report this bug" + return + failwith + "resultsSoFar.Length != 0 but MeasureConsistency returns None, please report this bug" | (_, maxNumberOfConsistentResultsObtained) :: _ -> if (retriesForInconsistency = settings.NumberOfRetriesForInconsistency) then - return raise - (ResultInconsistencyException - (totalNumberOfSuccesfulResultsObtained, - maxNumberOfConsistentResultsObtained, - numberOfConsistentResponsesRequired)) + return + raise ( + ResultInconsistencyException ( + totalNumberOfSuccesfulResultsObtained, + maxNumberOfConsistentResultsObtained, + numberOfConsistentResponsesRequired + ) + ) else - return! QueryInternalImplementation - settings - initialFuncCount - funcs - List.Empty - List.Empty - retries - (retriesForInconsistency + 1u) - cancellationSource - | Some (AverageBetweenResponses _) -> - if (retries = settings.NumberOfRetries) then - let firstEx = executedServers.UnsuccessfulServers.First().Failure - return raise - (NotEnoughAvailableException - ("resultsSoFar.Length != 0 but not enough to satisfy minimum number of results for averaging func", - firstEx)) - else - return! QueryInternalImplementation + return! + QueryInternalImplementation settings initialFuncCount - failedFuncs - executedServers.SuccessfulResults - executedServers.UnsuccessfulServers - (retries + 1u) - retriesForInconsistency + funcs + List.Empty + List.Empty + retries + (retriesForInconsistency + 1u) cancellationSource + | Some (AverageBetweenResponses _) -> + if (retries = settings.NumberOfRetries) then + let firstEx = + executedServers + .UnsuccessfulServers + .First() + .Failure + + return + raise ( + NotEnoughAvailableException ( + "resultsSoFar.Length != 0 but not enough to satisfy minimum number of results for averaging func", + firstEx + ) + ) + else + return! + QueryInternalImplementation + settings + initialFuncCount + failedFuncs + executedServers.SuccessfulResults + executedServers.UnsuccessfulServers + (retries + 1u) + retriesForInconsistency + cancellationSource | _ -> return failwith "wrapping settings didn't work?" } - let SortServers (servers: List>) (mode: ServerSelectionMode): List> = + let SortServers + (servers: List>) + (mode: ServerSelectionMode) + : List> = let workingServers = - List.filter (fun server -> - match server.Details.CommunicationHistory with - | None -> false - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> false - | _ -> true) servers + List.filter + (fun server -> + match server.Details.CommunicationHistory with + | None -> false + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> false + | _ -> true + ) + servers let sortedWorkingServers = - List.sortBy (fun server -> - match server.Details.CommunicationHistory with - | None -> failwith "previous filter didn't work? should get working servers only, not lacking history" - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> failwith "previous filter didn't work? should get working servers only, not faulty" - | _ -> historyInfo.TimeSpan) workingServers - - let serversWithNoHistoryServers = List.filter (fun server -> server.Details.CommunicationHistory.IsNone) servers + List.sortBy + (fun server -> + match server.Details.CommunicationHistory with + | None -> + failwith + "previous filter didn't work? should get working servers only, not lacking history" + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> + failwith + "previous filter didn't work? should get working servers only, not faulty" + | _ -> historyInfo.TimeSpan + ) + workingServers + + let serversWithNoHistoryServers = + List.filter + (fun server -> server.Details.CommunicationHistory.IsNone + ) + servers let faultyServers = - List.filter (fun server -> - match server.Details.CommunicationHistory with - | None -> false - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> true - | _ -> false) servers + List.filter + (fun server -> + match server.Details.CommunicationHistory with + | None -> false + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> true + | _ -> false + ) + servers let sortedFaultyServers = - List.sortBy (fun server -> - match server.Details.CommunicationHistory with - | None -> failwith "previous filter didn't work? should get working servers only, not lacking history" - | Some historyInfo -> - match historyInfo.Status with - | Fault _ -> historyInfo.TimeSpan - | _ -> failwith "previous filter didn't work? should get faulty servers only, not working ones") + List.sortBy + (fun server -> + match server.Details.CommunicationHistory with + | None -> + failwith + "previous filter didn't work? should get working servers only, not lacking history" + | Some historyInfo -> + match historyInfo.Status with + | Fault _ -> historyInfo.TimeSpan + | _ -> + failwith + "previous filter didn't work? should get faulty servers only, not working ones" + ) faultyServers if mode = ServerSelectionMode.Fast then - List.append sortedWorkingServers (List.append serversWithNoHistoryServers sortedFaultyServers) + List.append + sortedWorkingServers + (List.append serversWithNoHistoryServers sortedFaultyServers) else let intersectionOffset = 3u let result = FSharpUtil.ListIntersect - (List.append serversWithNoHistoryServers sortedWorkingServers) + (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 + | Selective selSettings -> + SortServers servers selSettings.ServerSelectionMode let job = QueryInternalImplementation @@ -735,13 +948,15 @@ type FaultTolerantParallelClient<'K, 'E when 'K: equality and 'K :> ICommunicati 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 a899474bd..59b15aa90 100644 --- a/src/GWallet.Backend/FiatValueEstimation.fs +++ b/src/GWallet.Backend/FiatValueEstimation.fs @@ -28,9 +28,12 @@ module FiatValueEstimation = | CoinCap | CoinGecko - let private QueryOnlineInternal currency (provider: PriceProvider): Async> = + let private QueryOnlineInternal + currency + (provider: PriceProvider) + : Async> = async { - use webClient = new WebClient() + use webClient = new WebClient () let tickerName = match currency, provider with @@ -45,9 +48,12 @@ module FiatValueEstimation = try let baseUrl = match provider with - | PriceProvider.CoinCap -> SPrintF1 "https://api.coincap.io/v2/rates/%s" tickerName + | 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 + SPrintF1 + "https://api.coingecko.com/api/v3/simple/price?ids=%s&vs_currencies=usd" + tickerName let uri = Uri baseUrl let task = webClient.DownloadStringTaskAsync uri @@ -80,7 +86,8 @@ module FiatValueEstimation = let private QueryCoinGecko currency = async { - let! maybeJson = QueryOnlineInternal currency PriceProvider.CoinGecko + let! maybeJson = + QueryOnlineInternal currency PriceProvider.CoinGecko match maybeJson with | None -> return None @@ -103,11 +110,17 @@ module FiatValueEstimation = async { let coinGeckoJob = QueryCoinGecko currency let coinCapJob = QueryCoinCap currency - let bothJobs = FSharpUtil.AsyncExtensions.MixedParallel2 coinGeckoJob coinCapJob + + 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?" + Infrastructure.ReportWarningMessage + "Currency ETC can now be queried from CoinCap provider?" let result = match maybeUsdPriceFromCoinGecko, maybeUsdPriceFromCoinCap with @@ -115,7 +128,9 @@ module FiatValueEstimation = | Some usdPriceFromCoinGecko, None -> Some usdPriceFromCoinGecko | None, Some usdPriceFromCoinCap -> Some usdPriceFromCoinCap | Some usdPriceFromCoinGecko, Some usdPriceFromCoinCap -> - let average = (usdPriceFromCoinGecko + usdPriceFromCoinCap) / 2m + let average = + (usdPriceFromCoinGecko + usdPriceFromCoinCap) / 2m + Some average let realResult = @@ -137,7 +152,9 @@ module FiatValueEstimation = let UsdValue (currency: Currency): Async> = async { - let maybeUsdPrice = Caching.Instance.RetrieveLastKnownUsdPrice currency + let maybeUsdPrice = + Caching.Instance.RetrieveLastKnownUsdPrice currency + match maybeUsdPrice with | NotAvailable -> let! maybeOnlineUsdPrice = RetrieveOnline currency diff --git a/src/GWallet.Backend/Formatting.fs b/src/GWallet.Backend/Formatting.fs index 6058d4f24..a0ddb66a6 100644 --- a/src/GWallet.Backend/Formatting.fs +++ b/src/GWallet.Backend/Formatting.fs @@ -32,16 +32,24 @@ 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))) + 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 ()) + <| SPrintF2 + "how can %s be higher than %s?" + (truncated.ToString ()) + (maxAmount.ToString ()) DecimalAmountRounding currencyType truncated diff --git a/src/GWallet.Backend/Infrastructure.fs b/src/GWallet.Backend/Infrastructure.fs index 404ea3871..976e54a41 100644 --- a/src/GWallet.Backend/Infrastructure.fs +++ b/src/GWallet.Backend/Infrastructure.fs @@ -13,7 +13,8 @@ module Infrastructure = let private sentryUrl = "https://4d1c6170ee37412fab20f8c63a2ade24:fc5e2c50990e48929d190fc283513f87@sentry.io/187797" - let private ravenClient = RavenClient (sentryUrl, Release = VersionHelper.CURRENT_VERSION) + let private ravenClient = + RavenClient (sentryUrl, Release = VersionHelper.CURRENT_VERSION) let private ReportInner (sentryEvent: SentryEvent) = ravenClient.Capture sentryEvent |> ignore @@ -48,7 +49,9 @@ module Infrastructure = #if DEBUG failwith message #else - let sentryEvent = SentryEvent (SentryMessage message, Level = errorLevel) + let sentryEvent = + SentryEvent (SentryMessage message, Level = errorLevel) + ReportInner sentryEvent #endif @@ -85,8 +88,13 @@ module Infrastructure = let ReportCrash (ex: Exception) = Report ex ErrorLevel.Fatal - let private OnUnhandledException (_: obj) (args: UnhandledExceptionEventArgs) = + let private OnUnhandledException + (_: obj) + (args: UnhandledExceptionEventArgs) + = ReportCrash (args.ExceptionObject :?> Exception) let public SetupSentryHook () = - AppDomain.CurrentDomain.UnhandledException.AddHandler (UnhandledExceptionEventHandler (OnUnhandledException)) + AppDomain.CurrentDomain.UnhandledException.AddHandler ( + UnhandledExceptionEventHandler (OnUnhandledException) + ) diff --git a/src/GWallet.Backend/JsonRpcTcpClient.fs b/src/GWallet.Backend/JsonRpcTcpClient.fs index 4b209ea44..fcfcd0f9c 100644 --- a/src/GWallet.Backend/JsonRpcTcpClient.fs +++ b/src/GWallet.Backend/JsonRpcTcpClient.fs @@ -9,21 +9,21 @@ open GWallet.Backend.FSharpUtil.UwpHacks type ProtocolGlitchException = inherit CommunicationUnsuccessfulException - new(message) = { inherit CommunicationUnsuccessfulException(message) } + new (message) = { inherit CommunicationUnsuccessfulException (message) } - new(message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException(message, innerException) } + new (message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException (message, innerException) } type ServerCannotBeResolvedException = inherit CommunicationUnsuccessfulException - new(message) = { inherit CommunicationUnsuccessfulException(message) } + new (message) = { inherit CommunicationUnsuccessfulException (message) } - new(message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException(message, innerException) } + new (message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException (message, innerException) } type ServerNameResolvedToInvalidAddressException (message: string) = - inherit CommunicationUnsuccessfulException(message) + inherit CommunicationUnsuccessfulException (message) type JsonRpcTcpClient (host: string, port: uint32) = @@ -35,12 +35,15 @@ type JsonRpcTcpClient (host: string, port: uint32) = return hostEntry.AddressList |> Array.tryHead } - let exceptionMsg = "JsonRpcSharp faced some problem when trying communication" + let exceptionMsg = + "JsonRpcSharp faced some problem when trying communication" let ResolveHost (): Async = async { try - let! maybeTimedOutipAddress = ResolveAsync host |> FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT + let! maybeTimedOutipAddress = + ResolveAsync host + |> FSharpUtil.WithTimeout Config.DEFAULT_NETWORK_TIMEOUT match maybeTimedOutipAddress with | Some ipAddressOption -> @@ -48,33 +51,67 @@ type JsonRpcTcpClient (host: string, port: uint32) = | 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) + 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) + 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)) + | :? 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 + 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) + || 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) + JsonRpcSharp.TcpClient.JsonRpcClient ( + ResolveHost, + int port, + Config.DEFAULT_NETWORK_CONNECT_TIMEOUT + ) fun jsonRequest -> tcpClient.RequestAsync jsonRequest @@ -92,20 +129,27 @@ type JsonRpcTcpClient (host: string, port: uint32) = | Some s -> s | None -> raise - <| ServerTimedOutException ("Timeout when trying to communicate with UtxoCoin server") + <| ServerTimedOutException ( + "Timeout when trying to communicate with UtxoCoin server" + ) return str with - | :? CommunicationUnsuccessfulException as ex -> return raise <| FSharpUtil.ReRaise ex + | :? CommunicationUnsuccessfulException as ex -> + return raise <| FSharpUtil.ReRaise ex | :? JsonRpcSharp.TcpClient.CommunicationUnsuccessfulException as ex -> - return raise <| CommunicationUnsuccessfulException (ex.Message, 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) + | :? 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 + | Some rewrappedSocketException -> + return raise rewrappedSocketException } diff --git a/src/GWallet.Backend/Marshalling.fs b/src/GWallet.Backend/Marshalling.fs index 370fb568e..58ae20754 100644 --- a/src/GWallet.Backend/Marshalling.fs +++ b/src/GWallet.Backend/Marshalling.fs @@ -12,17 +12,27 @@ open GWallet.Backend.FSharpUtil.UwpHacks type DeserializationException = inherit Exception - new(message: string, innerException: Exception) = { inherit Exception(message, innerException) } - new(message: string) = { inherit Exception(message) } + 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) + 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> = { @@ -39,26 +49,37 @@ type MarshallingWrapper<'T> = } type private PascalCase2LowercasePlusUnderscoreContractResolver () = - inherit DefaultContractResolver() + 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() + 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 () = - inherit DefaultContractResolver() + inherit DefaultContractResolver () override __.CreateObjectContract (objectType: Type) = let contract = base.CreateObjectContract objectType contract.ItemRequired <- Nullable Required.Always contract - override __.CreateProperty (memberInfo: MemberInfo, memberSerialization: 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 = @@ -67,6 +88,7 @@ type RequireAllPropertiesContractResolver () = if isOption then property.Required <- Required.AllowNull + property module Marshalling = @@ -79,36 +101,59 @@ 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 fullTypeName = (JsonConvert.DeserializeObject> json).TypeName + let fullTypeName = + (JsonConvert.DeserializeObject> json) + .TypeName + 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")) let deserialized = try - JsonConvert.DeserializeObject> (json, settings) + JsonConvert.DeserializeObject> ( + json, + settings + ) with ex -> let versionJsonTag = "\"Version\":\"" + if (json.Contains (versionJsonTag)) then - let jsonSinceVersion = json.Substring (json.IndexOf (versionJsonTag) + versionJsonTag.Length) + let jsonSinceVersion = + json.Substring ( + json.IndexOf (versionJsonTag) + + versionJsonTag.Length + ) let endVersionIndex = jsonSinceVersion.IndexOf ("\"") - let version = jsonSinceVersion.Substring (0, endVersionIndex) + + let version = + jsonSinceVersion.Substring (0, endVersionIndex) + if (version <> currentVersion) then let msg = SPrintF2 @@ -116,34 +161,67 @@ module Marshalling = version currentVersion - raise <| VersionMismatchDuringDeserializationException (msg, ex) + raise + <| VersionMismatchDuringDeserializationException ( + msg, + ex + ) + raise - <| DeserializationException (SPrintF1 "Exception when trying to deserialize '%s'" json, ex) + <| 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) + <| 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) + <| 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 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 private SerializeInternal<'T> + (value: 'T) + (settings: JsonSerializerSettings) + : string = + JsonConvert.SerializeObject ( + MarshallingWrapper<'T>.New value, + DefaultFormatting, + settings + ) + + 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)) + 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) diff --git a/src/GWallet.Backend/Networking.fs b/src/GWallet.Backend/Networking.fs index 3ecc7a47d..9a7c498d8 100644 --- a/src/GWallet.Backend/Networking.fs +++ b/src/GWallet.Backend/Networking.fs @@ -16,98 +16,146 @@ type CloudFlareError = type internal UnhandledSocketException = inherit Exception - new(socketErrorCode: int, innerException: Exception) = - { inherit Exception(SPrintF1 "Backend not prepared for this SocketException with ErrorCode[%i]" socketErrorCode, - innerException) } + new (socketErrorCode: int, innerException: Exception) = + { inherit Exception (SPrintF1 + "Backend not prepared for this SocketException with ErrorCode[%i]" + socketErrorCode, + innerException) } type CommunicationUnsuccessfulException = inherit Exception - new(message: string, innerException: Exception) = { inherit Exception(message, innerException) } - new(message: string) = { inherit Exception(message) } - new() = { inherit Exception() } - -type ServerDiscardedException (message: string, innerException: CommunicationUnsuccessfulException) = - inherit Exception(message, innerException) - -type BuggyExceptionFromOldMonoVersion (message: string, innerException: Exception) = - inherit CommunicationUnsuccessfulException(message, innerException) - -type ServerClosedConnectionEarlyException (message: string, innerException: Exception) = - inherit CommunicationUnsuccessfulException(message, innerException) + new (message: string, innerException: Exception) = + { inherit Exception (message, innerException) } + + new (message: string) = { inherit Exception (message) } + new () = { inherit Exception () } + +type ServerDiscardedException + ( + message: string, + innerException: CommunicationUnsuccessfulException + ) = + inherit Exception (message, innerException) + +type BuggyExceptionFromOldMonoVersion + ( + 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) + inherit CommunicationUnsuccessfulException (message, innerException) type ServerTimedOutException = inherit CommunicationUnsuccessfulException - new(message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException(message, innerException) } + 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) } - - new(message: string, httpStatusCode: HttpStatusCode, innerException: Exception) = - { 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) } + new (message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException (message, innerException) } + + new (message: string, + httpStatusCode: HttpStatusCode, + innerException: Exception) = + { 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) } type ServerMisconfiguredException = inherit CommunicationUnsuccessfulException - new(message: string, innerException: Exception) = - { inherit CommunicationUnsuccessfulException(message, innerException) } + new (message: string, innerException: Exception) = + { inherit CommunicationUnsuccessfulException (message, innerException) } - new(message: string) = { inherit CommunicationUnsuccessfulException(message) } + new (message: string) = + { inherit CommunicationUnsuccessfulException (message) } module Networking = - let FindExceptionToRethrow (ex: Exception) (newExceptionMsg): Option = + let FindExceptionToRethrow + (ex: Exception) + (newExceptionMsg) + : Option = match FSharpUtil.FindException ex with | 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 + elif socketException.ErrorCode = int + SocketError.AddressFamilyNotSupported then + 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 + 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 6aad0ab41..a180f1870 100644 --- a/src/GWallet.Backend/Properties/AssemblyInfo.fs +++ b/src/GWallet.Backend/Properties/AssemblyInfo.fs @@ -6,18 +6,18 @@ open System.Runtime.InteropServices // General Information about an assembly is controlled through the following // set of attributes. Change these attribute values to modify the information // associated with an assembly. -[] -[] -[] -[] -[] +[] +[] +[] +[] +[] // Setting ComVisible to false makes the types in this assembly not visible // to COM components. If you need to access a type in this assembly from // COM, set the ComVisible attribute to true on that type. -[] +[] // The following GUID is for the ID of the typelib if this project is exposed to COM -[] +[] do () diff --git a/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs b/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs index 059059c91..6fee70169 100644 --- a/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs +++ b/src/GWallet.Backend/Properties/CommonAssemblyInfo.fs @@ -2,9 +2,9 @@ namespace GWallet open System.Reflection -[] -[] -[] +[] +[] +[] // Version information for an assembly consists of the following four values: @@ -17,7 +17,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 () diff --git a/src/GWallet.Backend/Server.fs b/src/GWallet.Backend/Server.fs index 8b629922e..1ffa08ddd 100644 --- a/src/GWallet.Backend/Server.fs +++ b/src/GWallet.Backend/Server.fs @@ -82,8 +82,7 @@ module ServerRegistry = let internal TryFindValue (map: ServerRanking) (serverPredicate: ServerDetails -> bool) - : Option - = + : Option = let rec tryFind currencyAndServers server = match currencyAndServers with | [] -> None @@ -96,16 +95,21 @@ module ServerRegistry = 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 -> let serverToAppend = - match server.CommunicationHistory, serverInMap.CommunicationHistory with + match server.CommunicationHistory, + serverInMap.CommunicationHistory with | None, _ -> serverInMap | _, None -> server | Some (_, lastComm), Some (_, lastCommInMap) -> @@ -114,8 +118,12 @@ module ServerRegistry = else serverInMap - let newMap = serversMap.Remove serverToAppend.ServerInfo.NetworkPath - Seq.append (seq { yield serverToAppend }) (removeDupesInternal tail newMap) + let newMap = + serversMap.Remove serverToAppend.ServerInfo.NetworkPath + + Seq.append + (seq { yield serverToAppend }) + (removeDupesInternal tail newMap) let initialServersMap = servers @@ -124,7 +132,9 @@ module ServerRegistry = 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) @@ -151,9 +161,11 @@ module ServerRegistry = match history.Status with | Fault faultInfo -> let success = false + match faultInfo.LastSuccessfulCommunication with | None -> Some (success, invertOrder history.TimeSpan, None) - | Some lsc -> Some (success, invertOrder history.TimeSpan, Some lsc) + | Some lsc -> + Some (success, invertOrder history.TimeSpan, Some lsc) | Success -> let success = true Some (success, invertOrder history.TimeSpan, Some lastComm) @@ -164,7 +176,9 @@ module ServerRegistry = 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 @@ -172,11 +186,15 @@ module ServerRegistry = let Deserialize (json: string): ServerRanking = Marshalling.Deserialize json - let Merge (ranking1: ServerRanking) (ranking2: ServerRanking): ServerRanking = + let Merge + (ranking1: ServerRanking) + (ranking2: ServerRanking) + : ServerRanking = let allKeys = seq { for KeyValue (key, _) in ranking1 do yield key + for KeyValue (key, _) in ranking2 do yield key } @@ -194,14 +212,20 @@ module ServerRegistry = | None -> Seq.empty | Some servers -> servers - let allServers = (currency, Seq.append allServersFrom1 allServersFrom2) |> RemoveCruft |> Sort + let allServers = + (currency, Seq.append allServersFrom1 allServersFrom2) + |> RemoveCruft + |> Sort yield currency, allServers } |> Map.ofSeq let private ServersRankingBaseline = - Deserialize (Config.ExtractEmbeddedResourceFileContents ServersEmbeddedResourceFileName) + Deserialize ( + Config.ExtractEmbeddedResourceFileContents + ServersEmbeddedResourceFileName + ) let MergeWithBaseline (ranking: ServerRanking): ServerRanking = Merge ranking ServersRankingBaseline diff --git a/src/GWallet.Backend/ServerManager.fs b/src/GWallet.Backend/ServerManager.fs index a71fdccc9..04a37e2d2 100644 --- a/src/GWallet.Backend/ServerManager.fs +++ b/src/GWallet.Backend/ServerManager.fs @@ -12,12 +12,16 @@ module ServerManager = Infrastructure.LogInfo "INPUT:" let baseLineServers = - Config.ExtractEmbeddedResourceFileContents ServerRegistry.ServersEmbeddedResourceFileName + Config.ExtractEmbeddedResourceFileContents + ServerRegistry.ServersEmbeddedResourceFileName |> ServerRegistry.Deserialize - let fromElectrumServerToGenericServerDetails (es: UtxoCoin.ElectrumServer) = + let fromElectrumServerToGenericServerDetails + (es: UtxoCoin.ElectrumServer) + = match es.UnencryptedPort with - | None -> failwith "filtering for non-ssl electrum servers didn't work?" + | None -> + failwith "filtering for non-ssl electrum servers didn't work?" | Some unencryptedPort -> { ServerInfo = @@ -33,13 +37,20 @@ module ServerManager = } let btc = Currency.BTC - let electrumBtcServers = UtxoCoin.ElectrumServerSeedList.ExtractServerListFromElectrumRepository btc - let eyeBtcServers = UtxoCoin.ElectrumServerSeedList.ExtractServerListFromWebPage btc + + let electrumBtcServers = + UtxoCoin.ElectrumServerSeedList.ExtractServerListFromElectrumRepository + btc + + let eyeBtcServers = + UtxoCoin.ElectrumServerSeedList.ExtractServerListFromWebPage btc let baseLineBtcServers = match baseLineServers.TryGetValue btc with | true, baseLineBtcServers -> baseLineBtcServers - | false, _ -> failwith <| SPrintF1 "There should be some %A servers as baseline" btc + | false, _ -> + failwith + <| SPrintF1 "There should be some %A servers as baseline" btc let allBtcServers = Seq.append electrumBtcServers eyeBtcServers @@ -47,13 +58,20 @@ module ServerManager = |> Seq.append baseLineBtcServers let ltc = Currency.LTC - let electrumLtcServers = UtxoCoin.ElectrumServerSeedList.ExtractServerListFromElectrumRepository ltc - let eyeLtcServers = UtxoCoin.ElectrumServerSeedList.ExtractServerListFromWebPage ltc + + let electrumLtcServers = + UtxoCoin.ElectrumServerSeedList.ExtractServerListFromElectrumRepository + ltc + + let eyeLtcServers = + UtxoCoin.ElectrumServerSeedList.ExtractServerListFromWebPage ltc let baseLineLtcServers = match baseLineServers.TryGetValue ltc with | true, baseLineLtcServers -> baseLineLtcServers - | false, _ -> failwith <| SPrintF1 "There should be some %A servers as baseline" ltc + | false, _ -> + failwith + <| SPrintF1 "There should be some %A servers as baseline" ltc let allLtcServers = Seq.append electrumLtcServers eyeLtcServers @@ -61,29 +79,59 @@ module ServerManager = |> Seq.append baseLineLtcServers for KeyValue (currency, servers) in baseLineServers do - Infrastructure.LogInfo (SPrintF2 "%i %A servers from baseline JSON file" (servers.Count ()) currency) + 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) + Infrastructure.LogInfo ( + SPrintF2 "%i %A servers total" (servers.Count ()) currency + ) let private tester = FaultTolerantParallelClient @@ -110,29 +158,46 @@ module ServerManager = match currency with | Currency.BTC -> // probably a satoshi address because it was used in blockheight 2 and is unspent yet - let SATOSHI_ADDRESS = "1HLoD9E4SDFFPDiYfNYnkBLQ85Y51J3Zb1" + let SATOSHI_ADDRESS = + "1HLoD9E4SDFFPDiYfNYnkBLQ85Y51J3Zb1" // funny that it almost begins with "1HoDL" - UtxoCoin.Account.GetElectrumScriptHashFromPublicAddress currency SATOSHI_ADDRESS + UtxoCoin.Account.GetElectrumScriptHashFromPublicAddress + currency + SATOSHI_ADDRESS | Currency.LTC -> // https://medium.com/@SatoshiLite/satoshilite-1e2dad89a017 - let LTC_GENESIS_BLOCK_ADDRESS = "Ler4HNAEfwYhBmGXcFP2Po1NpRUEiK8km2" - UtxoCoin.Account.GetElectrumScriptHashFromPublicAddress currency LTC_GENESIS_BLOCK_ADDRESS + let LTC_GENESIS_BLOCK_ADDRESS = + "Ler4HNAEfwYhBmGXcFP2Po1NpRUEiK8km2" + + UtxoCoin.Account.GetElectrumScriptHashFromPublicAddress + currency + LTC_GENESIS_BLOCK_ADDRESS | _ -> failwith <| SPrintF1 "Currency %A not UTXO?" currency let utxoFunc electrumServer = async { - let! bal = UtxoCoin.ElectrumClient.GetBalance scriptHash electrumServer + let! bal = + UtxoCoin.ElectrumClient.GetBalance + scriptHash + electrumServer + return bal.Confirmed |> decimal } UtxoCoin.Server.GetServerFuncs utxoFunc servers |> Some elif currency.IsEther () then - let ETH_GENESISBLOCK_ADDRESS = "0x0000000000000000000000000000000000000000" + let ETH_GENESISBLOCK_ADDRESS = + "0x0000000000000000000000000000000000000000" let web3Func (web3: Ether.SomeWeb3): Async = async { - let! balance = Async.AwaitTask (web3.Eth.GetBalance.SendRequestAsync ETH_GENESISBLOCK_ADDRESS) + let! balance = + Async.AwaitTask ( + web3.Eth.GetBalance.SendRequestAsync + ETH_GENESISBLOCK_ADDRESS + ) + return balance.Value |> decimal } @@ -145,7 +210,9 @@ module ServerManager = | Some queryFuncs -> async { try - let! _ = tester.Query testingSettings (queryFuncs |> List.ofSeq) + let! _ = + tester.Query testingSettings (queryFuncs |> List.ofSeq) + return () with :? NoneAvailableException -> return () } @@ -155,7 +222,11 @@ module ServerManager = 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 = @@ -164,8 +235,12 @@ module ServerManager = // because ETH tokens use ETH servers if not (currency.IsEthToken ()) then - let serversForSpecificCurrency = Caching.Instance.GetServers currency - match GetDummyBalanceAction currency serversForSpecificCurrency with + let serversForSpecificCurrency = + Caching.Instance.GetServers currency + + match GetDummyBalanceAction + currency + serversForSpecificCurrency with | None -> () | Some job -> yield job } diff --git a/src/GWallet.Backend/Shuffler.fs b/src/GWallet.Backend/Shuffler.fs index a37051f46..04ee867ee 100644 --- a/src/GWallet.Backend/Shuffler.fs +++ b/src/GWallet.Backend/Shuffler.fs @@ -9,23 +9,42 @@ module Shuffler = let Unsort aSeq = 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) = + 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 -> let nextIndex = (currentIndex + 1u) + if currentIndex % offset <> 0u || tail = [] then RandomizeInternal tail offset (head :: acc) nextIndex else let randomizedRest = Unsort tail |> List.ofSeq + match randomizedRest with - | [] -> failwith "should have fallen under previous 'if' case" + | [] -> + failwith "should have fallen under previous 'if' case" | randomizedHead :: _ -> let newRest = head :: (ListRemove tail randomizedHead) - RandomizeInternal newRest offset (randomizedHead :: acc) nextIndex + + RandomizeInternal + newRest + offset + (randomizedHead :: acc) + nextIndex RandomizeInternal list offset [] 1u diff --git a/src/GWallet.Backend/TransferAmount.fs b/src/GWallet.Backend/TransferAmount.fs index 17c749e97..212e7841b 100644 --- a/src/GWallet.Backend/TransferAmount.fs +++ b/src/GWallet.Backend/TransferAmount.fs @@ -2,12 +2,20 @@ 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" + invalidArg + "balanceAtTheMomentOfSending" + "balance has to be equal or higher than valueToSend" member __.ValueToSend = Math.Round (valueToSend, currency.DecimalPlaces ()) diff --git a/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs b/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs index 381d5573e..6b156e8e7 100644 --- a/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs +++ b/src/GWallet.Backend/UtxoCoin/ElectrumClient.fs @@ -8,8 +8,8 @@ open GWallet.Backend.FSharpUtil.UwpHacks module ElectrumClient = let private Init (fqdn: string) (port: uint32): Async = - let jsonRpcClient = new JsonRpcTcpClient(fqdn, port) - let stratumClient = new StratumClient(jsonRpcClient) + let jsonRpcClient = new JsonRpcTcpClient (fqdn, port) + let stratumClient = new StratumClient (jsonRpcClient) // this is the last version of Electrum released at the time of writing this module let CLIENT_NAME_SENT_TO_STRATUM_SERVER_WHEN_HELLO = "geewallet" @@ -26,37 +26,53 @@ module ElectrumClient = async { let! versionSupportedByServer = try - stratumClient.ServerVersion CLIENT_NAME_SENT_TO_STRATUM_SERVER_WHEN_HELLO PROTOCOL_VERSION_SUPPORTED + 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 + && 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 + <| ServerTooNewException ( + SPrintF1 "Version of server rejects our client version (%s)" - (PROTOCOL_VERSION_SUPPORTED.ToString ())) + (PROTOCOL_VERSION_SUPPORTED.ToString ()) + ) else reraise () if versionSupportedByServer < PROTOCOL_VERSION_SUPPORTED then - raise - (ServerTooOldException - (SPrintF2 + raise ( + ServerTooOldException ( + SPrintF2 "Version of server is older (%s) than the client (%s)" - (versionSupportedByServer.ToString ()) - (PROTOCOL_VERSION_SUPPORTED.ToString ()))) + (versionSupportedByServer.ToString ()) + (PROTOCOL_VERSION_SUPPORTED.ToString ()) + ) + ) return stratumClient } let StratumServer (electrumServer: ServerDetails): Async = match electrumServer.ServerInfo.ConnectionType with - | { Encrypted = true; Protocol = _ } -> failwith "Incompatibility filter for non-encryption didn't work?" - | { Encrypted = false; Protocol = Http } -> failwith "HTTP server for UtxoCoin?" - | { Encrypted = false; Protocol = Tcp port } -> Init electrumServer.ServerInfo.NetworkPath port + | { + Encrypted = true + Protocol = _ + } -> failwith "Incompatibility filter for non-encryption didn't work?" + | { + Encrypted = false + Protocol = Http + } -> failwith "HTTP server for UtxoCoin?" + | { + Encrypted = false + Protocol = Tcp port + } -> Init electrumServer.ServerInfo.NetworkPath port let GetBalance (scriptHash: string) (stratumServer: Async) = async { @@ -75,44 +91,74 @@ module ElectrumClient = // [ 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 + + let! balanceResult = + stratumClient.BlockchainScriptHashGetBalance scriptHash + return balanceResult.Result } - let GetUnspentTransactionOutputs scriptHash (stratumServer: Async) = + let GetUnspentTransactionOutputs + scriptHash + (stratumServer: Async) + = async { let! stratumClient = stratumServer - let! unspentListResult = stratumClient.BlockchainScriptHashListUnspent scriptHash + + let! unspentListResult = + stratumClient.BlockchainScriptHashListUnspent scriptHash + return unspentListResult.Result } let GetBlockchainTransaction txHash (stratumServer: Async) = async { let! stratumClient = stratumServer - let! blockchainTransactionResult = stratumClient.BlockchainTransactionGet txHash + + let! blockchainTransactionResult = + stratumClient.BlockchainTransactionGet txHash + return blockchainTransactionResult.Result } - let EstimateFee (numBlocksTarget: int) (stratumServer: Async): Async = + let EstimateFee + (numBlocksTarget: int) + (stratumServer: Async) + : Async = async { let! stratumClient = stratumServer - let! estimateFeeResult = stratumClient.BlockchainEstimateFee numBlocksTarget + + let! estimateFeeResult = + stratumClient.BlockchainEstimateFee numBlocksTarget if estimateFeeResult.Result = -1m then - return raise - <| ServerMisconfiguredException ("Fee estimation returned a -1 error code") + return + raise + <| ServerMisconfiguredException ( + "Fee estimation returned a -1 error code" + ) elif estimateFeeResult.Result <= 0m then - return raise - <| ServerMisconfiguredException - (SPrintF1 "Fee estimation returned an invalid non-positive value %M" estimateFeeResult.Result) + return + raise + <| ServerMisconfiguredException ( + SPrintF1 + "Fee estimation returned an invalid non-positive value %M" + estimateFeeResult.Result + ) return estimateFeeResult.Result } - let BroadcastTransaction (transactionInHex: string) (stratumServer: Async) = + let BroadcastTransaction + (transactionInHex: string) + (stratumServer: Async) + = async { let! stratumClient = stratumServer - let! blockchainTransactionBroadcastResult = stratumClient.BlockchainTransactionBroadcast transactionInHex + + 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 4906ef131..b4d9b554c 100644 --- a/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs +++ b/src/GWallet.Backend/UtxoCoin/ElectrumServer.fs @@ -11,22 +11,22 @@ open GWallet.Backend open GWallet.Backend.FSharpUtil.UwpHacks type IncompatibleServerException (message) = - inherit CommunicationUnsuccessfulException(message) + inherit CommunicationUnsuccessfulException (message) type IncompatibleProtocolException (message) = - inherit IncompatibleServerException(message) + inherit IncompatibleServerException (message) type ServerTooNewException (message) = - inherit IncompatibleProtocolException(message) + inherit IncompatibleProtocolException (message) type ServerTooOldException (message) = - inherit IncompatibleProtocolException(message) + inherit IncompatibleProtocolException (message) type TlsNotSupportedYetInGWalletException (message) = - inherit IncompatibleServerException(message) + inherit IncompatibleServerException (message) type TorNotSupportedYetInGWalletException (message) = - inherit IncompatibleServerException(message) + inherit IncompatibleServerException (message) type ElectrumServer = { @@ -37,9 +37,16 @@ type ElectrumServer = 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 = @@ -57,14 +64,23 @@ module ElectrumServerSeedList = match currency with | Currency.BTC -> "btc" | Currency.LTC -> "ltc" - | _ -> failwith <| SPrintF1 "UTXO currency unknown to this algorithm: %A" currency + | _ -> + failwith + <| SPrintF1 + "UTXO currency unknown to this algorithm: %A" + currency + + let url = + SPrintF1 + "https://1209k.com/bitcoin-eye/ele.php?chain=%s" + currencyMnemonic - let url = SPrintF1 "https://1209k.com/bitcoin-eye/ele.php?chain=%s" currencyMnemonic let web = HtmlWeb () let doc = web.Load url let firstTable = (doc.DocumentNode.SelectNodes "//table").[0] let tableBody = firstTable.SelectSingleNode "tbody" let servers = tableBody.SelectNodes "tr" + seq { for i in 0 .. (servers.Count - 1) do let server = servers.[i] @@ -72,23 +88,35 @@ module ElectrumServerSeedList = if serverProperties.Count = 0 then failwith "Unexpected property count: 0" + let fqdn = serverProperties.[0].InnerText if serverProperties.Count < 2 then failwith - <| SPrintF2 "Unexpected property count in server %s: %i" fqdn serverProperties.Count + <| 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 + <| SPrintF3 + "Unexpected property count in server %s:%i: %i" + fqdn + port + serverProperties.Count + let portType = serverProperties.[2].InnerText let encrypted = match portType with | "ssl" -> true | "tcp" -> false - | _ -> failwith <| SPrintF1 "Got new unexpected port type: %s" portType + | _ -> + failwith + <| SPrintF1 "Got new unexpected port type: %s" portType let privatePort = if encrypted then @@ -102,11 +130,12 @@ module ElectrumServerSeedList = else Some port - yield { - Fqdn = fqdn - PrivatePort = privatePort - UnencryptedPort = unencryptedPort - } + yield + { + Fqdn = fqdn + PrivatePort = privatePort + UnencryptedPort = unencryptedPort + } } |> Seq.filter FilterCompatibleServer @@ -121,20 +150,23 @@ module ElectrumServerSeedList = 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 @@ -145,12 +177,19 @@ module ElectrumServerSeedList = let urlToElectrumJsonFile = match currency with - | Currency.BTC -> "https://raw.githubusercontent.com/spesmilo/electrum/master/electrum/servers.json" - | Currency.LTC -> "https://raw.githubusercontent.com/pooler/electrum-ltc/master/electrum_ltc/servers.json" - | _ -> failwith <| SPrintF1 "UTXO currency unknown to this algorithm: %A" currency - - use webClient = new WebClient() + | Currency.BTC -> + "https://raw.githubusercontent.com/spesmilo/electrum/master/electrum/servers.json" + | Currency.LTC -> + "https://raw.githubusercontent.com/pooler/electrum-ltc/master/electrum_ltc/servers.json" + | _ -> + failwith + <| SPrintF1 + "UTXO currency unknown to this algorithm: %A" + currency + + use webClient = new WebClient () let serverListInJson = webClient.DownloadString urlToElectrumJsonFile + ExtractServerListFromElectrumJsonFile serverListInJson |> Seq.filter FilterCompatibleServer diff --git a/src/GWallet.Backend/UtxoCoin/StratumClient.fs b/src/GWallet.Backend/UtxoCoin/StratumClient.fs index e15c85e5c..e548d480c 100644 --- a/src/GWallet.Backend/UtxoCoin/StratumClient.fs +++ b/src/GWallet.Backend/UtxoCoin/StratumClient.fs @@ -90,32 +90,48 @@ type RpcErrorCode = // see https://gitlab.gnome.org/World/geewallet/issues/112 | UnknownMethod = -32601 -type public ElectrumServerReturningErrorInJsonResponseException (message: string, code: int) = - inherit CommunicationUnsuccessfulException(message) +type public ElectrumServerReturningErrorInJsonResponseException + ( + message: string, + code: int + ) = + inherit CommunicationUnsuccessfulException (message) member val ErrorCode: int = code -type public ElectrumServerReturningErrorException (message: string, - code: int, - originalRequest: string, - originalResponse: string) = - inherit ElectrumServerReturningErrorInJsonResponseException(message, code) +type public ElectrumServerReturningErrorException + ( + message: string, + code: int, + originalRequest: string, + originalResponse: string + ) = + inherit ElectrumServerReturningErrorInJsonResponseException (message, code) member val OriginalRequest: string = originalRequest member val OriginalResponse: string = originalResponse -type public ElectrumServerReturningInternalErrorException (message: string, - code: int, - originalRequest: string, - originalResponse: string) = - inherit ElectrumServerReturningErrorException(message, code, originalRequest, originalResponse) +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) + 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> = @@ -124,29 +140,50 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = // FIXME: we should actually fix this bug in JsonRpcSharp (https://github.com/nblockchain/JsonRpcSharp/issues/9) if String.IsNullOrEmpty rawResponse then - return raise - <| ProtocolGlitchException - (SPrintF2 - "Server '%s' returned a null/empty JSON response to the request '%s'??" - jsonRpcClient.Host - jsonRequest) + return + raise + <| ProtocolGlitchException ( + SPrintF2 + "Server '%s' returned a null/empty JSON response to the request '%s'??" + jsonRpcClient.Host + jsonRequest + ) try return (StratumClient.Deserialize<'R> rawResponse, rawResponse) with :? ElectrumServerReturningErrorInJsonResponseException as ex -> if ex.ErrorCode = int RpcErrorCode.InternalError then - return raise - (ElectrumServerReturningInternalErrorException - (ex.Message, ex.ErrorCode, jsonRequest, rawResponse)) + return + raise ( + ElectrumServerReturningInternalErrorException ( + ex.Message, + ex.ErrorCode, + jsonRequest, + rawResponse + ) + ) + if ex.ErrorCode = int RpcErrorCode.UnknownMethod then - return raise <| ServerMisconfiguredException (ex.Message, ex) + 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 <| ServerUnavailabilityException (ex.Message, ex) - return raise - (ElectrumServerReturningErrorException (ex.Message, ex.ErrorCode, jsonRequest, rawResponse)) + 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 = @@ -154,45 +191,57 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = let maybeError = try - JsonConvert.DeserializeObject - (resultTrimmed, Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) + JsonConvert.DeserializeObject ( + resultTrimmed, + Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings + ) with ex -> raise - <| Exception - (SPrintF2 + <| Exception ( + SPrintF2 "Failed deserializing JSON response (to check for error) '%s' to type '%s'" - resultTrimmed - typedefof<'T>.FullName, - ex) + 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)) + raise ( + ElectrumServerReturningErrorInJsonResponseException ( + maybeError.Error.Message, + maybeError.Error.Code + ) + ) let deserializedValue = try - JsonConvert.DeserializeObject<'T> - (resultTrimmed, Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings) + JsonConvert.DeserializeObject<'T> ( + resultTrimmed, + Marshalling.PascalCase2LowercasePlusUnderscoreConversionSettings + ) with ex -> raise - <| Exception - (SPrintF2 + <| Exception ( + SPrintF2 "Failed deserializing JSON response '%s' to type '%s'" - resultTrimmed - typedefof<'T>.FullName, - ex) + resultTrimmed + typedefof<'T>.FullName, + ex + ) if Object.ReferenceEquals (deserializedValue, null) then failwith <| SPrintF2 "Failed deserializing JSON response '%s' to type '%s' (result was null)" - resultTrimmed - typedefof<'T>.FullName + resultTrimmed + typedefof<'T>.FullName deserializedValue - member self.BlockchainScriptHashGetBalance address: Async = + member self.BlockchainScriptHashGetBalance + address + : Async = let obj = { Id = 0 @@ -203,7 +252,9 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = let json = Serialize obj async { - let! resObj, _ = self.Request json + let! resObj, _ = + self.Request json + return resObj } @@ -216,9 +267,19 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = 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 = + 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 = { @@ -237,10 +298,14 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = let! resObj, rawResponse = self.Request json if Object.ReferenceEquals (resObj, null) then - failwith <| SPrintF1 "resObj is null?? raw response was %s" rawResponse + 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 + 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" @@ -249,7 +314,9 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = return StratumClient.CreateVersion (serverProtocolVersion) } - member self.BlockchainScriptHashListUnspent address: Async = + member self.BlockchainScriptHashListUnspent + address + : Async = let obj = { Id = 0 @@ -258,12 +325,17 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = } let json = Serialize obj + async { - let! resObj, _ = self.Request json + let! resObj, _ = + self.Request json + return resObj } - member self.BlockchainTransactionGet txHash: Async = + member self.BlockchainTransactionGet + txHash + : Async = let obj = { Id = 0 @@ -272,12 +344,15 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = } let json = Serialize obj + async { let! resObj, _ = self.Request json return resObj } - member self.BlockchainEstimateFee (numBlocksTarget: int): Async = + member self.BlockchainEstimateFee + (numBlocksTarget: int) + : Async = let obj = { Id = 0 @@ -292,7 +367,9 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = return resObj } - member self.BlockchainTransactionBroadcast txInHex: Async = + member self.BlockchainTransactionBroadcast + txInHex + : Async = let obj = { Id = 0 @@ -303,6 +380,8 @@ type StratumClient (jsonRpcClient: JsonRpcTcpClient) = 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 fb623acbc..d72d36b56 100644 --- a/src/GWallet.Backend/UtxoCoin/TransactionTypes.fs +++ b/src/GWallet.Backend/UtxoCoin/TransactionTypes.fs @@ -21,6 +21,8 @@ type TransactionMetadata = interface IBlockchainFeeInfo with member self.FeeEstimationTime = self.Fee.EstimationTime - member self.FeeValue = (Money.Satoshis self.Fee.EstimatedFeeInSatoshis).ToUnit MoneyUnit.BTC + 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 229fae5f5..704e89151 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinAccount.fs @@ -18,7 +18,8 @@ type internal TransactionOutpoint = OutputIndex: int } - member self.ToCoin (): Coin = Coin (self.Transaction, uint32 self.OutputIndex) + member self.ToCoin (): Coin = + Coin (self.Transaction, uint32 self.OutputIndex) type internal IUtxoAccount = inherit IAccount @@ -26,29 +27,44 @@ type internal IUtxoAccount = abstract PublicKey: PubKey -type NormalUtxoAccount (currency: Currency, - accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string, - fromAccountFileToPublicKey: FileRepresentation -> PubKey) = - inherit GWallet.Backend.NormalAccount(currency, accountFile, fromAccountFileToPublicAddress) +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 -type ReadOnlyUtxoAccount (currency: Currency, - accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string, - fromAccountFileToPublicKey: FileRepresentation -> PubKey) = - inherit GWallet.Backend.ReadOnlyAccount(currency, accountFile, fromAccountFileToPublicAddress) +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 -type ArchivedUtxoAccount (currency: Currency, - accountFile: FileRepresentation, - fromAccountFileToPublicAddress: FileRepresentation -> string, - fromAccountFileToPublicKey: FileRepresentation -> PubKey) = - inherit GWallet.Backend.ArchivedAccount(currency, accountFile, fromAccountFileToPublicAddress) +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 @@ -58,57 +74,104 @@ module Account = let internal GetNetwork (currency: Currency) = if not (currency.IsUtxo ()) then failwith - <| SPrintF1 "Assertion failed: currency %A should be UTXO-type" currency + <| 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 + <| 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 private GetElectrumScriptHashFromAddress + (address: BitcoinAddress) + : string = + 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) = + 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 let internal GetPublicAddressFromPublicKey currency (publicKey: PubKey) = - (publicKey.GetSegwitAddress (GetNetwork currency)).GetScriptAddress().ToString() - - let internal GetPublicAddressFromNormalAccountFile (currency: Currency) (accountFile: FileRepresentation): string = + (publicKey.GetSegwitAddress (GetNetwork currency)) + .GetScriptAddress() + .ToString() + + let internal GetPublicAddressFromNormalAccountFile + (currency: Currency) + (accountFile: FileRepresentation) + : string = let pubKey = PubKey (accountFile.Name) GetPublicAddressFromPublicKey currency pubKey - let internal GetPublicKeyFromNormalAccountFile (accountFile: FileRepresentation): PubKey = + let internal GetPublicKeyFromNormalAccountFile + (accountFile: FileRepresentation) + : PubKey = PubKey accountFile.Name - let internal GetPublicKeyFromReadOnlyAccountFile (accountFile: FileRepresentation): PubKey = + let internal GetPublicKeyFromReadOnlyAccountFile + (accountFile: FileRepresentation) + : PubKey = accountFile.Content () |> PubKey - let internal GetPublicAddressFromUnencryptedPrivateKey (currency: Currency) (privateKey: string) = + let internal GetPublicAddressFromUnencryptedPrivateKey + (currency: Currency) + (privateKey: string) + = let privateKey = Key.Parse (privateKey, GetNetwork currency) GetPublicAddressFromPublicKey currency privateKey.PubKey - let internal GetAccountFromFile (accountFile: FileRepresentation) (currency: Currency) kind: IAccount = + 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 + <| 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 fromAccountFileToPublicAddress = + GetPublicAddressFromNormalAccountFile currency + let fromAccountFileToPublicKey = GetPublicKeyFromNormalAccountFile - NormalUtxoAccount (currency, accountFile, fromAccountFileToPublicAddress, fromAccountFileToPublicKey) :> IAccount + + NormalUtxoAccount ( + currency, + accountFile, + fromAccountFileToPublicAddress, + fromAccountFileToPublicKey + ) + :> IAccount | _ -> failwith <| SPrintF1 "Kind (%A) not supported for this API" kind - let private BalanceToShow (balances: BlockchainScriptHashGetBalanceInnerResult) = + let private BalanceToShow + (balances: BlockchainScriptHashGetBalanceInnerResult) + = let unconfirmedPlusConfirmed = balances.Unconfirmed + balances.Confirmed let amountToShowInSatoshis = @@ -117,19 +180,22 @@ module Account = else balances.Confirmed - let amountInBtc = (Money.Satoshis amountToShowInSatoshis).ToUnit MoneyUnit.BTC + let amountInBtc = + (Money.Satoshis amountToShowInSatoshis).ToUnit MoneyUnit.BTC + amountInBtc let private BalanceMatchWithCacheOrInitialBalance address currency (someRetrievedBalance: BlockchainScriptHashGetBalanceInnerResult) - : bool - = + : bool = if Caching.Instance.FirstRun then BalanceToShow someRetrievedBalance = 0m else - match Caching.Instance.TryRetrieveLastCompoundBalance address currency with + match Caching.Instance.TryRetrieveLastCompoundBalance + address + currency with | None -> false | Some balance -> BalanceToShow someRetrievedBalance = balance @@ -137,50 +203,75 @@ module Account = (account: IUtxoAccount) (mode: ServerSelectionMode) (cancelSourceOption: Option) - : Async - = - let scriptHashHex = GetElectrumScriptHashFromPublicAddress account.Currency account.PublicAddress + : 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 + + Server.Query + account.Currency + querySettings + balanceJob + cancelSourceOption let private GetBalancesFromServer (account: IUtxoAccount) (mode: ServerSelectionMode) (cancelSourceOption: Option) - : Async> - = + : 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> - = + : Async> = async { - let! maybeBalances = GetBalancesFromServer account mode cancelSourceOption + let! maybeBalances = + GetBalancesFromServer account mode cancelSourceOption match maybeBalances with | Some balances -> return Some (BalanceToShow balances) | None -> return None } - let private ConvertToICoin (account: IUtxoAccount) (inputOutpointInfo: TransactionInputOutpointInfo): ICoin = + let private ConvertToICoin + (account: IUtxoAccount) + (inputOutpointInfo: TransactionInputOutpointInfo) + : ICoin = let txHash = uint256 inputOutpointInfo.TransactionHash - let scriptPubKeyInBytes = NBitcoin.DataEncoders.Encoders.Hex.DecodeData inputOutpointInfo.DestinationInHex + + let scriptPubKeyInBytes = + NBitcoin.DataEncoders.Encoders.Hex.DecodeData + inputOutpointInfo.DestinationInHex + 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 @@ -189,21 +280,28 @@ module Account = (transactionInputs: List) (destination: string) (amount: TransferAmount) - : TransactionBuilder - = + : TransactionBuilder = let coins = List.map (ConvertToICoin account) transactionInputs - let transactionBuilder = (GetNetwork account.Currency).CreateTransactionBuilder() + let transactionBuilder = + (GetNetwork account.Currency) + .CreateTransactionBuilder() + transactionBuilder.AddCoins coins |> ignore let currency = account.Currency - 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 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 @@ -224,11 +322,17 @@ module Account = let private ConvertToInputOutpointInfo currency (utxo: UnspentTransactionOutputInfo) - : Async - = + : Async = async { let job = ElectrumClient.GetBlockchainTransaction utxo.TransactionId - let! transRaw = Server.Query currency (QuerySettings.Default ServerSelectionMode.Fast) job None + + 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? @@ -251,8 +355,7 @@ module Account = (account: IUtxoAccount) (usedInputsSoFar: List) (unusedUtxos: List) - : Async> - = + : Async> = async { try let fees = txBuilder.EstimateFees feeRate @@ -261,37 +364,38 @@ module Account = match unusedUtxos with | [] -> return raise <| FSharpUtil.ReRaise ex | head :: tail -> - let! newInput = head |> ConvertToInputOutpointInfo account.Currency + let! newInput = + head |> ConvertToInputOutpointInfo account.Currency let newCoin = newInput |> ConvertToICoin account let newTxBuilder = txBuilder.AddCoins [ newCoin ] let newInputs = newInput :: usedInputsSoFar - return! EstimateFees newTxBuilder feeRate account newInputs tail + + return! + EstimateFees newTxBuilder feeRate account newInputs tail } let internal EstimateFee (account: IUtxoAccount) (amount: TransferAmount) (destination: string) - : Async - = + : Async = async { let rec addInputsUntilAmount (utxos: List) soFarInSatoshis amount (acc: List) - : List * List - = + : List * List = match utxos with | [] -> // should `raise InsufficientFunds` instead? failwith <| SPrintF2 "Not enough funds (needed: %s, got so far: %s)" - (amount.ToString ()) - (soFarInSatoshis.ToString ()) + (amount.ToString ()) + (soFarInSatoshis.ToString ()) | utxoInfo :: tail -> let newAcc = // Avoid querying for zero-value UTXOs, which would make many unnecessary parallel @@ -308,16 +412,24 @@ module Account = 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 + GetElectrumScriptHashFromPublicAddress + account.Currency + account.PublicAddress |> ElectrumClient.GetUnspentTransactionOutputs - let! utxos = Server.Query account.Currency (QuerySettings.Default ServerSelectionMode.Fast) job None + let! utxos = + Server.Query + account.Currency + (QuerySettings.Default ServerSelectionMode.Fast) + job + None if not (utxos.Any ()) then failwith "No UTXOs found!" @@ -325,28 +437,41 @@ module Account = let possibleInputs = seq { for utxo in utxos do - yield { - TransactionId = utxo.TxHash - OutputIndex = utxo.TxPos - Value = utxo.Value - } + yield + { + TransactionId = utxo.TxHash + OutputIndex = utxo.TxPos + Value = utxo.Value + } } // first ones are the smallest ones - let inputsOrderedByAmount = possibleInputs.OrderBy (fun utxo -> utxo.Value) |> List.ofSeq + let inputsOrderedByAmount = + possibleInputs.OrderBy (fun utxo -> utxo.Value) |> List.ofSeq - let amountInSatoshis = Money(amount.ValueToSend, MoneyUnit.BTC).Satoshi + let amountInSatoshis = + Money(amount.ValueToSend, MoneyUnit.BTC).Satoshi - let utxosToUse, unusedInputs = addInputsUntilAmount inputsOrderedByAmount 0L amountInSatoshis List.Empty + let utxosToUse, unusedInputs = + addInputsUntilAmount + inputsOrderedByAmount + 0L + amountInSatoshis + List.Empty - let asyncInputs = List.map (ConvertToInputOutpointInfo account.Currency) utxosToUse + let asyncInputs = + List.map + (ConvertToInputOutpointInfo account.Currency) + utxosToUse let! inputs = Async.Parallel asyncInputs let initiallyUsedInputs = inputs |> List.ofArray let averageFee (feesFromDifferentServers: List): decimal = - let avg = feesFromDifferentServers.Sum () / decimal feesFromDifferentServers.Length + let avg = + feesFromDifferentServers.Sum () + / decimal feesFromDifferentServers.Length avg @@ -354,7 +479,11 @@ module Account = let estimateFeeJob = ElectrumClient.EstimateFee 2 let! btcPerKiloByteForFastTrans = - Server.Query account.Currency (QuerySettings.FeeEstimation averageFee) estimateFeeJob None + Server.Query + account.Currency + (QuerySettings.FeeEstimation averageFee) + estimateFeeJob + None let feeRate = try @@ -362,28 +491,45 @@ module Account = with ex -> // we need more info in case this bug shows again: https://gitlab.com/knocte/geewallet/issues/43 raise - <| Exception - (SPrintF1 + <| Exception ( + SPrintF1 "Could not create fee rate from %s btc per KB" - (btcPerKiloByteForFastTrans.ToString ()), - ex) + (btcPerKiloByteForFastTrans.ToString ()), + ex + ) let transactionBuilder = - CreateTransactionAndCoinsToBeSigned account initiallyUsedInputs destination amount + CreateTransactionAndCoinsToBeSigned + account + initiallyUsedInputs + destination + amount try let! estimatedMinerFee, allUsedInputs = - EstimateFees transactionBuilder feeRate account initiallyUsedInputs unusedInputs + EstimateFees + transactionBuilder + feeRate + account + initiallyUsedInputs + unusedInputs let estimatedMinerFeeInSatoshis = estimatedMinerFee.Satoshi - let minerFee = MinerFee (estimatedMinerFeeInSatoshis, DateTime.UtcNow, account.Currency) - - return { - Inputs = allUsedInputs - Fee = minerFee - } - with :? NBitcoin.NotEnoughFundsException -> return raise <| InsufficientBalanceForFee None + let minerFee = + MinerFee ( + estimatedMinerFeeInSatoshis, + DateTime.UtcNow, + account.Currency + ) + + return + { + Inputs = allUsedInputs + Fee = minerFee + } + with :? NBitcoin.NotEnoughFundsException -> + return raise <| InsufficientBalanceForFee None } let private SignTransactionWithPrivateKey @@ -396,27 +542,42 @@ module Account = let btcMinerFee = txMetadata.Fee - let finalTransactionBuilder = CreateTransactionAndCoinsToBeSigned account txMetadata.Inputs destination amount + let finalTransactionBuilder = + CreateTransactionAndCoinsToBeSigned + account + txMetadata.Inputs + destination + amount finalTransactionBuilder.AddKeys privateKey |> ignore - finalTransactionBuilder.SendFees (Money.Satoshis (btcMinerFee.EstimatedFeeInSatoshis)) + + finalTransactionBuilder.SendFees ( + Money.Satoshis (btcMinerFee.EstimatedFeeInSatoshis) + ) |> ignore let finalTransaction = finalTransactionBuilder.BuildTransaction true let transCheckResultAfterSigning = finalTransaction.Check () + if (transCheckResultAfterSigning <> TransactionCheckResult.Success) then failwith - <| SPrintF1 "Transaction check failed after signing with %A" transCheckResultAfterSigning + <| 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) + BitcoinEncryptedSecretNoEC ( + encryptedPrivateKey, + GetNetwork (account :> IAccount).Currency + ) try encryptedSecret.GetKey (password) @@ -432,18 +593,34 @@ module Account = let privateKey = GetPrivateKey account password - let signedTransaction = SignTransactionWithPrivateKey account txMetadata destination amount privateKey + let signedTransaction = + SignTransactionWithPrivateKey + account + txMetadata + destination + amount + privateKey + let rawTransaction = signedTransaction.ToHex () rawTransaction - let internal CheckValidPassword (account: NormalAccount) (password: string) = + let internal CheckValidPassword + (account: NormalAccount) + (password: string) + = GetPrivateKey account password |> ignore - let private BroadcastRawTransaction currency (rawTx: string): Async = + let private BroadcastRawTransaction + currency + (rawTx: string) + : Async = let job = ElectrumClient.BroadcastTransaction rawTx Server.Query currency QuerySettings.Broadcast job None - let internal BroadcastTransaction currency (transaction: SignedTransaction<_>) = + let internal BroadcastTransaction + currency + (transaction: SignedTransaction<_>) + = // FIXME: stop embedding TransactionInfo element in SignedTransaction // and show the info from the RawTx, using NBitcoin to extract it BroadcastRawTransaction currency transaction.RawTransaction @@ -456,10 +633,16 @@ module Account = (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 + let finalTransaction = + SignTransaction account txMetadata destination amount password + BroadcastRawTransaction baseAccount.Currency finalTransaction // TODO: maybe move this func to Backend.Account module, or simply inline it (simple enough) @@ -470,13 +653,15 @@ module Account = (transProposal: UnsignedTransactionProposal) (txMetadata: TransactionMetadata) (readOnlyAccounts: seq) - : string - = + : string = let unsignedTransaction = { Proposal = transProposal - Cache = Caching.Instance.GetLastCachedData().ToDietCache readOnlyAccounts + Cache = + Caching + .Instance + .GetLastCachedData().ToDietCache readOnlyAccounts Metadata = txMetadata } @@ -491,25 +676,41 @@ module Account = let currency = (account :> IAccount).Currency let network = GetNetwork currency let amount = TransferAmount (balance, balance, currency) - let privateKey = Key.Parse (account.GetUnencryptedPrivateKey (), network) + + let privateKey = + Key.Parse (account.GetUnencryptedPrivateKey (), network) let signedTrans = - SignTransactionWithPrivateKey account txMetadata destination.PublicAddress amount privateKey + SignTransactionWithPrivateKey + account + txMetadata + destination.PublicAddress + amount + privateKey BroadcastRawTransaction currency (signedTrans.ToHex ()) - let internal Create currency (password: string) (seed: array): Async = + 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 encryptedSecret = + secret.PrivateKey.GetEncryptedBitcoinSecret (password, network) + let encryptedPrivateKey = encryptedSecret.ToWif () let publicKey = secret.PubKey.ToString () - return { - Name = publicKey - Content = fun _ -> encryptedPrivateKey - } + + return + { + Name = publicKey + Content = fun _ -> encryptedPrivateKey + } } let internal ValidateAddress (currency: Currency) (address: string) = @@ -523,6 +724,7 @@ module Account = | BTC -> let BITCOIN_ADDRESS_PUBKEYHASH_PREFIX = "1" let BITCOIN_ADDRESS_SCRIPTHASH_PREFIX = "3" + [ BITCOIN_ADDRESS_PUBKEYHASH_PREFIX BITCOIN_ADDRESS_SCRIPTHASH_PREFIX @@ -531,17 +733,23 @@ module Account = | LTC -> let LITECOIN_ADDRESS_PUBKEYHASH_PREFIX = "L" let LITECOIN_ADDRESS_SCRIPTHASH_PREFIX = "M" + [ 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 + if (not ( + utxoCoinValidAddressPrefixes.Any (fun prefix -> + address.StartsWith prefix + ) + )) then raise (AddressMissingProperPrefix (utxoCoinValidAddressPrefixes)) let minLength, lenghtInBetweenAllowed, maxLength = - if currency = Currency.BTC && (address.StartsWith BITCOIN_ADDRESS_BECH32_PREFIX) then + 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 @@ -549,17 +757,21 @@ module Account = 27, true, 34 let limits = [ minLength; maxLength ] + if address.Length > maxLength then raise <| AddressWithInvalidLength limits + if address.Length < minLength then raise <| AddressWithInvalidLength limits + if not lenghtInBetweenAllowed && (address.Length <> minLength && address.Length <> maxLength) then raise <| AddressWithInvalidLength limits let network = GetNetwork currency + try BitcoinAddress.Create (address, network) |> ignore with - // TODO: propose to NBitcoin upstream to generate an NBitcoin exception instead - :? FormatException -> raise (AddressWithInvalidChecksum None) + // TODO: propose to NBitcoin upstream to generate an NBitcoin exception instead + :? FormatException -> raise (AddressWithInvalidChecksum None) diff --git a/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs b/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs index 80f6801ea..538d57fbc 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinMinerFee.fs @@ -5,7 +5,12 @@ 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 diff --git a/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs b/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs index 6348ba20c..16bb1260e 100644 --- a/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs +++ b/src/GWallet.Backend/UtxoCoin/UtxoCoinServer.fs @@ -21,7 +21,10 @@ 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 @@ -30,7 +33,8 @@ module Server = { NumberOfParallelJobsAllowed = NumberOfParallelJobsForMode mode NumberOfRetries = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS - NumberOfRetriesForInconsistency = Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS + NumberOfRetriesForInconsistency = + Config.NUMBER_OF_RETRIES_TO_SAME_SERVERS ExceptionHandler = Some (fun ex -> Infrastructure.ReportWarning ex) ResultSelectionMode = Selective @@ -52,28 +56,30 @@ module Server = = let consistencyConfig = if mode = ServerSelectionMode.Fast then - Some (OneServerConsistentWithCertainValueOrTwoServers cacheOrInitialBalanceMatchFunc) + 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> - = + : seq> = let ElectrumServerToRetrievalFunc (server: ServerDetails) (electrumClientFunc: Async -> Async<'R>) - : Async<'R> - = + : Async<'R> = async { try let stratumClient = ElectrumClient.StratumServer server @@ -82,32 +88,44 @@ module Server = // 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 + let msg = + SPrintF2 "%s: %s" (ex.GetType().FullName) ex.Message + return raise <| ServerDiscardedException (msg, ex) | ex -> - return raise - <| Exception - (SPrintF1 "Some problem when connecting to %s" server.ServerInfo.NetworkPath, ex) + return + raise + <| Exception ( + SPrintF1 + "Some problem when connecting to %s" + server.ServerInfo.NetworkPath, + ex + ) } let ElectrumServerToGenericServer (electrumClientFunc: Async -> Async<'R>) (electrumServer: ServerDetails) - : Server - = + : Server = { Details = electrumServer - Retrieval = ElectrumServerToRetrievalFunc electrumServer electrumClientFunc + 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> - = + : List> = let electrumServers = ElectrumServerSeedList.Randomize currency GetServerFuncs electrumClientFunc electrumServers |> List.ofSeq @@ -117,22 +135,32 @@ module Server = (settings: QuerySettings<'R>) (job: Async -> Async<'R>) (cancelSourceOption: Option) - : Async<'R> - = + : Async<'R> = let query = match cancelSourceOption with | None -> faultTolerantElectrumClient.Query - | Some cancelSource -> faultTolerantElectrumClient.QueryWithCancellation cancelSource + | Some cancelSource -> + faultTolerantElectrumClient.QueryWithCancellation cancelSource let querySettings = match settings with - | Default mode -> FaultTolerantParallelClientDefaultSettings mode None - | Balance (mode, predicate) -> FaultTolerantParallelClientSettingsForBalanceCheck mode predicate + | Default mode -> + FaultTolerantParallelClientDefaultSettings mode None + | Balance (mode, predicate) -> + FaultTolerantParallelClientSettingsForBalanceCheck + mode + predicate | FeeEstimation averageFee -> let minResponsesRequired = 3u + FaultTolerantParallelClientDefaultSettings ServerSelectionMode.Fast - (Some (AverageBetweenResponses (minResponsesRequired, averageFee))) + (Some ( + AverageBetweenResponses ( + minResponsesRequired, + averageFee + ) + )) | Broadcast -> FaultTolerantParallelClientSettingsForBroadcast () query querySettings (GetRandomizedFuncs currency job) diff --git a/src/GWallet.Backend/WarpKey.fs b/src/GWallet.Backend/WarpKey.fs index 06f2f6f74..e56b275c5 100644 --- a/src/GWallet.Backend/WarpKey.fs +++ b/src/GWallet.Backend/WarpKey.fs @@ -17,8 +17,10 @@ module WarpKey = raise (ArgumentException ()) else let result = Array.create a.Length (byte 0) + for i = 0 to (a.Length - 1) do result.[i] <- ((a.[i]) ^^^ (b.[i])) + result let Scrypt (passphrase: string) (salt: string): array = @@ -31,8 +33,15 @@ module WarpKey = 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 @@ -44,10 +53,15 @@ module WarpKey = 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 @@ -55,10 +69,12 @@ module WarpKey = let scrypt = Scrypt passphrase salt let pbkdf2 = PBKDF2 passphrase salt let privKeyBytes = XOR scrypt pbkdf2 + if (privKeyBytes.Length <> LENGTH_OF_PRIVATE_KEYS) then failwith <| SPrintF2 "Something went horribly wrong because length of privKey was not %i but %i" - LENGTH_OF_PRIVATE_KEYS - privKeyBytes.Length + LENGTH_OF_PRIVATE_KEYS + privKeyBytes.Length + privKeyBytes