diff options
Diffstat (limited to 'whispers/services/whispers/finance.scm')
| -rw-r--r-- | whispers/services/whispers/finance.scm | 332 |
1 files changed, 332 insertions, 0 deletions
diff --git a/whispers/services/whispers/finance.scm b/whispers/services/whispers/finance.scm new file mode 100644 index 0000000..1c1fb0e --- /dev/null +++ b/whispers/services/whispers/finance.scm @@ -0,0 +1,332 @@ +;;; Whispers --- Stealth VPN and ssh tunneler +;;; Copyright © 2023 Runciter <runciter@whispers-vpn.org> +;;; +;;; This file is part of Whispers. +;;; +;;; Whispers is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; Whispers is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with Whispers. If not, see <http://www.gnu.org/licenses/>. + +(define-module (whispers services whispers finance) + #:use-module (guix gexp) + #:use-module (guix records) + #:use-module (gnu system shadow) + #:use-module (gnu services) + #:use-module (gnu services shepherd) + #:use-module (whispers services whispers) + #:use-module (whispers services finance) + #:use-module (gnu packages finance) + #:use-module (gnu packages guile) + #:use-module (gnu packages linux) + #:export (whispers-finance-service-type + whispers-finance-configuration + whispers-finance-configuration? + crypto-user-group-nodes + crypto-user-group-nodes? + nodes-configuration + nodes-configuration? + bitcoin-node-configuration + bitcoin-node-configuration? + monero-node-configuration + monero-node-configuration?)) + +(define-record-type* <whispers-finance-configuration> + whispers-finance-configuration make-finance-configuration + whispers-finance-configuration? + this-whispers-finance-configuration + ;; A list of crypto-user-group-nodes records + (users-groups-nodes whispers-finance-configuration-users-groups-nodes + (default '()))) + +(define-record-type* <crypto-user-group-nodes> + crypto-user-group-nodes make-crypto-user-group-nodes + crypto-user-group-nodes? + this-crypto-user-group-nodes + ;; A whispers-user-group record + (user-and-group crypto-user-group-nodes-user-and-group + (default (whispers-user-group))) + ;; A <nodes-configuration record> + (nodes crypto-user-group-nodes-nodes + (default '(nodes-configuration)))) + +(define-record-type* <nodes-configuration> + nodes-configuration make-nodes-configuration + nodes-configuration? + this-nodes-configuration + ;; A boolean value. + (bitcoin? nodes-configuration-bitcoin? + (default #f)) + ;; A <bitcoin-node-configuration> record + (btc-node nodes-configuration-btc-node + (default (bitcoin-node-configuration))) + ;; A boolean value + (monero? nodes-configuration-monero? + (default #f)) + ;; A <monero-node-configuration> record + (xmr-node nodes-configuration-xmr-node + (default (monero-node-configuration)))) + +(define-record-type* <bitcoin-node-configuration> + bitcoin-node-configuration make-bitcoin-node-configuration + bitcoin-node-configuration? + this-bitcoin-node-configuration + ;; A file-like object + (bitcoin-package bitcoin-node-configuration-bitcoin-package + (default bitcoin-core)) + ;; A boolean value + (walletdir-opt? bitcoin-node-configuration-walletdir-opt? + (default #f)) + ;; A string + (walletdir bitcoin-node-configuration-walletdir + (default "")) + ;; A boolean value + (proxy-opt? bitcoin-node-configuration-proxy-opt? + (default #f)) + ;; A string + (proxy bitcoin-node-configuration-proxy + (default "")) + ;; A boolean value + (%auto-start? bitcoin-node-configuration-auto-start? + (default #t))) + +(define-record-type* <monero-node-configuration> + monero-node-configuration make-monero-node-configuration + monero-node-configuration? + this-monero-node-configuration + ;; A file-like object + (monero-package monero-node-configuration-monero-package + (default monero)) + ;; A boolean value + (proxy-opt? monero-node-configuration-proxy-opt? + (default #f)) + ;; A string + (proxy monero-node-configuration-proxy + (default "")) + ;; A boolean value + (tx-proxy-opt? monero-node-configuration-tx-proxy-opt? + (default #f)) + ;; A boolean value + (prune-blockchain-opt? monero-node-configuration-prune-blockchain-opt? + (default #f)) + ;; A string + (tx-proxy monero-node-configuration-tx-proxy + (default "")) + ;; A boolean value + (%auto-start? monero-node-configuration-auto-start? + (default #t))) + +(define (log-folder user) + "Return a string naming the path to the folder where the log file of +the bitcoin node daemon of the user named by the string USER is stored." + (string-append "/var/log/whispers/finance/" + (user-container-name user) + "/bitcoin")) + +(define (rightwing-log-folder user) + "Return a string naming the path to the folder where the log file of +the monero node daemon of the user named by the string USER is stored." + (string-append "/var/log/whispers/finance/" + (user-container-name user) + "/monero")) + +(define (pid-folder user) + "Return a string naming the path to the folder where the pid file of +the bitcoin node daemon of the user named by the string USER is +located." + (string-append "/run/whispers/finance/" + (user-container-name user) + "/bitcoin")) + +(define (rightwing-pid-folder user) + "Return a string naming the path to the folder where the pid file of +the monero node daemon of the user named by the string USER is +located." + (string-append "/run/whispers/finance/" + (user-container-name user) + "/monero")) + +(define (btc-node user wal) + "Returns a bitcoin node guix service for a bitcoin node daemon from +the package BITCOIN-PACKAGE owned by the user named by the string USER +and with the wallet parameters configured by WAL, a record of the +<bitcoin-node-configuration> type." + (let ((bitcoin-package (bitcoin-node-configuration-bitcoin-package wal)) + (walletdir-opt? (bitcoin-node-configuration-walletdir-opt? wal)) + (walletdir (bitcoin-node-configuration-walletdir wal)) + (proxy-opt? (bitcoin-node-configuration-proxy-opt? wal)) + (proxy (bitcoin-node-configuration-proxy wal)) + (auto-start? (bitcoin-node-configuration-auto-start? wal))) + (service + bitcoin-service-type + (bitcoin-configuration (bitcoin-package bitcoin-package) + (user user) + (log-folder (log-folder user)) + (pid (string-append (pid-folder user) + "/" + "bitcoin.pid")) + (walletdir-opt? walletdir-opt?) + (walletdir walletdir) + (proxy-opt? proxy-opt?) + (proxy proxy) + (%auto-start? auto-start?))))) + +(define (rightwing-node user node) + "Returns a monero node guix service for a monero node daemon from the +package MONERO-PACKAGE owned by the user named by the string USER and +with the node parameters configured by NODE, a record of the +<monero-node-configuration> type." + (let ((monero-package (monero-node-configuration-monero-package node)) + (proxy-opt? (monero-node-configuration-proxy-opt? node)) + (proxy (monero-node-configuration-proxy node)) + (tx-proxy-opt? (monero-node-configuration-tx-proxy-opt? node)) + (tx-proxy (monero-node-configuration-tx-proxy node)) + (prune? (monero-node-configuration-prune-blockchain-opt? node)) + (auto-start? (monero-node-configuration-auto-start? node))) + (service + monero-service-type + (monero-configuration (monero-package monero-package) + (user user) + (log-folder (rightwing-log-folder user)) + (pidfile + (string-append (rightwing-pid-folder user) + "/" + "monero.pid")) + (proxy-opt? proxy-opt?) + (proxy proxy) + (tx-proxy-opt? tx-proxy-opt?) + (tx-proxy tx-proxy) + (prune-blockchain-opt? prune?) + (%auto-start? auto-start?))))) + +(define (extra-actions user group nodes) + "Return a list of <shepherd-action> records for the creation and +destruction of the folders and temporary file systems necessary for the +operation of the bitcoin node daemon of the user named by the string +USER, configuration by NODES, a record of the <nodes-configuration> +type." + (let* ((user-str (user-container-name user)) + (user-sym (string->symbol user-str)) + (bitcoin? (nodes-configuration-bitcoin? nodes)) + (monero? (nodes-configuration-monero? nodes))) + (list (shepherd-action + (name 'pre-start) + (documentation "Create the directories and tmpfs mounts +used by the bitcoin node daemon.") + (procedure + #~(lambda (running) + (unless (not #$bitcoin?) + (perform-service-action (lookup-service '#$user-sym) + 'make-directory + #$(log-folder user-str) + #$user + #$group + #$(number->string #o755 8)) + (perform-service-action (lookup-service '#$user-sym) + 'make-tmpfs + #$(pid-folder user) + #$user + #$group + #$(number->string #o755 8))) + (unless (not #$monero?) + (perform-service-action (lookup-service '#$user-sym) + 'make-directory + #$(rightwing-log-folder user-str) + #$user + #$group + #$(number->string #o755 8)) + (perform-service-action (lookup-service '#$user-sym) + 'make-tmpfs + #$(rightwing-pid-folder user) + #$user + #$group + #$(number->string #o755 8)))))) + (shepherd-action + (name 'post-stop) + (documentation "Unmount the tmpfs mounts used by the bitcoin +node daemon.") + (procedure + #~(lambda (running) + (unless (not #$bitcoin?) + (perform-service-action (lookup-service '#$user-sym) + 'clear-tmpfs + #$(pid-folder user))) + (unless (not #$monero?) + (perform-service-action (lookup-service '#$user-sym) + 'clear-tmpfs + #$(rightwing-pid-folder + user))))))))) + +(define (node-lieutenants user nodes) + "Returns a list of zero to two crypto node guix shepherd services +daemonizing a bitcoin and/or a monero node, running as the user USER, +and configured by NODES, a record of the <nodes-configuration> type." + (let* ((user-str (user-container-name user)) + (user-sym (string->symbol user-str)) + (bitcoin? (nodes-configuration-bitcoin? nodes)) + (bitcoin-node (nodes-configuration-btc-node nodes)) + (monero? (nodes-configuration-monero? nodes)) + (monero-node (nodes-configuration-xmr-node nodes))) + (append (if bitcoin? + (list (btc-node user + bitcoin-node)) + (list)) + (if monero? + (list (rightwing-node user + monero-node)) + (list))))) + + +(define (nodes-lieutenant user group nodes) + "Returns an elementary whispers service tree for a single user's +section of whispers finance sub-tree, at the tip of which a bitcoin node +daemon and a monero node can be daemonized owned by the user named by +the string USER and the group named by the string GROUP, with nodes +configured by NODES, a record of the <nodes-configuration> type." + (service whispers-service-type + (whispers-configuration (name (string->symbol + (user-container-name user))) + (lieutenants (node-lieutenants user + nodes)) + (user user) + (group group) + (pre-start-action? #t) + (post-stop-action? #t) + (extra-actions (extra-actions user + group + nodes))))) + +(define (whispers-finance-tree config) + "Returns a whispers service tree for a whispers bitcoin nodes +sub-tree, configurable by CONFIG, a record of the +<whispers-finance-configuration> type." + (let* ((ugws (whispers-finance-configuration-users-groups-nodes config)) + (user-group crypto-user-group-nodes-user-and-group) + (user (lambda (ugw) (whispers-user-group-user (user-group ugw)))) + (group (lambda (ugw) (whispers-user-group-group (user-group ugw)))) + (nodes (lambda (ugw) + (crypto-user-group-nodes-nodes ugw)))) + (list (service whispers-service-type + (whispers-configuration + (name 'finance) + (lieutenants (map (lambda (ugw) + (nodes-lieutenant (user ugw) + (group ugw) + (nodes ugw))) + ugws))))))) + +(define whispers-finance-service-type + (service-type + (name '(whispers-finance)) + (description "Daemonized per-user cryptocurrency nodes") + (extensions (list (service-extension whispers-service-type + whispers-finance-tree))) + (default-value (whispers-finance-configuration)))) |