aboutsummaryrefslogtreecommitdiffstats
path: root/config/shepherd/init.d/cardano.scm
blob: b8efbcaa3aeca4f582c6ea790a6b4e376f7efec5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
(define (make-dir-parents dir-path)
  (unless (access? dir-path F_OK)
    (make-dir-parents (dirname dir-path))
    (mkdir dir-path)))

(register-services
 (make <service>
   #:docstring "Nina ssh tunnel, Cardano nodes"
   #:provides '(nina-ssh)
   #:start (make-forkexec-constructor
            (list "ssh" "-NTv"
                  "-o" "ServerAliveInterval=60"
                  "-o" "ExitOnForwardFailure=yes"
                  "-o" "StreamLocalBindUnlink=yes"
                  "-L" "/tmp/nina-mn.socket:/run/cardano-node-mainnet/socket"
                  "-L" "/tmp/nina-pr.socket:/run/cardano-node-preview/socket"
                  "-L" "54320:localhost:5432"
                  "-L" "50001:localhost:50001" ;; electrs
                  "-L" "24224:localhost:24224" ;; electrs monitoring
                  "cardano@nina")
            #:log-file "/tmp/nina-ssh.log")
   #:stop (make-kill-destructor 2) ;; 2 is SIGINT - interupt process stream, ctrl-C
   #:respawn? #t))

(register-services
 (make <service>
   #:docstring "Cardano preview wallet"
   #:provides '(preview-wallet)
   #:start (make-forkexec-constructor
            (list "cardano-wallet"
             ;;(string-append (getenv "HOME") "/.cabal/bin/cardano-wallet")
                  "serve"
                  "--port" "8091"
                  "--node-socket" "/tmp/nina-pr.socket"
                  "--database" (string-append (getenv "HOME") "/test-cardano/preview/wallet")
                  "--testnet"  (string-append (getenv "HOME") "/dev/archlinux-ansible/roles/cardano/files/preview/byron-genesis.json"))
            #:log-file (string-append (getenv "HOME") "/test-cardano/preview/log/wallet.log"))

   #:stop (make-kill-destructor 2) ;; 2 is SIGINT - interupt process stream, ctrl-C
   #:requires '(nina-ssh)))

(register-services
 (make <service>
   #:docstring "Mainnet wallet"
   #:provides '(mainnet-wallet)
   #:start (make-forkexec-constructor
            (list ;;(string-append (getenv "HOME") "/.cabal/bin/cardano-wallet")
             "cardano-wallet"
                  "serve"
                  "+RTS" "-T" "-RTS"
                  "--node-socket" "/tmp/nina-mn.socket"
                  "--database" (string-append (getenv "HOME") "/test-cardano/main/wallet")
                  "--mainnet")
            #:log-file (string-append (getenv "HOME") "/test-cardano/main/log/wallet.log"))
   #:stop (make-kill-destructor 2) ;; 2 is SIGINT - interupt process stream, ctrl-C
   #:requires '(nina-ssh)))
ss="p">(#\< #'1-) (#\v #'(lambda (p) (- p +chamber-width+)))) current))) (if (and (>= next 0) ;; no rolling boundaries (multiple-value-bind (y x) (coords current) (multiple-value-bind (y2 x2) (coords next) (= 1 (+ (abs (- x x2)) (abs (- y y2)))))) (not (member next obstacles :test #'eq))) next (return-from no-collision-move object)))) object)) (fiveam:test moves (fiveam:is (equal '(6) (no-collision-move '(6) #\v nil))) (fiveam:is (equal '(6) (no-collision-move '(6) #\> nil))) (fiveam:is (equal '(6) (no-collision-move '(6) #\< '(5))))) (defun gen-object (seq) (let ((len (length seq)) (index 0)) (lambda () (prog1 (aref seq index) (setf index (mod (1+ index) len)))))) (defun place-rock (rock highpoint) (let ((left-pad 2) (altitude (* +chamber-width+ highpoint))) (mapcar (lambda (point) (+ point left-pad altitude)) rock))) (defun next-move (rock next-move obstacles) (let* ((shift (no-collision-move rock next-move obstacles)) (drop (no-collision-move shift #\v obstacles))) (values drop (equal shift drop)))) (defun highpoint (obstacles) (1+ (coords (reduce #'max obstacles)))) (defun simulate (chamber rock next-shift) (multiple-value-bind (new-place done-falling-p) (next-move rock (funcall next-shift) chamber) (if done-falling-p (values (append new-place chamber) (highpoint new-place)) (simulate chamber new-place next-shift)))) (defun solver (drops-left highpoint raise-history obstacles next-rock next-shift) (if (zerop drops-left) raise-history (multiple-value-bind (new-obstacles posible-high) (simulate obstacles (place-rock (funcall next-rock) (+ highpoint 3)) next-shift) (let ((new-high (max highpoint posible-high))) (solver (1- drops-left) new-high (cons new-high raise-history) ;; new-obstacles (if (zerop (mod drops-left 100)) ;; arbitrarily chop list (subseq new-obstacles 0 (min 128 (length new-obstacles))) new-obstacles) next-rock next-shift))))) (defun occurrences (lst) (let ((table (make-hash-table :test #'eq))) (loop for e in lst do (incf (gethash e table 0))) table)) (defun to-alist (table) (loop for k being the hash-key of table using (hash-value v) collect (cons k v))) (defun find-period (history max-window) (let ((len (1- (length history)))) (loop for size from 1 to max-window for raises = (loop for start from 0 to len by size for end from size by size collect (- (aref history (min end len)) (aref history start))) for periods = (occurrences raises) for test = (and (<= (hash-table-count periods) 3) (car (find-if (lambda (f) (< 1 (cdr f))) (to-alist periods)))) until test finally (return (values size test))))) (defun height-reached (max-drops history max-window) (multiple-value-bind (period block-height) (find-period history max-window) (multiple-value-bind (cycles left) (floor max-drops period) (let ((offset (aref history period)) (remaining (- (aref history (+ left period)) (aref history period)))) (+ offset (* (1- cycles) block-height) remaining))))) (fiveam:test solutions ;; part 1 (fiveam:is (= 3068 (car (solver 2022 0 '(0) nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in")))))) (fiveam:is (= 3141 (car (solver 2022 0 '(0) nil (gen-object *rocks*) (gen-object (uiop:read-file-line "input")))))) ;; part 2 (let* ((drops 1000000000000) (quick-run 10000) (max-period-window 3620) (history-eg (nreverse (solver quick-run 0 '(0) nil (gen-object *rocks*) (gen-object (uiop:read-file-line "eg-in"))))) (history-my (nreverse (solver quick-run 0 '(0) nil (gen-object *rocks*) (gen-object (uiop:read-file-line "input")))))) (fiveam:is (= 1514285714288 (height-reached drops (make-array (length history-eg) :initial-contents history-eg) max-period-window))) (fiveam:is (= 1561739130391 (height-reached drops (make-array (length history-my) :initial-contents history-my) max-period-window)))))