557 changed files with 11747 additions and 54872 deletions
--- a/.envrc
+++ b/.envrc
@ -1,4 +1,3 @@
-## wtf
 if [ -f .envrc.local ]; then
  source_env .envrc.local
 fi
--- a/.fixme-new/.gitignore
+++ b/.fixme-new/.gitignore
@ -1,2 +0,0 @@
-state.db
-config.local
--- a/.fixme-new/config
+++ b/.fixme-new/config
@ -1,78 +0,0 @@
-
-; fixme-files **/*.hs docs/devlog.md
-
-; no-debug
-; debug
-
-fixme-prefix     FIXME:
-fixme-prefix     TODO:
-fixme-prefix     PR:
-fixme-prefix     REVIEW:
-fixme-prefix     PATCH:
-
-fixme-attribs assigned workflow :class
-
-fixme-attribs class
-
-fixme-attribs :committer-name :commit-time
-
-fixme-value-set :workflow :new :backlog :wip :test :fixed :done :ready :merged
-
-fixme-value-set class hardcode performance boilerplate ui
-
-; fixme-value-set cat bug feat refactor
-
-fixme-value-set scope mvp-0 mvp-1 backlog
-
-fixme-files **/*.txt docs/devlog.md
-fixme-files **/*.hs
-fixme-exclude **/.**
-fixme-exclude dist-newstyle
-fixme-exclude miscellaneous
-
-fixme-file-comments "*.scm" ";"
-
-fixme-comments ";" "--"
-
-(define-template short
-  (quot
-    (simple
-         (trim 10  $fixme-key) " "
-
-         (if (~ FIXME $fixme-tag)
-          (then (fgd red (align 6  $fixme-tag))  )
-          (else (if (~ TODO $fixme-tag)
-                  (then (fgd green (align 6  $fixme-tag)))
-                  (else (align 6  $fixme-tag)) ) )
-          )
-
-
-         (align 10  ("[" $workflow "]"))  " "
-         (align 8  $class)  " "
-         (align 12 $assigned)  " "
-         (align 20 (trim 20 $committer-name)) " "
-         (trim 40  ($fixme-title)) " "
-         (nl))
-    )
-)
-
-(set-template default short)
-
-(define (ls) (report))
-
-(define (lss s) (report workflow ~ s))
-
-(define (done s) (modify s workflow :done))
-(define (wip s) (modify s workflow :wip))
-(define (test s) (modify s workflow :test))
-(define (new s) (modify s workflow :new))
-(define (backlog s) (modify s workflow :backlog))
-(define (ready s) (modify s workflow :ready))
-(define (merged s) (modify s workflow :merged))
-(define (assign s who) (modify s :assigned who))
-
-;; refchan settings
-refchan 3WtddmcE8zzgBAPR7Bu7mKMaVMTN423NNXSPUJp3Hx42
-source ./refchan.local
-
-
--- a/.fixme-new/fixme.log
+++ b/.fixme-new/fixme.log
--- a/.fixme/config
+++ b/.fixme/config
@ -20,7 +20,8 @@ fixme-files docs/notes/**/*.txt

 fixme-files-ignore .direnv/** dist-newstyle/**

-fixme-id-show-len 12
+fixme-id-show-len 10
+

 fixme-attribs assigned workflow resolution cat scope

--- a/.fixme/log
+++ b/.fixme/log
@ -1,3 +1,2 @@

 (fixme-set "workflow" "done" "RsTry2C5Gk")
-(fixme-set "workflow" "done" "DYfcfsNCrU")
--- a/.gitattributes
+++ b/.gitattributes
@ -1,2 +0,0 @@
-.fixme-new/log merge=fixme-log-merge
-.fixme-new/fixme.log merge=fixme-log-merge
--- a/.gitignore
+++ b/.gitignore
@ -1,7 +1,12 @@
-.fixme-new/refchan.local
-dist-newstyle/
-bin/
+dist-newstyle
 .direnv/
-.hbs2-git3/
+.fixme/state.db
+result
+# VS Code
+settings.json

-temp/
+cabal.project.local
+
+*.key
+
+.backup/
--- a/.hbs2-git/manifest
+++ b/.hbs2-git/manifest
@ -0,0 +1,5 @@
+title: "hbs2 project repo"
+author: "Dmitry Zuikov"
+public: yes
+
+Project description TBD
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@ -1,4 +1 @@
-
-# 0.24.1.2  2024-04-27
-  - Bump scotty version
-
+#
--- a/31
+++ b/31
@ -1,31 +0,0 @@
-Copyright (c) 2023, 2024
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of  nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
--- a/52
+++ b/52
@ -5,52 +5,22 @@ SHELL := bash
 MAKEFLAGS += --warn-undefined-variables
 MAKEFLAGS += --no-builtin-rules

-RT_DIR := test/RT
-
-VPATH += test/RT
-
-RT_FILES := $(wildcard $(RT_DIR)/*.rt)
-OUT_FILES := $(RT_FILES:.rt=.out)
-
-GHC_VERSION := 9.6.6
+GHC_VERSION := 9.4.8
 BIN_DIR := ./bin
 BINS := \
-	bf6                \
  hbs2               \
  hbs2-peer          \
  hbs2-keyman        \
-  hbs2-cli           \
-  hbs2-sync          \
-  fixme-new          \
-	hbs2-git3 \
-	git-remote-hbs23 \
-	ncq3 \
-	hbs2-obsolete \
-	tcq \
-	test-ncq \
-
-RT_DIR := tests/RT
+	hbs2-fixer         \
+	hbs2-git-subscribe \
+  git-remote-hbs2    \
+  git-hbs2           \

 ifeq ($(origin .RECIPEPREFIX), undefined)
  $(error This Make does not support .RECIPEPREFIX. Please use GNU Make 4.0 or later)
 endif
 .RECIPEPREFIX = >

-rt: $(OUT_FILES)
-
-%.out: %.rt
-> @hbs2-cli --run $<  > $(dir $<)$(notdir $@)
-> @hbs2-cli \
-	 [define r [eq? [parse:top:file root $(dir $<)$(notdir $@)] \
-   [parse:top:file root $(dir $<)$(basename $(notdir $@)).baseline]]] \
-   and [print '"[RT]"' space \
-	             [if r [ansi green _ [concat ✅ OK space space]] \
-	                   [ansi red~ _  [concat ❌FAIL]]] \
-	             : space $(notdir $(basename $@))] \
-	 and println
-
-> $(RM) $(dir $<)$(notdir $@)
-
 $(BIN_DIR):
 >	@mkdir -p $@

@ -62,15 +32,11 @@ symlinks: $(BIN_DIR)
 >		path=`find dist-newstyle -type f -name $$bin -path "*$(GHC_VERSION)*" | head -n 1`; \
 >		if [ -n "$$path" ]; then \
 >			echo "Creating symlink for $$bin"; \
->			ln -sfn $$PWD/$$path $(BIN_DIR)/$$bin; \
-#>			cp $$PWD/$$path $(BIN_DIR)/$$bin; \
+>			ln -sf $$PWD/$$path $(BIN_DIR)/$$bin; \
 >		else \
 >			echo "Binary $$bin for GHC $(GHC_VERSION) not found"; \
 >		fi; \
 >	done
-> ln -sfn ../hbs2-git3/bf6/git-hbs2 bin/git-hbs2
-> ln -sfn ../hbs2-git3/bf6/hbs2-git bin/hbs2-git
-> ln -sfn ../bf6/hbs2 bin/hbs2


 .PHONY: build
@ -85,9 +51,3 @@ test-core:
 test-raft:
 > nix develop -c ghcid -c 'cabal repl' raft-algo -T RaftAlgo.Proto.devTest

-README.md:
->	pandoc README.md -t gfm -s -o README1.md --table-of-contents
->	@mv README1.md README.md
->	@echo Remove old TOC before publishing!
-
-
--- a/README.md
+++ b/README.md
@ -1,14 +1,47 @@
+-   [ABOUT](#about){#toc-about}
+    -   [Status update
+        2024-03-20](#status-update-2024-03-20){#toc-status-update-2024-03-20}
+    -   [Status update
+        2024-03-17](#status-update-2024-03-17){#toc-status-update-2024-03-17}
+    -   [What is it](#what-is-it){#toc-what-is-it}
+    -   [Current status](#current-status){#toc-current-status}
+-   [HOWTO](#howto){#toc-howto}
+    -   [How to install](#how-to-install){#toc-how-to-install}
+    -   [How to generate peer's
+        key?](#how-to-generate-peers-key){#toc-how-to-generate-peers-key}
+    -   [How to run
+        hbs2-peer](#how-to-run-hbs2-peer){#toc-how-to-run-hbs2-peer}
+    -   [How to configure
+        hbs2-peer](#how-to-configure-hbs2-peer){#toc-how-to-configure-hbs2-peer}
+    -   [How to create a new own
+        repo](#how-to-create-a-new-own-repo){#toc-how-to-create-a-new-own-repo}
+    -   [How to launch a
+        peer](#how-to-launch-a-peer){#toc-how-to-launch-a-peer}
+    -   [How to save an encrypted file
+        (TBD)](#how-to-save-an-encrypted-file-tbd){#toc-how-to-save-an-encrypted-file-tbd}
+-   [FAQ](#faq){#toc-faq}
+    -   [Why DVCS are not actually
+        distributed](#why-dvcs-are-not-actually-distributed){#toc-why-dvcs-are-not-actually-distributed}
+    -   [Okay, if centralized services are bad, why are you
+        here?](#okay-if-centralized-services-are-bad-why-are-you-here){#toc-okay-if-centralized-services-are-bad-why-are-you-here}
+    -   [What platforms are supported
+        yet?](#what-platforms-are-supported-yet){#toc-what-platforms-are-supported-yet}
+    -   [What is a "reflog"](#what-is-a-reflog){#toc-what-is-a-reflog}
+    -   [What is the fixme?](#what-is-the-fixme){#toc-what-is-the-fixme}
+-   [Contact](#contact){#toc-contact}
+-   [Download](#download){#toc-download}
+-   [Support](#support){#toc-support}
+
 -   [ABOUT](#about)
-  - [Status update 2024-03-20](#status-update-2024-03-20)
-  - [Status update 2024-03-17](#status-update-2024-03-17)
    -   [What is it](#what-is-it)
    -   [Current status](#current-status)
 -   [HOWTO](#howto)
    -   [How to install](#how-to-install)
-  - [How to generate peer’s key?](#how-to-generate-peers-key)
+    -   [How to generate peer\'s key?](#how-to-generate-peers-key)
    -   [How to run hbs2-peer](#how-to-run-hbs2-peer)
    -   [How to configure hbs2-peer](#how-to-configure-hbs2-peer)
    -   [How to create a new own repo](#how-to-create-a-new-own-repo)
+    -   [How to make a pull request](#how-to-make-a-pull-request)
    -   [How to launch a peer](#how-to-launch-a-peer)
    -   [How to save an encrypted file
        (TBD)](#how-to-save-an-encrypted-file-tbd)
@ -19,11 +52,13 @@
        here?](#okay-if-centralized-services-are-bad-why-are-you-here)
    -   [What platforms are supported
        yet?](#what-platforms-are-supported-yet)
-  - [What is a “reflog”](#what-is-a-reflog)
+    -   [What is a \"reflog\"](#what-is-a-reflog)
    -   [What is the fixme?](#what-is-the-fixme)
 -   [Contact](#contact)
 -   [Download](#download)
 -   [Support](#support)
+-   [Donate](#donate)
+-   [Other](#other)

 # ABOUT

@ -85,22 +120,22 @@ notified of it and receive a copy of the data.

 It is a middleware for implementing distributed applications that shares
 data. Like a distributed git, for example. (What? git is already
-distributed and… No, it is not. Not really).
+distributed and\... No, it is not. Not really).

 The idea of extracting the minimal sufficent set of primitives for
 distributed applications and APIs and let the side applications do the
 rest.

-This is not a “blockchain”, but heavily uses the approaches that
-“blockchains” brought to the world.
+This is not a \"blockchain\", but heavily uses the approaches that
+\"blockchains\" brought to the world.

 Using this solution you may treat application data as local. HBS2 will
-syncronize all the data along the crowd of peers. The apps don’t need to
-bother where the other peers are located, where the hosts, ssh keys on
-thouse hosts, auth tokens on thouse hosts, etc. They only need to know
-the references and (optionally) have signing/encryption keys that are
-stored locally or distributed (public parts, of course) automatically
-like any other data.
+syncronize all the data along the crowd of peers. The apps don\'t need
+to bother where the other peers are located, where the hosts, ssh keys
+on thouse hosts, auth tokens on thouse hosts, etc. They only need to
+know the references and (optionally) have signing/encryption keys that
+are stored locally or distributed (public parts, of course)
+automatically like any other data.

 What types of applications may be implemented on top of this?

@ -108,24 +143,24 @@ For an instance:

 -   Distributed file sharing (wip)
 -   Distributed git (seems working)
- Distributed communications, like a chat or a “channel”
- Distibuted ledgers with different types of consensus protocols (we’re
-  trying not to use “b” words)
+-   Distributed communications, like a chat or a \"channel\"
+-   Distibuted ledgers with different types of consensus protocols
+    (we\'re trying not to use \"b\" words)
 -   Actually, any sort of applications that require data and network

 The whitepaper is in shortlist, watch the updates.

-Why it is *experimental* ? Well, it’s on a quite early stage and some
+Why it is *experimental* ? Well, it\'s on a quite early stage and some
 root data structures, protocols or API may change.

 It also have some known issues with performance and might have some
-stability issues. We’re working hard to fix them.
+stability issues. We\'re working hard to fix them.

 ## Current status

 Version 0.24.1-rc.

-Means it’s mostly working. We’re using it about a year.
+Means it's mostly working. We're using it about a year.

 Encryption status: works.

@ -136,22 +171,20 @@ Encryption for protocols: implemented, turned on:

 So right now it is useful for distributing any data.

-We’re using it for our non-public projects.
+We're using it for our non-public projects.

 # HOWTO

 ## How to install

-### nix flakes
-
 Assuming you know what the Nix and Nix flakes are ( See
-[nixos.org](https://nixos.org) if you don’t )
+[nixos.org](https://nixos.org) if you don't )

 and nix flake support is turned on on your system:

    nix profile install github:voidlizard/hbs2/master

-It will take time. Patience, we’re working on rolling out cachix, that
+It will take time. Patience, we're working on rolling out cachix, that
 will allow binary caches for the project.

 Alternative option:
@ -160,55 +193,7 @@ Alternative option:
    --substituters http://nix.hbs2.net:6000 \
    --trusted-public-keys git.hbs2.net-1:HYIYU3xWetj0NasmHrxsWQTVzQUjawOE8ejZAW2xUS4=

-### Home Manager module
-
-The following snippet of code tries to show how to bring the HBS2 flake
-from the flake input and use its packages with Home Manager.
-
-Don’t forget to replace exampleName with your username!
-
-```nix
-# flake.nix
-
-{
-  inputs = {
-    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
-
-    home-manager = {
-      url = "github:nix-community/home-manager";
-      inputs.nixpkgs.follows = "nixpkgs";
-    };
-
-    hbs2.url = "git+https://git.hbs2.net/BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP";
-  };
-
-  outputs = {nixpkgs, home-manager, hbs2, ...}: {
-    homeConfigurations."exampleName" =
-    let system = "x86_64-linux"; # use your system here
-    in home-manager.lib.homeManagerConfiguration {
-      pkgs = nixpkgs.legacyPackages.${system};
-
-      modules = [
-        hbs2.homeManagerModules.${system}.default
-        {
-          services.hbs2 = {
-            enable = true;
-            git-dashboard.enable = true; # optional
-          };
-        }
-        # ...
-      ];
-    };
-  };
-}
-```
-
-Option `services.hbs2.enable` will add all hbs2 binaries into your environment and
-create `hbs2-peer` user service to run it automatically at the background.
-
-Option `services.hbs2.git-dashboard.enable` will create `hbs2-git-dashboard` user service.
-
-## How to generate peer’s key?
+## How to generate peer's key?

    hbs2 keyring-new > new-peer-key.key

@ -287,14 +272,16 @@ Typically hbs2-peer config is located at

 1.  Create a new keyring

+```{=html}
 <!-- -->
-
+```
    hbs2 keyring-new > new.key

-2.  Watch it’s public key
+2.  Watch it's public key

+```{=html}
 <!-- -->
-
+```
    hbs2 keyring-list new.key

 Example:
@ -304,14 +291,16 @@ Example:

 3.  Export repo to the new reflog

+```{=html}
 <!-- -->
-
+```
    git hbs2 export --public --new eq5ZFnB9HQTMTeYasYC3pSZLedcP7Zp2eDkJNdehVVk

 4.  Add git remote and push

+```{=html}
 <!-- -->
-
+```
    git remote add mynerepo hbs2://eq5ZFnB9HQTMTeYasYC3pSZLedcP7Zp2eDkJNdehVVk
    git push mynerepo

@ -340,19 +329,19 @@ Example:

 ## Why DVCS are not actually distributed

-Reason 1. Because they don’t have any content distribution mechanism.
+Reason 1. Because they don't have any content distribution mechanism.

 Common practice right now is using centralized services, which are:

 -   Censored
 -   Faulty
- Not transparent and irresponsible (For customers. They are responsible
-  as hell for any sort of goverment-alike structures before they even
-  asked for something).
+-   Not transparent and irresponsible (For customers. They are
+    responsible as hell for any sort of goverment-alike structures
+    before they even asked for something).
 -   Tracking users
 -   May use their code regardless of license agreement
- Giving up the network neutrality in a sake of \<skipped\*\> anyone but
-  customers who pay
+-   Giving up the network neutrality in a sake of \<skipped\*\> anyone
+    but customers who pay

 There are registered examples, how one most popular git service droppped
 repositoties because they contain some words in README file.
@ -361,12 +350,12 @@ And banned accounts for visiting the service from wrong IP address.

 And data loss in a cloud storage services because they located all
 replicas in a single data centre which was destroyed by the fire or a
-canalization breakthrough. They even don’t tell you how many replicas do
-they have for your data. Why? Because fuck you, that’s why.
+canalization breakthrough. They even don't tell you how many replicas do
+they have for your data. Why? Because fuck you, that's why.

 Setting own hosts/services for dvcs data hosting.

-Yeah, it’s the way. But they are
+Yeah, it\'s the way. But they are

 -   Obviously centralized

@ -384,7 +373,7 @@ What else. Sending patches by email.
 -   Email right now is a centralized service with all the consequences
    (see above)

-Okay, ley’s bring the overlay network (VPN), place all our hosts and
+Okay, ley\'s bring the overlay network (VPN), place all our hosts and
 resources there and will use own DNS.

 Yeap, it will work. But it will cost you. It is acceptable for an
@ -402,16 +391,16 @@ like this easily.

 Also they require trackers, that are centralized web resources.

-Things like Syncthing don’t scales, in fact event if you will use git
+Things like Syncthing don\'t scales, in fact event if you will use git
 repo in syncthing dir, you will face file modification conflicts even if
 you use them alone.

-So that’s why HBS2 came to light. Trust me, if I could use some
-decentralized solution normally for this I’d never start this project.
+So that\'s why HBS2 came to light. Trust me, if I could use some
+decentralized solution normally for this I\'d never start this project.

 ## Okay, if centralized services are bad, why are you here?

-Is’s a mirror for the really distributed repository:
+Is's a mirror for the really distributed repository:

 hbs2://BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP

@ -425,12 +414,12 @@ So far we were able to run the hbs2-peer on:

 Probably it will work on MacOS - but we need someone to check.

-## What is a “reflog”
+## What is a "reflog"

 Reflog is an implementation of a permanent mutable reference. It has a
 permanent ID that corresponds to a public signing cryptographic key, and
-the value, that is calculated from the “state”, where the state is a set
-of all “reference update” transactions.
+the value, that is calculated from the "state", where the state is a set
+of all "reference update" transactions.

 Each transaction is cryptographically signed by the sender, for current
 reflog implementation sender must be an owner of the private key of the
--- a/bf6/hbs2
+++ b/bf6/hbs2
@ -1,206 +0,0 @@
-#! /usr/bin/env -S hbs2-cli file
-
-; # println *args
-
-; # (println (grep (sym "-g") *args))
-
-(define (--help)
-  (begin
-    (println [concat
-
-"hbs2-cli wrapper"           chr:lf
-"supported commands list:"   chr:lf
-"  "
-
-             ])
-  )
-)
-
-(match *args
-
-  ( (list? [sym? store] ...)
-    (begin
-      (local optdef
-        `( [-g          1 GROUPKEY]
-           [--group-key 1 GROUPKEY] ))
-
-      (local split (cli:split optdef ...))
-      (local opts (nth 0 split))
-      (local args (nth 1 split))
-
-      (local gk (@? GROUPKEY opts))
-      (local fname (head args))
-
-      (local kwa `[ ,(if gk [list :gk gk] '() ) ])
-
-      ; (display kwa)
-
-      (println
-        (if fname
-          (hbs2:tree:metadata:file kwa fname)
-          (hbs2:tree:metadata:stdin kwa)))
-    )
-  )
-
-  ( (list? [sym? hash] ...)
-    (begin
-      (local what (if (eq? (type ...) :list) ... '()))
-      (display (eval `(hbs2:hash ,@what)))
-    )
-  )
-
-  ( (list? [sym? has] hash)
-    (begin
-      (local s (hbs2:peer:storage:block:size hash))
-      (cond
-        ( (eq? :no-block s) (die))
-        ( _ (print s))
-      ))
-  )
-
-  ( (list? [sym? cat] ...)
-
-      (begin
-
-        (local optdef `( [-H           0 HASHES]
-                         [--raw        0 RAW]
-                         [--metadata   0 META]
-                         [--m          0 META]
-                       ))
-
-        (local parsed (cli:split optdef ...))
-        (local opts (nth 0 parsed))
-        (local hash (head (nth 1 parsed)))
-
-        (if (@? HASHES opts)
-          (begin
-            (iterate [fn x . println x] [tail [hbs2:tree:scan:deep hash]])
-            (quit)
-        ))
-
-
-        (if (@? RAW    opts)
-          (begin
-            (bytes:put (hbs2:peer:storage:block:get hash))
-            (quit)
-          )
-        )
-
-        (if (@? META opts)
-          (begin
-            (display (hbs2:tree:metadata:get hash))
-            (quit)
-          )
-        )
-
-        (hbs2:tree:read:stdout hash)
-
-      )
-  )
-
-  ( (list? [sym? del] ...)
-
-      (begin
-
-        (local optdef `( [-y       0 YES]
-                         [-r       0 REC]
-                       ))
-
-        (local parsed (cli:split optdef ...))
-        (local opts (nth 0 parsed))
-        (local hash (head (nth 1 parsed)))
-
-        (local hashes
-          (cond
-            ( (@? REC opts)  (hbs2:tree:scan:deep hash) )
-            ( _              (hbs2:tree:scan hash)  )
-          )
-        )
-
-        (define (ask ha)
-            (if (@? YES opts) true
-            (begin
-              (print "deleting " ha " ")
-              (print "sure [y/n]? ") (flush:stdout)
-              (local answ (str:getchar:stdin))
-              (newline)
-              (eq? (upper answ) "Y")
-            ))
-        )
-
-        (cond
-          ( (and (@? YES opts) (@? REC opts)) (hbs2:tree:delete hash))
-          ( _
-            (for (reverse hashes)
-              [fn ha .
-                  [begin
-                    (local y (or (@? YES opts) (ask ha)))
-                    (if y
-                      (begin
-                        (hbs2:peer:storage:block:del ha)
-                     ))
-                  ]])
-          )
-        )
-
-
-      )
-
-  )
-
-  ( (list? [sym? keyring] [sym? new] ...)
-      (begin
-
-        (local optdef `( [-n       1 NUM]
-                         [--number 1 NUM]
-                       ))
-
-        (local opts (nth 0 (cli:split optdef ...)))
-        ;  (println opts)
-        (print (hbs2:keyring:new (@? NUM opts)))
-      )
-  )
-
-  ( (list? [sym? reflog] [sym? get] hash)
-    (display (hbs2:reflog:get hash))
-  )
-
-  ( (list? [sym? reflog] [sym? fetch] hash)
-    (hbs2:reflog:fetch hash)
-  )
-
-  ( (list? [sym? metadata] [sym? dump] hash)
-    (display (hbs2:tree:metadata:get hash))
-  )
-
-  ( (list? [sym? deps] hash)
-    (iterate println (hbs2:tree:scan:deep hash) )
-  )
-
-  ( (list? [sym? fsck] [sym? -h])
-    (begin
-      (println "usage: hbs2 fsck <PATH>")
-      (println "default for <PATH> is hbs2-peer storage path")
-    )
-  )
-
-  ( (list? [sym? fsck] ...)
-    (begin
-      (local sto1 (if (eq? (type ...) :list) (car ...) '()))
-      (if sto1
-        (run:proc:attached tcq ncq:fsck (concat sto1 :/ :0))
-        (begin
-          (local answ (fallback #f '(call:proc hbs2-peer poke)))
-          (unless answ (die "hbs2-peer seems down, but you may pass storage directory manually"))
-          (local sto (lookup:uw storage: answ))
-          (println (ansi :red _ "check") space sto)
-          (run:proc:attached tcq ncq:fsck (concat sto :/ :0))
-        )
-      )
-    )
-  )
-
-  ( _  (--help) )
-)
-
-; vim: filetype=scheme syntax=scheme
--- a/bf6/ncq-migrate.ss
+++ b/bf6/ncq-migrate.ss
@ -1,75 +0,0 @@
-
-(define STORAGE (path:join (env HOME) .local/share/hbs2 ))
-(define REFS    (path:join STORAGE  refs)  )
-(define BLOCKS  (path:join STORAGE  blocks)  )
-(define NEW     (path:join (env HOME) tmp/ncq0))
-
-
-(define refs   (glob REFS '[*/**]  ))
-(define blocks (glob BLOCKS '[*/**]  ))
-
-(define (readref x)
-  (begin
-    (local ref    (concat (reverse (take 2 (reverse (split :/ x))))))
-    (local refval (str:file x))
-    `(,(sym ref) ,(sym refval))))
-
-(define (readhash x)
-  (sym (concat (reverse (take 2 (reverse (split :/ x))))))
-)
-
-(local zu (map readref refs))
-
-; (println zu)
-
-(println STORAGE)
-(println NEW)
-
-; debug
-(define ncq (ncq:open NEW))
-
-(define (writeref x)
-  (match x
-    ( (list? a b )
-      (begin
-        (ncq:set:ref ncq a b)
-        (println ref space a space b)
-      )
-    )
-    (_ '())
- ))
-
-(define (import-refs) (for zu writeref))
-
-(define (import-blocks)
-  (begin
-    ; (local (write x) (ncq:put ncq (bytes:file x)))
-    (for blocks (fn x .
-      (begin
-        (local h0 (sym (readhash x)))
-        (local here  (ncq:has ncq h0))
-        (if (not here)
-          (begin
-            (local ha (sym (ncq:put ncq (bytes:strict:file x))))
-            (local s  (coalesce "" (ncq:has ncq ha)))
-            (local ok (if (eq? ha h0) (ansi :green _ ok) (ansi :red _ fail)))
-            (println block space ok space (align -6 (str s)) space ha space h0 space )
-            ; (println block space ok space space ha space h0 space )
-            (if (not (eq? ha h0)) (die "*** block import error:" ha space h0)))
-
-          (println "block" space (ansi :yellow _ "skip") space h0)
-        )
-    )))
-  )
-)
-
-(import-blocks)
-(import-refs)
-
-(debug)
-
-(ncq:fossilize ncq)
-
-(println done)
-
-
--- a/cabal.project
+++ b/cabal.project
@ -1,20 +1,9 @@
 packages: **/*.cabal
  examples/*/*.cabal
-  **/*/*.cabal

 allow-newer: all

-constraints:
-    pandoc >=3.1.11
-  , suckless-conf >= 0.1.2.7
-  , http-client >=0.7.16 && <0.8
-  , typed-process >= 0.2.13.0
-
-
-debug-info: True
 -- executable-static: True
 -- profiling: True
--library-profiling: False
-debug-info: True
-
+-- library-profiling: False

--- a/docs/devlog.md
+++ b/docs/devlog.md
@ -1,7 +1,3 @@
-## 2024-12-02
-
-Пробуем новую структуру репозитория
-
 ## 2024-02-24

 wtf?
--- a/docs/papers/Makefile
+++ b/docs/papers/Makefile
@ -5,7 +5,7 @@ $(basename $(1))-$(REV)$(suffix $(1))
 endef


-all: hbs2-git-problem hbs2-git-new-repo hbs2-git-doc hbs2-mailbox
+all: hbs2-git-problem hbs2-git-new-repo hbs2-git-doc

 .PHONY: all clean

@ -20,23 +20,13 @@ hbs2-git-new-repo: hbs2-git-new-repo.pdf

 hbs2-git-doc: hbs2-git-doc-0.24.1.pdf

-hbs2-mailbox: hbs2-mailbox.pdf
-
 publish-hbs2-git-doc: hbs2-git-doc-0.24.1.pdf
 	$(eval TARGET := $(call make_target,$<))
 	$(eval HASH := $(shell hbs2 metadata create --hash --auto $(TARGET)))
 	@echo Updating $(HBS2GITDOCLWW) $(HASH)
 	hbs2-peer lwwref update -v $(HASH) $(HBS2GITDOCLWW)

-
-publish-hbs2-mailbox: hbs2-mailbox.pdf
-	@echo not implemented yet
-	# $(eval TARGET := $(call make_target,$<))
-	# $(eval HASH := $(shell hbs2 metadata create --hash --auto $(TARGET)))
-	# @echo Updating $(HBS2GITDOCLWW) $(HASH)
-	# hbs2-peer lwwref update -v $(HASH) $(HBS2GITDOCLWW)
-
-publish: publish-hbs2-git-doc publish-hbs2-mailbox
+publish: publish-hbs2-git-doc

 clean:
 	rm -f *.aux *.log *.nav *.out *.snm *.vrb *.toc *.pdf
--- a/docs/papers/hbs2-git-doc-0.24.1.tex
+++ b/docs/papers/hbs2-git-doc-0.24.1.tex
@ -668,8 +668,8 @@ Cloning into '8vFu9S79ysdWag4wek53YWXbC5nCRLF7arGp6181G4js'...
 git hbs2 export --encrypted ./gk-new.key  C6tTuapmG7sE8QktQo4q4tBr8kNWKvBruNb36HYThpuy
 \end{verbatim}

-Для обновления манифеста --- редактировать файл \texttt{.hbs2-git/manifest}
- и вызвать \texttt{git hbs2 manifest update <LWWREF>}
+Для обновления манифеста --- редактировать файл \texttt{.hbs2-git/manifest} и сделать
+git commit/push либо же вызвать \texttt{git hbs2 export <LWWREF>}

 \subsubsection{Смотреть групповой ключ}

@ -739,7 +739,7 @@ hbs2 sigil check my.sigil

 \end{verbatim}

-Это похоже на сертификат и, в некотором роде, им является, но специально названо иначе, что бы не
+Это похоже на сертификат и, в некотором роде, им является но специально названо иначе, что бы не
 путать с сертификатами X.509 или какими-то еще.

 Создать <<cигил>> можно при помощи команды
@ -785,7 +785,7 @@ export tags

 Означает, что каждая операция \texttt{git push} которая на деле является операцией EXPORT --
 экспортирует все объекты, перечисленные в конфигурации: бранч master, бранч main, бранч, на который
-указывает \texttt{HEAD}, и бранчи, для которых выполняется \texttt{git push}.
+указывает \texttt{HEAD} и бранчи, для которых выполняется \texttt{git push}.

 Если указать, например,

@ -811,7 +811,7 @@ export exclude "refs/heads/*"
 \paragraph{Синхронизация с hbs2-fixer}

 \texttt{hbs2-fixer} принимает в качестве параметра \texttt{-c} имя файла конфигурации.
-Формат конфигурации -- Scheme-подобный DSL, который позволяет настраивать обработчики
+Формат конфигурации -- Schema-подобный DSL, который позволяет настраивать обработчики
 событий и действия по ним.  Примеры файлов конфигурации находятся в \texttt{hbs2-fixer/examples}.

 Рассмотрим простой пример:
@ -897,7 +897,7 @@ $ cat simple.scm

 \end{verbatim}

-Теперь, имея данный конфигурационный файл, запустим его:
+Теперь имя данный конфигурационный файл, запустим его:

 \begin{verbatim}
 hbs2-fixer -c ./simple.scm
@ -1137,14 +1137,14 @@ BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP
 \end{verbatim}

 Однако, теперь это не ссылка типа reflog, а ссылка типа lwwref. Это другой тип данных,
- и значение типа \texttt{lwwref(BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP)}
+ и значение типа \texttt{lwwref(BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP}
 имеет другой хэш.

 Таким образом, старая версия hbs2-git продолжит работать с рефлогом

 \texttt{BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP},

- новая же версия использует lwwref. Ассоциированный с данным lwwref рефлог можно посмотреть, например, так:
+ новая же версия использует lwwref. Ассоциированный с данным lwwref можно посмотреть, например, так:

 \begin{verbatim}
 $ git hbs2 tools show-remotes
@ -1152,7 +1152,7 @@ $ git hbs2 tools show-remotes
 \end{verbatim}

 Данная команда покажет, какие lwwref используются в качестве git remote в данном репозитории,
-а также версии и значения этих lwwref.
+и какие у них версии lwwref и какие значения.

 Каждая транзакция $T_n$ содержит полный самодостаточный снимок репозитория, т.е технически
 возможно развернуть репозиторий, имея только транзакцию.
@ -1169,7 +1169,7 @@ $GitObjectPack_n$, полученных при помощи команды \text
  \item git порождает огромное количество слабо различающихся маленьких объектов, следовательно,
    огромную избыточность данных. Лучше всего свои объекты упаковывает сам git, используя, в
    частности, бинарные дельты.
-  \item Каждый отдельный объект (\textit{блок}) подразумевает, в общем случае, несколько
+  \item каждый отдельный объект (\textit{блок}) подразумевает, в общем случае, несколько
    сетевых запросов для получения: запрос размера, запрос чанков, ответ. Таким образом,
    повышение количества объектов ведёт к ухудшению скорости синхронизации.
  \item Выше скорость импорта объектов в репозиторий, так как он выполняется стандартной
@ -1204,7 +1204,7 @@ $GitObjectPack_n$, полученных при помощи команды \text
 Для <<новых>> деревьев будет сгенерирован новый секрет.

 Нет смысла обновлять <<старые>> секреты, так как уже записанная в HBS2 информация никуда оттуда уже
-не денется, будут ли обновлены старые секреты или нет --- данные, зашифрованные
+не денется, будут ли обновлены перегенерированы старые секреты или нет --- данные, зашифрованные
 <<старыми>> секретами все равно останутся в системе.

 Заметим, что удаление участника из группового ключа лишит его доступа к последующим изменениям, но
@ -1357,14 +1357,14 @@ hbs2-keyman не отображает секретные ключи, тольк

 \section{Поддержка возможностей git}

-Пока не поддерживаются подписанные теги. По крайней мере не тестировались.
+пока не поддерживаются подписанные теги. По крайней мере не тестировались.

 \section{Разное}

 В документации или где-то еще могут спорадически появляться префиксы hbs21 (hbs21://).

-Этот префикс был присвоен новому протоколу hbs2, чтобы он не интерферировал
-со старым, и можно было бы одновременно пользоваться двумя версиями hbs2-git.
+Этот префикс был присвоен новому протоколу hbs2, что бы он не интерферировал
+со старым и можно было бы одновременно пользоваться двумя версиями hbs2-git.

 После релиза новой версии и прекращении поддержки старой -- данный префикс
 не используется, однако должен пониматься hbs2-git (вместо hbs2://)
--- a/docs/papers/hbs2-mailbox.tex
+++ b/docs/papers/hbs2-mailbox.tex
@ -1,758 +0,0 @@
-%
-\documentclass[11pt,a4paper]{article}
-
-\usepackage{polyglossia}
-\usepackage{xltxtra}
-\usepackage[margin=2cm,a4paper]{geometry}% http://ctan.org/pkg/geometry
-\usepackage{pdfpages}
-\usepackage{graphicx}
-\usepackage[ddmmyyyy]{datetime}
-\usepackage{booktabs}
-\usepackage{enumitem}
-\usepackage{amssymb}
-\usepackage{amsmath}
-\usepackage{bm}
-\usepackage[nomessages]{fp}
-\usepackage{caption}
-\usepackage{url}
-\usepackage{indentfirst}
-\usepackage[parfill]{parskip}
-\usepackage[ colorlinks=true
-           , linkcolor=black
-		   , anchorcolor=black
-		   , citecolor=black
-		   , filecolor=black
-		   , menucolor=black
-		   , runcolor=black
-		   , urlcolor=blue]{hyperref}
-\usepackage{tikz}
-\usetikzlibrary{arrows,snakes,shapes,backgrounds,positioning,calc}
-\usepackage{marvosym}
-\usepackage{pifont}
-\usepackage{fontspec}
-\usepackage{fontawesome5}
-\usepackage{listings}
-\usepackage{verbatim}
-\usepackage{xcolor}
-\usepackage{float} % Needed for the floating environment
-
-\setmainlanguage{russian}
-\defaultfontfeatures{Ligatures=TeX,Mapping=tex-text}
-\setmainfont{Liberation Serif}
-\newfontfamily\cyrillicfont{Liberation Serif}[Script=Cyrillic]
-\newfontfamily{\cyrillicfonttt}{Liberation Mono}[Scale=0.8]
-
-\setlist{noitemsep}
-\setlength{\intextsep}{2cm}
-
-\newcommand{\term}[2]{\textit{#2}}
-\newcommand{\Peer}{\term{peer}{пир}}
-\newcommand{\Relay}{\term{relay}{Relay}}
-\newcommand{\Acc}{\term{acc}{Accumulator}}
-\newcommand{\Dude}{\term{dude}{Dude}}
-\newcommand{\Mailbox}{\term{mailbox}{Mailbox}}
-\renewcommand{\dateseparator}{.}
-\renewcommand*\contentsname{Содержание}
-
-\lstset{
-  language=Haskell,
-  basicstyle=\ttfamily\small,
-  keywordstyle=\color{blue},
-  commentstyle=\color{green},
-  stringstyle=\color{red},
-  % numberstyle=\tiny\color{gray},
-  % numbers=left,
-  % stepnumber=1,
-  showstringspaces=false,
-  breaklines=true,
-  frame=single,
-}
-
-\newfloat{Code}{t}{myc}
-
-\graphicspath{ {img/}}
-
-\title{Протокол <<Mailbox>>}
-
-\begin{document}
-
-\maketitle
-
-\section{О документе}
-
-Документ рассматривает протокол доставки данных <<Mailbox>> по паттерну $*
-\rightarrow 1$ <<email>> в P2P окружении, как подпротокола  для hbs2-peer.
-
-Протокол предполагается к использованию в ситуациях, когда между
-\term{actor}{акторами} нет общего авторизованного канала связи (в смысле
-hbs2-peer).
-
-Протокол не подразумевает нахождения акторов постоянно онлайн.
-
-Протокол не подразумевает использования механизмов вроде DNS, сертификатов PKCS
-и Authority, или каких-либо (скомпрометированных) централизованных сервисов.
-
-Протокол не подразумевает постоянной связности сети.
-
-Для адресации используются публичные ключи подписи.
-
-Для E2E шифрования используется механизм групповых ключей.
-
-Для упаковки и распространения данных используются примитивы hbs2-peer:
-\term{block}{блоки}, \term{merkle}{(шифрованные) деревья Меркла} с метаданными,
-и протоколы для работы с ними.
-
-Отличие от протоколов IMAP,SMTP,POP3 в том, что это другой протокол для другого
-окружения и исходящий из других предпосылок.
-
-Теоретически, в качестве несложного упражнения, можно поднять сервер IMAP как
-локальный фронтенд для hbs2-peer и тогда это будет IMAP-via-P2P.
-
-\section{Предпосылки}
-
-В текущей реализации HBS2 существуют следующие релевантные виды каналов
-(протоколов,\term{ref}{ссылок}):
-
-\paragraph{RefLog:}
-
-Обеспечивает коммуникацию по паттерну   $1 \rightarrow *$, то есть один -- ко
-всем, канал распространяет сообщения одного автора. Пруфом записи является
-подпись \term{ksign}{ключом подписи} автора. \term{peer}{Пиры} должны
-подписаться на канал для его распространения, распространять канал (ссылку)
-может любой любой подписанный на него \term{peer}{пир}, так как валидность
-записей проверяется подписью автора. Канал является \term{GSET}{CRDT G-SET}
-записей.
-
-Метафорой рефлога может являться твиттер-аккаунт либо канал в телеграме, с одним
-писателем и множеством подписчиков.
-
-
-\paragraph{RefChan:}
-
-Обеспечивает коммуникацию по паттерну ${A} \rightarrow {R}$, то есть определяет
-множество \term{author}{авторов} $A$ и множество \term{reader}{читателей} $R$, и
-пруфом записи является подпись \term{author}{автора}, а
-\term{permission}{разрешением} на чтение --- опциональное шифрование сообщения
-\term{GK0}{групповым ключом}, куда входят читатели $R$, то есть $GK = \{ k_i
-\}_{i \in R}$, где каждый $k_i$ --- секретный ключ, зашифрованный публичным
-ключом $r_i$ из множества $R$.
-
-Кроме того, \term{refchan}{RefChan} определяет множество пиров ${P}$, которые
-могут отправлять сообщение в данный \term{refchan}{RefChan} и принимаются только
-такие сообщения.
-
-Данное ограничение необходимо для борьбы с атакой Сивиллы в случае, если \Peer{}
-игнорирует настройки ${A}$.
-
-Кроме того, у \term{refchan}{рефчана} есть владелец, который может менять
-настройки $A,R$, а блок настроек представляет собой \term{lww}{CRDT LWW регистр}
-со ссылкой на блок настроек, подписанный ключом владельца.
-
-Как видно, распространять сообщения из \term{refchan}{рефчана} могут только пиры
-$p_i \in P$
-
-То есть, распространять транзакции может кто угодно, т.к каждая транзакция
-подписана ключом \term{peer}{пира}, но вот при запросе состояния будут
-учитываться только ответы пиров $p_i \in P$.
-
-Метафорой \term{refchan}{рефчана} является модерируемый чат с ограниченным
-множеством участников и администраторами.
-
-Таким образом, при наличии этих протоколов, мы можем
-
-\begin{enumerate}
-
-\item посылать сообщения от одного автора всему миру, то есть тем пирам, которые
-  слушают (подписаны) на данный рефлог или
-
-\item осуществлять коммуникацию между ограниченными множествами пиров и
-  авторов/читателей.
-
-\end{enumerate}
-
-Общим является то, что бы получать обновления рефлога или рефчана, мы (как пир)
-должны быть на них \term{subscribed}{подписаны}, т.е мы должны знать, что такие
-\term{ref}{ссылки} существуют и явно на них подписаться.
-
-
-Возникает вопрос, как можно обеспечить коммуникацию между произвольными
-\term{actor}{акторами} Алиса и Боб, у которых нет общего канала.
-
-Куда писать Алисе, что бы её сообщение достигло Боба? Рефчана, куда бы входили
-бы и Алиса и Боб в общем случае еще не существует, канал связи отсутствует.
-
-Алиса может быть подписана на какую-то ссылку Боба, но Боб не подписан на каналы
-Алисы. Или наоборот.
-
-Предлагается ввести новый протокол, \term{mailbox}{Mailbox}, который будет
-обеспечивать коммуникацию по паттерну $ * \rightarrow 1 $, то есть кто угодно
-может отправлять сообщения в почтовый ящик получателя.
-
-Получатель проверяет почтовый ящик и забирает оттуда сообщения.
-
-При этом обеспечивается отправка и доставка в условиях, когда \term{peer}{пиры}
-получателя и отправителя  не находятся онлайн всё время.
-
-Данный протокол может быть полезен при установлении канала связи (например,
-создании общего рефчана), или просто оффлайн обмене сообщениями в условиях
-необязательного наличия каналов, например, при рассылке патчей и пулл/мерж
-реквестов в git или создании тикетов или для отсылки \textit{реакций}, в общем
---  в любом случае, когда между акторами нет какого-то прямого канала.
-
-Важным является то, что получатель подписан только на свои, известные ему
-каналы, куда все (при выполнении определённых условий) могут отправлять
-сообщения.
-
-
-\section{Протокол}
-
-Протокол является подпротоколом \textit{hbs2-peer} и в отношении него верно всё,
-что верно для семейства этих протоколов --- авторизация и аутентификация пиров,
-черные и белые списки пиров, транспортное шифрование сообщений через ByPass и
-так далее.
-
-Идентификаторами являются публичные ключи подписи и шифрования.
-
-Для e2e шифрования используется тот же механизм групповых ключей.
-
-Передаваемыми единицами являются либо короткие сообщения
-\texttt{SmallEncryptedBlock} либо \term{merkle}{деревья Меркла} с шифрованием и
-метаданными.
-
-Протокол использует примитивы \textit{hbs2-core} и \textit{hbs2-peer}, как
-минимум:
-
-\begin{itemize}
-  \item[-] SignedBox
-  \item[-] SmallEncryptedBlock
-  \item[-] MerkleTree
-\end{itemize}
-
-Протокол определяет служебные сообщения, специфичные для него, однако обмен
-данными идёт через обычные протоколы (GetBlock,GetBlockSize).
-
-Короткие сообщения могут доставляться непосредственно через (сигнальные)
-сообщения протокола.
-
-\subsection{Участники}
-
-\paragraph{Пир} Узел hbs2, поддерживающий данный протокол
-
-\paragraph{Актор} также \term{dude}{Dude}.  Отправители и получатели сообщений.
-
-Требуется определить, что явлется идентификатором, или идентификаторами \Dude{}.
-
-\paragraph{Message} Сообщение.
-
-Определяется отправителем, получателем (получателями?), и содержимым.
-Видится,что сообщения могут быть двух классов: \textit{маленькое}, где всё
-сообщение вместе со служебной информацией помещается в один пакет и может быть
-доставлено непосредственно через коммуникационный протокол (GOSSIP), и
-\textit{большое}, когда \Peer{} поддерживающий данный протокол -- будет
-выкачивать все ссылки на части сообщения (большой текст, аттачменты и т.п.)
-
-\paragraph{Mailbox} Единица хранения и распространения сообщений.
-
-Mailbox бывают видов \term{Relay}{Relay} и \term{Accumulator}{Accumulator}.
-
-Разница между ними в том, что \Relay{} просто принимает и выкачивает сообщения,
-пришедшие по протоколу, и не пытается опрашивать соседей и объединять все
-известные сообщения дла \Dude{} в общее множество.
-
-Назначание \Relay{} --- временное хранение сообщений, пока их не заберёт один из
-\term{acc}{аккумуляторов}. \Mailbox{} \Relay{} занимает фиксированное, заранее
-определенное место на диске
-
-Поскольку мы в общем не знаем, забрали ли сообщение или нет, видится так, что
-\Relay{} организует ограниченную очередь сообщений, и при исчерпании лимита
-места, отведённого под почтовый ящик -- просто удаляет наиболее старые сообщения
-из очереди.
-
-Назначание \Acc{} -- хранить все сообщения для своего \Dude{}, т.е это его
-<<распределённый почтовый аккаунт>>.
-
-То есть, \Acc{} образуют \term{GSET}{CRDT G-SET} сообщений, и постепенно
-сходятся к одному значению (объединению всех сообщений всех \Acc{}).
-
-Очевидно, нужно предусмотреть или записи вида \textit{Tomb}, или иной способ
-удаления сообщений, например, через команду протокола.
-
-\Acc{} опрашивает всех соседей, получает ссылки на \term{merkle}{деревья~Меркла}
-сообщений, выкачивает сообщения и объединяет их в общее множество.
-
-\subsection{Примеры}
-
-\subsection*{Минимальная конфигурация}
-
-Два пира при условии наличия прямой сетевой доступности в обоих направлениях.
-
-\begin{figure}[h!]
-\centering
-\begin{tikzpicture}[ every label/.style={font=\scriptsize},
-                     every node/.style={font=\scriptsize},
-                     handle/.style={ draw=black
-                                   , circle
-                                   , inner sep=2pt
-                                   },
-                     box/.style={ draw=black
-                                , rounded corners,
-                                , anchor=base
-                                , font=\scriptsize
-                                , minimum height=1.5cm
-                                , text width=1.5cm
-                                , align=center
-                                },
-                   ]
-
-  \node[box,minimum height=2cm,label={below:{hbs2-peer}}] (dudeA) {{\underline{Dude~A}}\\ \Acc{}};
-  \node[ box
-       , minimum height=2cm
-       , label={below:{hbs2-peer}}
-       , right=2.5cm of dudeA
-       ] (dudeB) {{\underline{Dude~B}}\\ \Acc{}};
-
-  \draw[<->] (dudeA) -- (dudeB)
-              node[midway,above] {Mailbox}
-              node[midway,below] {GOSSIP};
-
-
-\end{tikzpicture}
-\caption{минимальная конфигурация}
-\end{figure}
-
-\pagebreak
-
-\begin{itemize}
- \item[-] Обмен сообщениями возможен только при одновременном нахождении обоих
-   пиров онлайн и наличия между ними связи
-
- \item[-] При потере узла Dude~A или Dude~B теряют все адресованные им сообщения
-\end{itemize}
-
-
-\subsection*{Примерно оптимальная конфигурация}
-
-\begin{figure}[h!]
-\centering
-\begin{tikzpicture}[ every label/.style={font=\scriptsize},
-                     every node/.style={font=\scriptsize},
-                     handle/.style={ draw=black
-                                   , circle
-                                   , inner sep=2pt
-                                   },
-                     box/.style={ draw=black
-                                , rounded corners,
-                                , anchor=base
-                                , font=\scriptsize
-                                , minimum height=1.5cm
-                                , text width=1.5cm
-                                , align=center
-                                },
-                   ]
-
-  \node[box,minimum height=2cm,label={below:{hbs2-peer}}] (dudeA) {{\underline{Dude~A}}\\ \Acc{}};
-
-  \node[ box
-       , minimum height=2cm
-       , label={below:{hbs2-peer}}
-       , right=1.5cm of dudeA
-       ] (relayA) {{\underline{Relay~1}}\\ \Relay{}};
-
-  \node[ box
-       , minimum height=2cm
-       , label={below:{hbs2-peer}}
-       , below=1.5cm of dudeA
-       ] (A1) {{\underline{A1}}\\ \Acc{}};
-
-  \node[ box
-       , minimum height=2cm
-       , label={below:{hbs2-peer}}
-       , right=1.5cm of relayA
-       ] (relayB) {{\underline{Relay~2}}\\ \Relay{}};
-
-  \node[ box
-       , minimum height=2cm
-       , label={below:{hbs2-peer}}
-       , right=1.5cm of relayB
-       ] (dudeB) {{\underline{Dude~B}}\\ \Acc{}};
-
-  \node[ box
-       , minimum height=2cm
-       , label={below:{hbs2-peer}}
-       , below=1.5cm of dudeB
-       ] (B1) {{\underline{B1}}\\ \Acc{}};
-
-  \node[ box, circle, draw, dashed
-       , minimum size=2.5cm
-       , minimum height=2.5cm
-       , yshift=-0.5cm
-       , right=2.75cm of A1
-       , label={below: protocol}
-       ] (gossip) {{\underline{Mailbox}}\\GOSSIP };
-
-
-  \draw[<->,dashed] (dudeA) -- (relayA);
-  \draw[<->,dashed] (dudeB) -- (relayB);
-  \draw[<->,dashed] (dudeA) -- (A1);
-  \draw[<->,dashed] (dudeB) -- (B1);
-
-  \draw[<->,dashed] (dudeA) -- (gossip);
-  \draw[<->,dashed] (dudeB) -- (gossip);
-  \draw[<->,dashed] (relayA) -- (gossip);
-  \draw[<->,dashed] (relayB) -- (gossip);
-  \draw[<->,dashed] (A1) -- (gossip);
-  \draw[<->,dashed] (B1) -- (gossip);
-
-\end{tikzpicture}
-\caption{Примерно оптимальная конфигурация}
-\end{figure}
-
-\begin{itemize}
-\item[-] Каждый Dude имеет некоторое количество Mailbox типа \Acc{} и \Relay{}.
-
-\item[-] Часть из них находится на пирах, которые большую часть времени
-  доступны.
-
-\item[-] Часть доступных пиров имеет между собой прямую связь по GOSSIP.
-
-\item[-] Не требуется полная связность сети между Dude~A и Dude~B, достаточно,
-  что бы была цепочка соединений, доступных хотя бы время от времени.
-
-\item[-] Сообщения Dude~A и Dude~B реплицированы между узлами типа \Acc{} (для
-  каждого Dude -- свои мейлбоксы, естественно) и сообщения будут утрачены
-    только в случае полной одновременной утраты всех узлов такого типа или если
-    на всех этих узлах будут удалены \term{mailbox}{мейлбоксы} для Dude~A или
-    Dude~B.
-\end{itemize}
-
-\pagebreak
-
-\section{Структуры данных}
-
-\subsection{Message}
-
-\begin{figure}[h!]
-\centering
-\begin{tikzpicture}[ every label/.style={font=\scriptsize},
-                     every node/.style={font=\scriptsize},
-                     handle/.style={ draw=black
-                                   , circle
-                                   , inner sep=2pt
-                                   },
-                     box/.style={ draw=black
-                                , rounded corners,
-                                , anchor=base
-                                , font=\scriptsize
-                                , minimum height=1.5cm
-                                , text width=1.5cm
-                                , align=center
-                                },
-                   ]
-
-  \node[ draw
-       , minimum height=2cm
-       , minimum width=12cm
-       % , label={[yshift=5mm]south:SignedBox}
-       ] (msg)  {};
-
-
-   \node[draw,below=5mm of msg.north west,anchor=north west,xshift=2mm
-       ] (sender) {$Sender$};
-
-  \node[above=1.5cm of sender.north west, anchor = south west, text width=1.8cm] (label1) {Публичный ключ отправителя};
-
-  \draw[->] (label1.south) -- ($(sender.north west)!(label1.south)!(sender.north east)$);
-
-  % \node[draw,below=5mm of msg.north west,anchor=north west,xshift=2mm
-  \node[draw,right=5mm of sender
-       ] (flags) {$\{F\}$};
-
-  \node[draw,right=1mm of flags
-       ] (rcpt) {$\{Recipients\}$};
-
-  \node[draw,right=1mm of rcpt
-       ] (gk) {$GK^*$};
-
-  \node[draw,right=1mm of gk
-       ] (ref) {$\{Ref\}$};
-
-  \node[draw,right=1mm of ref,minimum width=4cm
-       ] (payload) {$Payload$};
-
-
-  \node[above=1.5cm of payload.north west, anchor = south west, text width=2cm]
-     (labelP) {SmallEncryptedBlock};
-
-  \draw[->] (labelP.south) -- ($(payload.north west)!(labelP.south)!(payload.north east)$);
-
-  \node[ draw
-       , above=2mm of flags.north west, xshift=-2.5mm
-       , anchor=north west
-       , minimum width = 10cm
-       , minimum height = 1.1cm
-       , label={[yshift=-1mm]south:SignedBox}
-       ] (box) {};
-
-
-\end{tikzpicture}
-\caption{Структура сообщения}
-\end{figure}
-
-\paragraph{Sender:}  Публичный (адрес) ключ подписи отправителя
-
-\paragraph{F:} Флаги (опции) сообщения. Например, TTL. TBD.
-
-\paragraph{Recipients:} Публичные ключи подписи (адреса) получателей
-
-Так как \term{peer}{пиру} нужно знать, в какой \Mailbox{} положить сообщение
-
-
-\paragraph{GK:} (Опционально) групповой ключ шифрования, которым зашифровано
-сообщение
-
-\paragraph{Refs:} Ссылки на части сообщения, (зашифрованные)
-\term{merkle}{деревья} с метаданными
-
-\paragraph{Payload:} Непосредственное короткое сообщение
-
-
-\section{Сообщения протокола}
-
-\subsection{SEND}
-
-Пир~A \Dude~A посылает сообщение \Dude~B или списку \Dude{} через Пир~X.
-
-Если Пир~X не поддерживает протокол -- то сообщение не обрабатывается.
-
-Если Пир~X поддерживает протокол -- то сообщение пересылается соседям Пир~X.
-
-Если Пир~X имеет \Mailbox{} для одного из получателей (\Dude{}) --- то сообщение
-кладётся в \Mailbox{}.
-
-Если это \Acc{} -- то просто кладётся. Если задана квота на размер и размер
-\Mailbox{} превышен (переполнен), то сообщение может игнорироваться.
-
-Если это \Relay{} то кладётся, если квота размера не превышена. Если превышена,
-то удаляются наиболее старые сообщения, пока не освободится достаточно места на
-диске.
-
-Если не удалось, то сообщение удаляется.
-
-Если сообщение содержит хэш-ссылки (вложения), то они скачиваются в соответствии
-с политиками (размеры,etc).
-
-Каждая ссылка сообщения проверяется на целостность, скачивание продолжается,
-пока оно не станет целостным или до тех пор, пока (определяется политикой).
-
-Если пир \Dude~A не имеет блоков, на которые ссылается сообщениe --- то мы
-прекращаем скачивать зависимости. Возможно, такое сообщение стоит дропнуть.
-
-Авторизация: сообщение SEND подписано \Dude~A, отправителем сообщения.
-
-\subsection{CHECK-MAIL}
-
-Получатель (владелец \Mailbox{}) запрашивает хэш \term{merkle}{дерева Меркла} сообщений,
-содержащихся в \Mailbox{}.
-
-Авторизация: сообщение SEND подписано \Dude --- владельцем \Mailbox{}.
-
-\subsection{MAIL-STATUS}
-
-Ответ на сообщение \texttt{CHECK-MAIL}, содержит хэш ссылку
-\term{merkle}{дерева Меркла} сообщений, содержащихся в \Mailbox{}
-или признак отсутствия сообщений.
-
-Поведение. Получаем сообщения из дерева, пишем в результат только валидные.
-
-Если затесались невалидные -- то это повод для каких-то действий в отношении
-пира, который обслуживает \Mailbox{}.
-
-Авторизация: сообщение подписано \Dude --- владельцем  \Mailbox{}.
-
-\subsection{DELETE}
-
-Удалить сообщение для \Mailbox{}.
-
-Содержит признак рассылать по GOSSIP или нет, допустим, оно адресовано только
-одному конкретному узлу.
-
-Содержит предикат, какие сообщения удалять (все, для определенного отправителя,
-старше, чем X, больше, чем X, и т.п.). TBD.
-
-Полезно для освобождения ресурсов и экономии сетевого трафика.
-
-Опциональное.
-
-Авторизация: сообщение подписано \Dude --- владельцем  \Mailbox{}.
-
-\subsection{SET-POLICY}
-
-Устанавливает политики обработки сообщений и \Mailbox{}.
-
-Параметры: GOSSIP (да/нет)
-
-Данные: \term{term}{дерево Меркла} текстового файла с инструкциями.
-
-Авторизация: сообщение подписано \Dude --- владельцем  \Mailbox{}.
-
-Инструкции: TBD, расширяемо.
-
-Возможный примерный вид:
-
-\begin{verbatim}
-
-dudes drop *
-peers drop *
-
-dudes accept GmtNGbawvxqykjDaBiT3LsqP7xqDPHVTxqfBqoFQ6Mre
-
-dudes accept 3WtddmcE8zzgBAPR7Bu7mKMaVMTN423NNXSPUJp3Hx42
-
-dudes delete G5K9QvFaomXdP4Y9HcYEt3diS2cCWyU8nBd2eTzrcq1j
-
-dude set-pow-factor 94wrDGvcnSitP8a6rxLSTPBhXSwdGYrQqkuk2FcuiM3T 10
-
-peer set-pow-factor Gu5FxngYYwpRfCUS9DJBGyH3tvtjXFbcZ7CbxmJPWEGH 10
-
-peers accept yFSaUfb97ZRtQqzHWdERsR7KJvN8qyWX1M8rJcxnsiu
-
-peer cooldown * 120
-peer cooldown yFSaUfb97ZRtQqzHWdERsR7KJvN8qyWX1M8rJcxnsiu  60
-
-dude cooldown * 120
-dude cooldown G5K9QvFaomXdP4Y9HcYEt3diS2cCWyU8nBd2eTzrcq1j 300
-
-\end{verbatim}
-
-
-\section{Возможные атаки и противодействие им}
-
-\subsection{Спам}
-
-Массовые нежелательные рассылки.
-
-\paragraph{Тактика борьбы:}
-
-\begin{itemize}
- \item[-] Отвергать сообщения с множеством реципиентов.
- \item[-] Вводить cooldown периоды для пиров и \Dude{}.
- \item[-] Вводить (общие) белые списки и принимать сообщения только от них.
- \item[-] Сделать ненулевой стоимость попадания в белые списки.
- \item[-] Ввести иструменты репутации и т.п.
- \item[-] Ввести регулируемый PoW на сообщения.
-\end{itemize}
-
-\subsubsection{DoS}
-
-Атаки на работоспособность пира и сети в целом.
-
-\subsubsection{Посылка огромных данных}
-
-TBD
-
-\subsubsection{Посылка невалидных данных}
-
-TBD
-
-\subsubsection{Ссылки на отсутствующие данные}
-
-TBD
-
-\subsubsection{Анализ метаданных, построение графа взаимодействий}
-
-Поскольку \texttt{GOSSIP} проходит через пиров и имеет открытые метаданные,
-можно сохранять граф коммуникаций и запоминать публичные ключи.
-
-Что бы этому противодействовать -- можно только взаимодействовать с заведомо
-надёжными пирами через, возможно, отдельную сеть.
-
-К сожалению.
-
-Для по-настоящему анонимного и неотслеживаемого общения нужно использовать
-другие механизмы.
-
-\section{Примеры применения}
-
-\subsection{Issues/Pull requests}
-
-
-\begin{figure}[h!]
-\centering
-\begin{tikzpicture}[ every label/.style={font=\scriptsize},
-                     every node/.style={font=\scriptsize},
-                     handle/.style={ draw=black
-                                   , circle
-                                   , inner sep=2pt
-                                   },
-                     box/.style={ draw=black
-                                , rounded corners,
-                                , anchor=base
-                                , font=\scriptsize
-                                , minimum height=1.5cm
-                                , text width=1.5cm
-                                , align=center
-                                },
-                     db/.style={ cylinder
-                               , draw
-                               , fill=gray!10
-                               , minimum height=1cm
-                               , minimum width=1.5cm
-                               , shape border rotate=90
-                               , aspect=0.5
-                               }
-                   ]
-
-  \node[box] (hbs2-peer1) {hbs2-peer1};
-  \node[box,right=3cm of hbs2-peer1] (hbs2-peer2) {\underline{hbs2-peer2}\\Relay};
-  \node[box,below=3cm of hbs2-peer2]
-      (hbs2-peerN)
-      {\underline{hbs2-peerN}\\\Acc{}};
-
-  \draw[->] (hbs2-peer1) -- (hbs2-peer2)
-    node[below,midway] {MAILBOX:SEND}
-    node[above,midway] {PR~Message};
-
-  \draw[->] (hbs2-peer2) -- (hbs2-peerN)
-    node[left,midway] {MAILBOX:SEND}
-    node[left,midway,yshift=4mm] {PR~Message};
-
-  \node[box,right=2cm of hbs2-peerN] (process) {filter-process};
-
-  \node[box,right=2cm of process] (fixme) {fixme};
-
-  \node[db,right=1cm of fixme,anchor=west,yshift=-4mm] (db) {fixme-state};
-
-  \draw[->] (process.150) -- ($(hbs2-peerN.north east)!(process.150)!(hbs2-peerN.south east)$)
-      node[midway,above] {MAIL-CHECK};
-
-  \draw[->] (process.180) -- ($(hbs2-peerN.north east)!(process.180)!(hbs2-peerN.south east)$)
-      node[midway,above] {READ};
-
-  \draw[->] (process) -- (fixme)
-    node[above,midway] {import};
-
-  \draw[->]  (fixme.south) -- ($(fixme.south) - (0,+2cm)$) -| (hbs2-peerN.south)
-    node[below,near start] {refchan:export};
-
-  \draw[->] (fixme.east) -- (db.152);
-
-
-\end{tikzpicture}
-\end{figure}
-
-Пользователь формирует сообщение специального вида (plaintext/fixme) которое
-посылается по протоколу MAILBOX получателю -- владельцу мейлобокса, который
-указан в manifest проекта, как контакт для посылки подобных сообщений.
-
-На некоем хосте существует процесс, который время от времени проверяет
-\Mailbox{} и при обнаружении новых сообщений экспортирует их в fixme,
-который, в свою очередь, помещает их в RefChan делая доступными и видимыми
-для подписчиков этого рефчана.
-
-Обновления данного Issue/PR возможны, если в качестве fixme-key выбран некий
-уникальный идентификатор, который и будет указан в каждом сообщении.
-
-
-\end{document}
-
-
--- a/docs/todo/download-exponential-backoff.txt
+++ b/docs/todo/download-exponential-backoff.txt
@ -1,8 +0,0 @@
-TODO: asap-exponential-backoff-on-download
-  Увеличивать таймаут между запросами блока с
-  какой-то степенью; достаточно пологой
-
-TODO: download-drop-cli-command
-  Сделать команду hbs2-peer download drop
-  которая удалит все активные скачивания из очереди
-
--- a/docs/todo/fixme-new-web.txt
+++ b/docs/todo/fixme-new-web.txt
@ -1,30 +0,0 @@
-TODO: fixme-refchan-to-manifest
-  добавить настройку рефчана для fixme в манифест проекта
-
-TODO: fixme-refchan-allow
-  добавить настройку для разрешения fixme для проекта.
-  только если разрешено --- пир подписывается на этот рефчан
-  и тянет из него issues
-
-TODO: fixme-init
-  инициализация fixme в каталоге репозитория.
-  проконтроллировать, что нормально работает с bare
-  репо
-
-TODO: fixme-refchan-import
-  встроить обновление стейта fixme в
-  конвейры hbs2-git-dashboard
-  (видимо, отдельным конвейром)
-
-
-FIXME: poll-fixme-refchans
-  сейчас новые рефчаны с fixme будут подтянуты
-  только при перезапуске. надо встроить явный
-  poll
-
-
-FIXME: commit-and-blob-catch-inconsistency
- похоже, возникают ситуации, когда fixme-new захватывает
- blob и commit некорректно (из разных коммитов?), и
- hbs2-git-dashboard, бывает, не может найти blob в индексе.
-
--- a/docs/todo/hbs2-git-dashboard.txt
+++ b/docs/todo/hbs2-git-dashboard.txt
@ -1,34 +0,0 @@
-FIXME: poll-fixme-refchans
-  поллить рефчаны fixme и обновлять
-  в случае изменений.
-
-  Сейчас не обновляются
-
-FIXME: commit-cache-inconsistency
-
-  Встретилась ситуация, когда commit помечен, как processed, но не все блобы
-  из него попали в кэш.
-
-  Похожие ситуации возникают и в hbs2-git.
-
-  Похоже, надо как-то инвертировать подход: когда искомые данные
-  встречаются в кэше --- отдаём из него, а когда нет --- ищем
-  в источнике (рефчане, дереве, репозитории).
-
-  Значит, в этих источниках должен быть некий индекс.
-
-  В git он есть.
-
-  В hbs2-git он вроде бы тоже есть.
-
-  Возможно, это будет незначительно медленнее при выдаче,
-  но сильно быстрее при индексации и система будет, типа,
-  самовосстанавливающаяся.
-
-  Возможно, это приведёт к тому, что все схемы выродятся
-  в таблицу "object", для ускорения доступа к которой
-  будут создаваться индексные таблицы (aka materialized view)
-  на её же основе только средствами sqlite.
-
-
-
--- a/docs/todo/hbs2-peer-queues.txt
+++ b/docs/todo/hbs2-peer-queues.txt
@ -1,29 +0,0 @@
-TODO: hbs2-peer-queues
-  $workflow: backlog
-
-  Сделать механизм очередей ( циклических FIFO буферов )
-  с управлением ( put/get ) по RPC
-
-  hbs2-peer постоянно в памяти;
-
-  Тогда мы решаем проблемы блокировок в sqlite:
-
-  Процесс продюсер -- пишет в очередь через hbs2-peer ( на диск )
-
-  Процесс консьюмер -- читает оттуда и обновляет БД, когда к этому
-  готов.
-
-  Таким образом, мы избегаем проблем с блокировками и
-  получаем понятный асинхронный механизм взаимодействия
-  между разными программами из hbs2.
-
-  Технически их можно сделать на основе компактов, в каждый
-  compact пишутся сообщения в формате (n, bytestring), после
-  чтения консьюмером -- сообщения удаляются.
-
-  По превышению файлом компакта некоего размера --
-  производим компактизацию, т.е начинаем писать в новый
-  файл, а старый удаляем, как только в нём не останется
-  ничего для чтения... Ну или как-то так.
-
-
--- a/docs/todo/hbs2-peer.txt
+++ b/docs/todo/hbs2-peer.txt
@ -1,39 +0,0 @@
-TODO: ASAP-bloom-filter-of-blocks
-
-  Каждый пир поддерживает фильтр Блума для блоков и раздаёт этот фильтр по
-  протоколу.
-
-  Протокол подразумевает как отдачу всего фильтра целиком ( тут подходит
-  держать его в LWWRef)
-
-  Так и просто запросы к нему.
-
-  Запрос должен пролезать в UDP, таким образом, выглядит так, что это
-  список чисел с номерами бит, т.е в худшем случае (8 байт на число)
-  один запрос это проверка 128 блоков за раз. Поскольку CBOR у нас
-  кодирует числа с переменной длиной, можно ожидать, что в среднем
-  будет получше.
-
-  Это ускорит, возможно, на порядок поиск блоков, который тем хуже,
-  чем больше в системе пиров.
-
-  Открытые вопросы:
-
-  - Параметры фильтра Блума? Зашитые в систему, или зависящие от
-    пира (и тогда мы пересчитываем их)
-
-  - Надо ли качать фильтры целиком (кажется, что нет, но можно
-    запоминать/обновлять для каждого пира, и время от времени
-    чистить)
-
-  - Если параметры фильтра могут меняться для пира, как
-    согласовывать хэш функции? Если их зашивать и менять только
-    коэффициенты, то не слишком ли плохие будут хэш функции?
-
-  - Какие атаки может вызвать?
-
-  - Как эффективно хранить?
-
-
-
-
--- a/docs/todo/hbs2-sync.txt
+++ b/docs/todo/hbs2-sync.txt
@ -1,37 +0,0 @@
-FIXME: race-on-large-files
-  добавляем большой файл ( ~4GB )
-  делаем hbs2-sync run на хосте A
-  делаем hbs2-sync run на хосте B
-  результат: файл удалён (tomb transaction)
-  вероятно, гонка по какой-то причине.
-
-  кажется, это backup-mode гадит
-
-TODO: hbs2-sync-recovery
-  сделать команды для получения всех
-  меркл-деревьев (игнорировать tomb-ы)
-
-  сделать команду для постинга транзакции с
-  новым таймстемпом (восстановить файл из tomb-а не копируя его)
-
-
-TODO: hbs2-sync-group-key-policy
-  сейчас на каждый файл генерируется новый групповой
-  ключ.
-
-  это хорошо, но если добавить большой файл
-  удалить большой файл
-  добавить большой файл обратно --- получится
-  адовое дублирование данных.
-
-  Возможное решение --- держать групповой ключ в кэше,
-  и устраивать его ротацию время от времени.
-
-
-TODO: hbs2-sync-whole-state
-  сейчас будет выкачан весь рефчан, включая удалённые данные (tombs)
-  там, где они не нужны.
-
-  это плохо для файлопомойки.
-
-  нужно найти решения для проблемы
--- a/docs/todo/static-binaries.txt
+++ b/docs/todo/static-binaries.txt
@ -1,7 +0,0 @@
-PR: Initial support for static builds using nix
-  Still work in progress.
-  Suddenly, I didn't manage to make flake that is able to build
-  both static and dynamic binaries.
-
-  To run static builds use `nix build .#static` command at the project's root
-  commit: be86429c4b806fe20069e8efbf921c20b9e17ee3
--- a/examples/dns-example-1/dns.ss
+++ b/examples/dns-example-1/dns.ss
@ -1,92 +0,0 @@
-
-;; all key ids are PUBLIC
-
-(define hosts
-   ;; host-id sign-key encrypt-key
-  `[
-     (minime  4Z1ebkksoiZ9j4vZE9jnghxPDmc1ihXdNC6cX39phkLD
-              9Fp8Y5c9Fp612sjby3bL8P3SnUjjK2bz4F38nmVASpzb)
-
-     (expert  CxJaFMBykhTdUiXxgdWF2pjxV5cWtw3yjDozNniUYRRC
-              Hg6XD19KGQrVjMYrCNeuaGfhTn7BCCUGR8c3brSWnzQi)
-
-     (minipig 44onTKSrAjXQ42Ahu6Z8d5X35g23pTTbSgRudNow9ZEn
-              D17PC8RGELG2wvTUoeAVhZvpf5R2txQHdwtYxGAJ9M1h)
-
-   ]
-)
-
-(define (sign-key host)
-  (str (nth 1 (assoc host hosts))))
-
-(define (encrypt-key host)
-  (str (nth 2 (assoc host hosts))))
-
-(define my-refchan-head
-  `[
-
-(version 2)
-(quorum 1)
-(wait 10)
-(peer "CVDMz8BiSvRsgWNbJ4u9vRwXthN8LoF8XbbbjoL2cNFd" 1)
-(peer "5GnroAC8FXNRL8rcgJj6RTu9mt1AbuNd5MZVnDBcCKzb" 1)
-(peer "J8dFP5TbUQxUpVbVqZ3NKKPwrhvUCTQKC6xrVWUGkrR6" 1)
-(author ,(sign-key minime))
-(author ,(sign-key expert))
-(author ,(sign-key minipig))
-
-(reader ,(encrypt-key minime))
-(reader ,(encrypt-key expert))
-(reader ,(encrypt-key minipig))
-   ]
-)
-
-(define (create-refchan)
-  [hbs2:refchan:create my-refchan-head]
-)
-
-;; created once by create-refchan
-(define REFCHAN :Aze8PNNexhfz629UfaE79oyRW8Rf7fTGSVoJW4qD95Z7)
-(define HOST  [car [car [call:proc hostname]]])
-
-(define (update-refchan)
-  [hbs2:refchan:head:update REFCHAN my-refchan-head]
-)
-
-(define (create:name:update host)
-  (begin
-    (local pk (sign-key host))
-    (local tx (hbs2:refchan:tx:raw:create pk [unwords :name host]))
-    tx
-  )
-)
-
-(define (post:name:update)
-  (begin
-    (local tx (create:name:update HOST))
-    (hbs2:refchan:tx:propose REFCHAN tx)
-  )
-)
-
-(define (state:get)
-  (begin
-    ; won't work on ipv6 address 'cause of their stupid : as separator
-    (local (strip x) [sym [car [split :: [last [split :// x]]]]] )
-    (local self [list [sym [car [cdr [car [ grep peer-key [hbs2:peer:poke] ]]]]] :127.0.0.1])
-    (local txs (grep :propose (hbs2:refchan:tx:raw:list REFCHAN)))
-    (local (hostname e)  (car (cdr (car (top:string (bytes:decode [nth 4 _1]))))) )
-    (local peers (map (lambda [x] [car [cdr x]]) (car (call:proc hbs2-peer do peer-info))))
-
-    (local peers2 (map [fn 1  [list (lookup:uw :key _1) (strip (lookup:uw :addr _1))]] peers))
-    (local peers3 (filter [fn 1 [not (eq? [nth 1 _1] :192.168.1.1)]] peers2))
-
-    (local state (map [fn 1 [list [nth 2 _1] [hostname _1] ]] txs))
-
-    (local (entry e) [list [lookup:uw [nth 0 e] (cons self peers3)] [nth 1 e] ])
-    (local res [map [fn 1 [entry _1]]  state])
-
-    res
-  )
-)
-
-
--- a/examples/refchan-qblf/app/Main.hs
+++ b/examples/refchan-qblf/app/Main.hs
@ -1,6 +0,0 @@
-module Main where
-
-import RefChanQBLF.CLI qualified as CLI
-
-main :: IO ()
-main = CLI.main
--- a/examples/refchan-qblf/app/RefChanQBLFMain.hs
+++ b/examples/refchan-qblf/app/RefChanQBLFMain.hs
@ -0,0 +1,806 @@
+{-# Language TemplateHaskell #-}
+{-# Language UndecidableInstances #-}
+{-# Language AllowAmbiguousTypes #-}
+module Main where
+
+import HBS2.Prelude
+import HBS2.Defaults
+import HBS2.Merkle
+import HBS2.Hash
+import HBS2.Clock
+import HBS2.Base58
+import HBS2.OrDie
+import HBS2.Data.Types.Refs
+import HBS2.Net.Proto.Types
+import HBS2.Actors.Peer
+import HBS2.Peer.Proto.RefChan
+import HBS2.Peer.Proto.AnyRef
+import HBS2.Data.Types.SignedBox
+import HBS2.Net.Messaging.Unix
+import HBS2.Data.Bundle
+import HBS2.Net.Auth.Credentials
+import HBS2.Data.Detect
+import HBS2.Actors.Peer.Types()
+
+import HBS2.Storage.Simple
+
+import HBS2.System.Logger.Simple
+
+import HBS2.Net.Proto.QBLF
+
+import Demo.QBLF.Transactions
+import Data.Config.Suckless
+
+import Control.Monad.Trans.Maybe
+import Codec.Serialise
+import Control.Monad.Reader
+import Data.ByteString(ByteString)
+import Data.ByteString.Char8 qualified as BS
+import Data.ByteString.Lazy qualified as LBS
+import Data.List qualified as List
+import Lens.Micro.Platform hiding ((.=))
+import Options.Applicative hiding (info)
+import Options.Applicative qualified as O
+import System.Directory
+import Data.HashSet qualified as HashSet
+import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict qualified as HashMap
+import Data.Maybe
+import Data.Word
+import System.Random
+import UnliftIO
+
+import Web.Scotty hiding (request,header)
+import Network.HTTP.Types.Status
+import Data.Cache (Cache)
+import Data.Cache qualified as Cache
+
+import Control.Monad.Except
+
+{- HLINT ignore "Use newtype instead of data" -}
+
+-- TODO: config
+--  сделать конфиг, а то слишком много уже параметров в CLI
+
+data HttpPortOpt
+data RefChanOpt
+data SocketOpt
+data ActorOpt
+data DefStateOpt
+data StateRefOpt
+
+data QBLFRefKey
+type MyRefKey = AnyRefKey QBLFRefKey HBS2Basic
+
+instance Monad m => HasCfgKey HttpPortOpt (Maybe Int) m where
+  key = "http"
+
+
+instance {-# OVERLAPPING #-} (HasConf m, HasCfgKey HttpPortOpt (Maybe Int) m) => HasCfgValue HttpPortOpt (Maybe Int) m where
+  cfgValue  = val <$> getConf
+    where
+      val syn = lastMay [ fromIntegral e
+                | ListVal (Key s [LitIntVal e]) <- syn, s == key @HttpPortOpt @(Maybe Int) @m
+                ]
+
+instance Monad m => HasCfgKey RefChanOpt (Maybe String) m where
+  key = "refchan"
+
+instance Monad m => HasCfgKey SocketOpt (Maybe String) m where
+  key = "socket"
+
+instance Monad m => HasCfgKey ActorOpt (Maybe String) m where
+  key = "actor"
+
+instance Monad m => HasCfgKey DefStateOpt (Maybe String) m where
+  key = "default-state"
+
+instance Monad m => HasCfgKey StateRefOpt (Maybe String) m where
+  key = "state-ref"
+
+class ToBalance e tx where
+  toBalance :: tx -> [(Account e, Amount)]
+
+tracePrefix :: SetLoggerEntry
+tracePrefix  = toStderr . logPrefix "[trace] "
+
+debugPrefix :: SetLoggerEntry
+debugPrefix  = toStderr . logPrefix "[debug] "
+
+errorPrefix :: SetLoggerEntry
+errorPrefix  = toStderr . logPrefix "[error] "
+
+warnPrefix :: SetLoggerEntry
+warnPrefix   = toStderr . logPrefix "[warn] "
+
+noticePrefix :: SetLoggerEntry
+noticePrefix = toStderr . logPrefix "[notice] "
+
+infoPrefix :: SetLoggerEntry
+infoPrefix = toStdout . logPrefix ""
+
+silently :: MonadIO m => m a -> m ()
+silently m = do
+  setLoggingOff @DEBUG
+  setLoggingOff @INFO
+  setLoggingOff @ERROR
+  setLoggingOff @WARN
+  setLoggingOff @NOTICE
+  void m
+
+withLogging :: MonadIO m => m a -> m ()
+withLogging m = do
+
+  -- setLogging @TRACE  tracePrefix
+  setLogging @DEBUG  debugPrefix
+  setLogging @INFO   infoPrefix
+  setLogging @ERROR  errorPrefix
+  setLogging @WARN   warnPrefix
+  setLogging @NOTICE noticePrefix
+
+  m
+
+  setLoggingOff @DEBUG
+  setLoggingOff @INFO
+  setLoggingOff @ERROR
+  setLoggingOff @WARN
+  setLoggingOff @NOTICE
+
+data MyEnv =
+  MyEnv
+  { mySelf  :: Peer UNIX
+  , myFab   :: Fabriq UNIX
+  , myChan  :: RefChanId UNIX
+  , myRef   :: MyRefKey
+  , mySto   :: AnyStorage
+  , myCred  :: PeerCredentials HBS2Basic
+  , myHttpPort :: Int
+  , myFetch :: Cache HashRef ()
+  }
+
+newtype App m a = App { fromApp :: ReaderT MyEnv m a }
+                  deriving newtype ( Functor
+                                   , Applicative
+                                   , Monad
+                                   , MonadIO
+                                   , MonadUnliftIO
+                                   , MonadReader MyEnv
+                                   , MonadTrans
+                                   )
+
+runApp :: (MonadIO m, PeerMessaging UNIX) => MyEnv -> App m a -> m a
+runApp env m = runReaderT (fromApp  m) env
+
+instance Monad m => HasFabriq UNIX (App m) where
+  getFabriq = asks myFab
+
+instance Monad m => HasOwnPeer UNIX (App m) where
+  ownPeer = asks mySelf
+
+instance Monad m => HasStorage (App m) where
+  getStorage = asks mySto
+
+data ConsensusQBLF
+
+data StateQBLF = StateQBLF { fromStateQBLF :: HashRef }
+
+data MyError =
+  DeserializationError | SignatureError | TxUnsupported | SomeOtherError
+  deriving stock (Eq,Ord,Show)
+
+check :: MonadIO m => MyError -> Either e a -> ExceptT MyError m a
+check w  = \case
+  Right x -> ExceptT $ pure (Right x)
+  Left{}  -> ExceptT $ pure (Left w)
+
+fiasco :: MonadIO m => MyError -> ExceptT MyError m a
+fiasco x = ExceptT $ pure $ Left x
+
+ok :: MonadIO m => a -> ExceptT MyError m a
+ok x = ExceptT $ pure $ Right x
+
+
+type ForConsensus m = (MonadIO m, Serialise (QBLFMessage ConsensusQBLF))
+
+instance Serialise (QBLFMerge ConsensusQBLF)
+instance Serialise (QBLFMessage ConsensusQBLF)
+instance Serialise (QBLFAnnounce ConsensusQBLF)
+instance Serialise (QBLFCommit ConsensusQBLF)
+
+instance Monad m => HasTimeLimits UNIX (RefChanNotify UNIX) (App m) where
+  tryLockForPeriod _ _ = pure True
+
+instance (ForConsensus m, MonadUnliftIO m)  => IsQBLF ConsensusQBLF (App m) where
+  type QBLFActor ConsensusQBLF = Actor L4Proto
+  type QBLFTransaction ConsensusQBLF = QBLFDemoToken L4Proto
+  type QBLFState ConsensusQBLF = DAppState
+
+  qblfMoveForward _ s1 = do
+    env <- ask
+    fetchMissed env s1
+    pure True
+
+  qblfNewState (DAppState h0) txs = do
+    sto <- asks mySto
+    chan <- asks myChan
+    self <- asks mySelf
+    creds <- asks myCred
+    let sk = view peerSignSk creds
+    let pk = view peerSignPk creds
+
+    -- основная проблема в том, что мы пересортировываем весь state
+    -- однако, если считать его уже отсортированным, то, может быть,
+    -- все будет не так уж плохо.
+    -- так-то мы можем вообще его на диске держать
+
+    root <- if List.null txs then do
+              pure h0
+            else do
+              hashes <- liftIO $ mapM (putBlock sto . serialise) txs <&> catMaybes
+
+              current <- readLog (getBlock sto) h0
+
+              let new = HashSet.fromList ( current <> fmap HashRef hashes )
+
+              let pt = toPTree (MaxSize 256) (MaxNum 256) (HashSet.toList new)
+
+              -- пробуем разослать бандлы с транзакциями
+              runMaybeT do
+                ref <- MaybeT $ createBundle sto (fmap HashRef hashes)
+                let refval = makeBundleRefValue @L4Proto pk sk (BundleRefSimple ref)
+                r <- MaybeT $ liftIO $ putBlock sto (serialise refval)
+                lift $ request self (ActionRequest @UNIX chan (RefChanAnnounceBlock (HashRef r)))
+
+              r <- makeMerkle 0 pt $ \(hx,_,bs) -> do
+                th <- liftIO (enqueueBlock sto bs)
+                debug $ "WRITE TX" <+> pretty hx
+
+              request self (ActionRequest @UNIX chan (RefChanAnnounceBlock (HashRef r)))
+
+              pure (HashRef r)
+
+    debug $ "PROPOSED NEW STATE:" <+> pretty root
+    pure $ DAppState root
+
+  qblfCommit s0 s1 = do
+    debug $ "COMMIT:" <+> pretty s0 <+> pretty s1
+    sto <- asks mySto
+    chan <- asks myChan
+    ref  <- asks myRef
+
+    debug $ "UPDATING REF" <+> pretty ref <+> pretty s1
+    liftIO $ updateRef sto ref (fromHashRef (fromDAppState s1))
+    pure ()
+
+  qblfBroadCast msg = do
+      self <- asks mySelf
+      creds <- asks myCred
+      chan <- asks myChan
+
+      let sk = view peerSignSk creds
+      let pk = view peerSignPk creds
+      nonce <- randomIO @Word64 <&> serialise <&> LBS.toStrict
+      let box = makeSignedBox @UNIX pk sk (LBS.toStrict (serialise msg) <> nonce)
+      let notify = Notify @UNIX chan box
+      request self notify
+
+      case msg of
+        QBLFMsgAnn _ (QBLFAnnounce _ _) -> do
+          -- TODO: maybe-announce-new-state-here
+          pure ()
+
+        _ -> none
+
+  -- TODO: optimize-qblf-merge
+  --   будет нормально работать до десятков/сотен тысяч транз,
+  --   а потом помрёт.
+  --   варианты:
+  --     1. перенести логику в БД
+  --     2. кэшировать всё, что можно
+  qblfMerge s0 s1 = do
+    chan <- asks myChan
+    self <- asks mySelf
+
+    creds <- asks myCred
+    let sk = view peerSignSk creds
+    let pk = view peerSignPk creds
+
+    debug $ "MERGE. Proposed state:" <+> pretty s1
+
+    sto <- asks mySto
+    let readFn = liftIO . getBlock sto
+
+    tx1 <- mapM (readLog readFn) (fmap fromDAppState s1) <&> mconcat
+    tx0 <- readLog readFn (fromDAppState s0) <&> HashSet.fromList
+
+    let txNew = HashSet.fromList tx1 `HashSet.difference` tx0
+
+    if List.null txNew then do
+      pure s0
+    else do
+      debug $ "READ TXS" <+> pretty s1 <+> pretty (length tx1)
+
+      r <- forM tx1 $ \t -> runMaybeT do
+
+              -- игнорируем ранее добавленные транзакции
+              guard (not (HashSet.member t tx0))
+
+              bs <- MaybeT $ liftIO $ getBlock sto (fromHashRef t)
+
+              tx <- MaybeT $ pure $ deserialiseOrFail @(QBLFDemoToken L4Proto) bs & either (const Nothing) Just
+
+              case tx of
+                Emit box -> do
+                  (pk, e@(EmitTx a q _)) <- MaybeT $ pure $ unboxSignedBox0 @(EmitTx L4Proto) box
+                  guard ( chan == pk )
+                  debug $ "VALID EMIT TRANSACTION" <+> pretty t <+> pretty (AsBase58 a) <+> pretty q
+                  pure ([(t,e)], mempty)
+
+                (Move box) -> do
+                  (_, m@(MoveTx _ _ qty _)) <- MaybeT $ pure $ unboxSignedBox0 @(MoveTx L4Proto) box
+
+                  guard (qty > 0)
+                  debug $ "MOVE TRANSACTION" <+> pretty t
+                  pure (mempty, [(t,m)])
+
+      let parsed = catMaybes r
+
+      let emits = foldMap (view _1) parsed
+
+      let moves = foldMap (view _2) parsed & List.sortOn fst
+
+      bal0 <- balances (fromDAppState s0)
+
+      -- баланс с учётом новых emit
+      let balE = foldMap (toBalance @L4Proto . snd) emits
+                        & HashMap.fromListWith (+)
+                        & HashMap.unionWith (+) bal0
+
+      let moves' = updBalances @L4Proto balE moves
+
+      let merged = fmap fst emits <> fmap fst moves'
+
+      let pt = toPTree (MaxSize 256) (MaxNum 256) (HashSet.toList (tx0 <> HashSet.fromList merged))
+
+      root <- makeMerkle 0 pt $ \(_,_,bs) -> do
+                void $ liftIO (putBlock sto bs)
+
+      let new = DAppState (HashRef root)
+
+      -- FIXME: garbage-collect-discarded-states
+
+      async $ void $ balances (fromDAppState new)
+      debug $ "MERGED" <+> pretty new
+
+      pure new
+
+
+instance HasStorage (ReaderT AnyStorage IO) where
+  getStorage = ask
+
+
+
+instance ToBalance e (EmitTx e) where
+  toBalance (EmitTx a qty _) = [(a, qty)]
+
+instance ToBalance e (MoveTx e) where
+  toBalance (MoveTx a1 a2 qty _) = [(a1, -qty), (a2, qty)]
+
+balances :: forall e s m . ( e ~ L4Proto
+                           , MonadIO m
+                           , HasStorage m
+                           -- , FromStringMaybe (PubKey 'Sign s)
+                           , s ~ Encryption e
+                           , ToBalance L4Proto (EmitTx L4Proto)
+                           , ToBalance L4Proto (MoveTx L4Proto)
+                           , Pretty (AsBase58 (PubKey 'Sign s))
+                           )
+         => HashRef
+         -> m (HashMap (Account e) Amount)
+
+balances root = do
+  sto <- getStorage
+
+  let pk = SomeRefKey (HashRef "6ChGmfYkwM6646oKkj8r8MAjdViTsdtZSi6tgqk3tbh", root)
+
+  cached <- runMaybeT do
+    rval <- MaybeT $ liftIO $ getRef sto pk
+    val  <- MaybeT $ liftIO $ getBlock sto rval
+    MaybeT $ deserialiseOrFail @(HashMap (Account e) Amount) val
+          & either (const $ pure Nothing) (pure . Just)
+
+  case cached of
+    Just bal -> pure bal
+    Nothing -> do
+
+      txs <- readLog (liftIO . getBlock sto) root
+
+      r <- forM txs $ \h -> runMaybeT do
+        blk <- MaybeT $ liftIO $ getBlock sto (fromHashRef h)
+        tx  <- MaybeT $ pure $ deserialiseOrFail @(QBLFDemoToken L4Proto) blk & either (const Nothing) Just
+
+        case tx of
+          Emit box -> do
+            (_, emit) <- MaybeT $ pure $  unboxSignedBox0 @(EmitTx L4Proto) box
+            pure $ toBalance @e emit
+
+          Move box -> do
+            (_, move) <- MaybeT $ pure $  unboxSignedBox0 @(MoveTx L4Proto) box
+            pure $ toBalance @e move
+
+      let val = catMaybes r & mconcat & HashMap.fromListWith (+)
+
+      runMaybeT do
+        checkComplete sto root >>= guard
+        rv <- MaybeT $ liftIO $ putBlock sto (serialise val)
+        liftIO $ updateRef sto pk rv
+
+      pure val
+
+
+-- TODO: optimize-upd-balances
+--  можно сгруппировать по аккаунтам
+--  и проверять только те транзакции, которые относятся
+--  к связанной (транзакциями) группе аккаунтов.
+--  то есть, разбить на кластеры, у которых отсутствуют пересечения по
+--  аккаунтам и проверять независимо и параллельно, например
+--  причем, прямо этой функцией
+--
+-- updBalances :: HashMap (Account L4Proto) Amount
+--              -> [(tx, b)]
+--              -> [(tx, b)]
+
+updBalances :: forall e a tx . (ForRefChans e, ToBalance e tx)
+            => HashMap (Account e) Amount
+            -> [(a, tx)]
+            -> [(a, tx)]
+
+updBalances = go
+  where
+    go bal [] = empty
+
+    go bal (t:rest) =
+
+      if good then
+        t : go nb rest
+      else
+        go bal rest
+
+      where
+        nb = HashMap.unionWith (+) bal (HashMap.fromList (toBalance @e (snd t)))
+        good = HashMap.filter (<0) nb & HashMap.null
+
+
+fetchMissed :: forall e w m . ( MonadIO m
+                              , Request e (RefChanNotify e) m
+                              , e ~ UNIX
+                              , w ~ ConsensusQBLF
+                              )
+            => MyEnv
+            -> QBLFState w
+            -> m ()
+
+fetchMissed env s = do
+  let tube = mySelf env
+  let chan = myChan  env
+  let cache = myFetch env
+  let sto = mySto env
+
+  let href = fromDAppState s
+
+  here <- liftIO $ hasBlock sto (fromHashRef href) <&> isJust
+  wip <- liftIO $ Cache.lookup cache href <&> isJust
+
+  when here do
+    liftIO $ Cache.delete cache href
+
+  unless (here || wip) do
+    debug $ "We might be need to fetch" <+> pretty s
+    liftIO $ Cache.insert cache href ()
+    request @UNIX tube (ActionRequest @UNIX chan (RefChanFetch (fromDAppState s)))
+
+runMe :: ForConsensus IO => Config -> IO ()
+runMe conf = withLogging $ flip runReaderT conf do
+
+  debug $ "runMe" <+> pretty conf
+
+  kr    <- cfgValue @ActorOpt @(Maybe String) `orDie` "actor's key not set"
+  chan' <- cfgValue @RefChanOpt @(Maybe String) `orDie` "refchan not set"
+  sa    <- cfgValue @SocketOpt @(Maybe String) `orDie` "socket not set"
+  pno   <- cfgValue @HttpPortOpt @(Maybe Int) <&> fromMaybe 3011
+  ds    <- cfgValue @DefStateOpt @(Maybe String)
+
+  ref   <- ( cfgValue @StateRefOpt @(Maybe String)
+                <&>  maybe Nothing fromStringMay
+           ) `orDie` "state-ref not set"
+
+  sc <- liftIO $ BS.readFile kr
+  creds <- pure (parseCredentials @HBS2Basic (AsCredFile sc)) `orDie` "bad keyring file"
+
+  chan  <- pure (fromStringMay @(RefChanId L4Proto) chan') `orDie` "invalid REFCHAN"
+
+  here <- liftIO $ doesFileExist sa
+
+  when here do
+    liftIO $ removeFile sa
+
+  server <- newMessagingUnixOpts [MUNoFork] True 1.0 sa
+
+  abus <- async $ runMessagingUnix server
+
+  let tube = fromString sa
+
+  -- FIXME: fix-default-storage
+  xdg <- liftIO $ getXdgDirectory XdgData defStorePath <&> fromString
+  sto' <- simpleStorageInit @HbSync [StoragePrefix xdg]
+
+  let sto = AnyStorage sto'
+  sw <- liftIO $ replicateM 4 $ async $ simpleStorageWorker sto'
+
+  -- FIXME: fix-hardcoded-timeout
+  fetches <- liftIO $ Cache.newCache (Just (toTimeSpec (TimeoutSec 30)))
+
+  let myEnv = MyEnv tube
+                    (Fabriq server)
+                    chan
+                    ref
+                    sto
+                    creds
+                    pno
+                    fetches
+
+  let dss = ds >>= fromStringMay
+
+  s0 <- readOrCreateStateRef dss sto ref
+
+  debug $ "STATE0:" <+> pretty s0
+
+  -- получить голову
+  -- из головы получить акторов
+
+  headBlk <- getRefChanHead @L4Proto sto (RefChanHeadKey chan) `orDie` "can't read head block"
+
+  let self = view peerSignPk creds & Actor @L4Proto
+
+  let actors = view refChanHeadAuthors headBlk
+                  & HashSet.toList
+                  & fmap (Actor @L4Proto)
+
+  runApp myEnv do
+
+    -- FIXME: timeout-hardcode
+    let w = realToFrac 5
+
+    -- FIXME: use-actors-asap
+    qblf <- qblfInit @ConsensusQBLF self actors (DAppState (HashRef s0)) w
+
+    consensus <- async do
+                   pause @'Seconds 0.5
+                   qblfRun qblf
+
+
+    -- FIXME: web-port-to-config
+    web <- async $ liftIO $ scotty (fromIntegral (myHttpPort myEnv)) $ do
+             post "/tx" $ do
+
+              r <- runExceptT do
+
+                bin <- lift body
+                let hBin = hashObject @HbSync bin
+
+                debug $ "GOT TX" <+> pretty hBin
+
+                tok <- check DeserializationError =<< pure (deserialiseOrFail @(QBLFDemoToken L4Proto) bin)
+
+                tx <- case tok of
+                        (Emit box) -> do
+                          (sign, tx) <- maybe (ExceptT $ pure $ Left SignatureError) pure $  unboxSignedBox0 box
+
+                          if sign == chan then
+                            pure hBin
+                          else
+                            fiasco SignatureError
+
+                        (Move box) -> do
+                          (sign, tx) <- maybe (ExceptT $ pure $ Left SignatureError) pure $  unboxSignedBox0 box
+                          pure hBin
+
+                qblfEnqueue qblf tok
+                pure hBin
+
+              case r of
+                Left SignatureError -> do
+                  err $ viaShow SignatureError
+                  status status401
+
+                Left e -> do
+                  err $ viaShow e
+                  status status400
+
+                Right tx -> do
+                  debug $ "TX ENQUEUED OK" <+> pretty tx
+                  status status200
+
+    link web
+
+    runProto $ List.singleton $ makeResponse (myProto myEnv qblf chan)
+
+  void $ waitAnyCatchCancel $ [abus] <> sw
+
+  where
+
+    myProto :: forall e m . ( MonadIO m
+                            , Request e (RefChanNotify e) m
+                            , e ~ UNIX
+                            )
+                       => MyEnv
+                       -> QBLF ConsensusQBLF
+                       -> RefChanId e
+                       -> RefChanNotify e
+                       -> m ()
+
+    myProto _ qblf _ (ActionRequest{}) = do
+      pure ()
+
+    myProto env qblf chan (Notify _ msg) = do
+
+      let sto = mySto env
+      let tube = mySelf env
+
+      let coco = hashObject @HbSync $ serialise msg
+      void $ runMaybeT do
+        (_, wrapped) <- MaybeT $ pure $ unboxSignedBox0 @ByteString @UNIX msg
+        qbmess <- MaybeT $ pure $ deserialiseOrFail @(QBLFMessage ConsensusQBLF) (LBS.fromStrict wrapped)
+                                              & either (const Nothing) Just
+
+        states <- case qbmess of
+          QBLFMsgAnn _ (QBLFAnnounce s0 s1) -> do
+            pure [s0, s1]
+
+          QBLFMsgHeartBeat _ _ s0 _-> do
+            pure  [s0]
+
+          _ -> do
+            pure mempty
+
+        -- FIXME: full-download-guarantee
+        lift $ forM_ states (fetchMissed env)
+
+        qblfAcceptMessage qblf qbmess
+        -- debug $ "RefChanQBLFMain(3)" <+> "got message" <+> pretty (AsBase58 chan) <+> pretty coco
+
+    readOrCreateStateRef mbDs sto ref = do
+      debug $ "MyRef:" <+> pretty (hashObject @HbSync ref)
+      fix \spin -> do
+                mbref <- liftIO $ getRef @_ @HbSync sto ref
+                case mbref of
+                  Nothing -> do
+                    debug "STATE is empty"
+                    maybe1 mbDs none $ \ds -> do
+                      debug $ "UPDATE REF" <+> pretty (hashObject @HbSync ref) <+> pretty (HashRef ds)
+                      liftIO $ updateRef sto ref ds
+
+                    pause @'Seconds 0.25
+
+                    spin
+
+                  Just val -> do
+                    pure val
+
+type Config = [Syntax MegaParsec]
+
+main :: IO ()
+main = join . customExecParser (prefs showHelpOnError) $
+  O.info (helper <*> globalOptions)
+  (  fullDesc
+  <> header "refchan-qblf-worker"
+  <> progDesc "for test and demo purposed"
+  )
+  where
+
+    globalOptions = applyConfig <$> commonOpts <*> cli
+
+    applyConfig :: Maybe FilePath -> (Config -> IO ()) -> IO ()
+    applyConfig config m = do
+      maybe1 config (m mempty) $ \conf -> do
+        top <- readFile conf <&> parseTop <&> either (pure mempty) id
+        m top
+
+    commonOpts = optional $ strOption (long "config" <> short 'c' <> help "Config file")
+
+    cli = hsubparser (  command "run" (O.info pRun (progDesc "run qblf servant" ) )
+                     <> command "gen" (O.info pGen (progDesc "generate transcation") )
+                     <> command "post" (O.info pPostTx (progDesc "post transaction") )
+                     <> command "check" (O.info pCheckTx (progDesc "check transaction") )
+                     <> command "balances" (O.info pBalances (progDesc "show balances") )
+                     )
+
+    pRun = do
+      pure runMe
+
+    pGen = hsubparser
+           (   command "tx-emit" ( O.info pGenEmit (progDesc "generate emit") )
+            <> command "tx-move" ( O.info pGenMove (progDesc "generate move") )
+           )
+
+    pGenEmit = do
+      kr    <- strOption   ( long "keyring"  <> short 'k' <> help "keyring file" )
+      amnt <- option @Amount auto ( long "amount" <> short 'n' <> help "amount" )
+      dest <- strArgument ( metavar "ADDRESS" )
+      pure $ const $ silently do
+        sc <- BS.readFile kr
+        creds <- pure (parseCredentials @HBS2Basic (AsCredFile sc)) `orDie` "bad keyring file"
+        let pk = view peerSignPk creds
+        let sk = view peerSignSk creds
+        acc <- pure (fromStringMay @(RefChanId L4Proto) dest) `orDie` "bad account address"
+        tx <- makeEmitTx @L4Proto pk sk acc amnt
+        LBS.putStr $ serialise tx
+
+    pGenMove = do
+      kr    <- strOption   ( long "wallet"  <> short 'w' <> help "wallet (keyring) file" )
+      amnt <- option @Amount auto ( long "amount" <> short 'n' <> help "amount" )
+      dest <- strArgument ( metavar "ADDRESS" )
+      pure $ const $ silently do
+        sc <- BS.readFile kr
+        creds <- pure (parseCredentials @HBS2Basic (AsCredFile sc)) `orDie` "bad keyring file"
+        let pk = view peerSignPk creds
+        let sk = view peerSignSk creds
+        acc <- pure (fromStringMay @(RefChanId L4Proto) dest) `orDie` "bad account address"
+        tx <- makeMoveTx @L4Proto pk sk acc amnt
+        LBS.putStr $ serialise tx
+
+    pCheckTx = do
+      kr    <- strOption   ( long "keyring"  <> short 'k' <> help "keyring file" )
+      pure $ const do
+        sc <- BS.readFile kr
+        creds <- pure (parseCredentials @HBS2Basic (AsCredFile sc)) `orDie` "bad keyring file"
+        let pk = view peerSignPk creds
+        let sk = view peerSignSk creds
+
+        tx <- LBS.getContents <&> deserialise @(QBLFDemoToken L4Proto)
+
+        case tx of
+          Emit box -> do
+            void $ pure (unboxSignedBox0 @(EmitTx L4Proto) @L4Proto box) `orDie` "bad emit tx"
+
+          Move box -> do
+            void $ pure (unboxSignedBox0 @(MoveTx L4Proto) @L4Proto box) `orDie` "bad move tx"
+
+        pure ()
+
+    pPostTx  = pure $ const do
+      error "not supported anymore / TODO via http"
+      -- rc <- strArgument ( metavar "REFCHAN" )
+      -- sa <- strArgument ( metavar "UNIX-SOCKET" ) <&> fromString
+      -- pure $ withLogging do
+      --   rchan <- pure (fromStringMay @(RefChanId L4Proto) rc) `orDie` "bad refchan"
+      --   print "JOPA"
+      --   -- FIXME: wrap-client-boilerplate
+      --   inbox <- newMessagingUnix False 1.0 sa
+      --   wInbox <- async $ runMessagingUnix inbox
+      --   let env = MyEnv (fromString sa) (Fabriq inbox) rchan
+      --   msg <- (LBS.getContents <&> deserialiseOrFail) `orDie` "transaction decode error"
+      --   runApp env do
+      --     request (mySelf env) (msg  :: QBLFDemoTran UNIX)
+      --     pause @'Seconds 0.1
+        -- cancel wInbox
+
+    pBalances = do
+      state <- strArgument ( metavar "STATE" )
+      pure $ const $ withLogging do
+
+        xdg <- liftIO $ getXdgDirectory XdgData defStorePath <&> fromString
+        sto' <- simpleStorageInit @HbSync [StoragePrefix xdg]
+
+        let sto = AnyStorage sto'
+        sw <- liftIO $ replicateM 4 $ async $ simpleStorageWorker sto'
+
+        root <- pure (fromStringMay @HashRef state) `orDie` "Bad STATE reference"
+
+        flip runReaderT sto $ do
+          debug $ "calculating balances for" <+> pretty root
+          bal <- balances root
+
+          forM_ (HashMap.toList bal) $ \(acc, qty) -> do
+            liftIO $ print $ pretty (AsBase58 acc) <+> pretty qty
+
--- a/examples/refchan-qblf/lib/Demo/QBLF/Transactions.hs
+++ b/examples/refchan-qblf/lib/Demo/QBLF/Transactions.hs
@ -0,0 +1,131 @@
+{-# Language UndecidableInstances #-}
+module Demo.QBLF.Transactions where
+
+import HBS2.Prelude.Plated
+import HBS2.Hash
+import HBS2.Base58
+import HBS2.Peer.Proto
+import HBS2.Data.Types.Refs (HashRef(..))
+import HBS2.Data.Types.SignedBox
+import HBS2.Net.Auth.Credentials
+import HBS2.Net.Messaging.Unix (UNIX)
+
+import Data.Hashable(Hashable(..))
+import Codec.Serialise
+import Data.ByteString.Lazy (ByteString)
+import Data.Word (Word64)
+import System.Random
+
+newtype Actor e =
+  Actor { fromActor :: PubKey 'Sign (Encryption e) }
+  deriving stock (Generic)
+
+deriving stock instance Eq (PubKey 'Sign (Encryption e)) => Eq (Actor e)
+deriving newtype instance Hashable (PubKey 'Sign (Encryption e)) => Hashable (Actor e)
+
+instance Pretty (AsBase58 (PubKey 'Sign (Encryption e))) => Pretty (Actor e) where
+  pretty (Actor a) = pretty (AsBase58 a)
+
+type Account e = PubKey 'Sign (Encryption e)
+
+newtype Amount = Amount Integer
+                deriving stock (Eq,Show,Ord,Data,Generic)
+                deriving newtype (Read,Enum,Num,Integral,Real,Pretty)
+
+newtype DAppState = DAppState { fromDAppState :: HashRef }
+                deriving stock (Eq,Show,Ord,Data,Generic)
+                deriving newtype (Hashable,Pretty)
+
+instance Hashed HbSync DAppState where
+  hashObject (DAppState (HashRef h)) = h
+
+data EmitTx e = EmitTx (Account e) Amount Word64
+                deriving stock (Generic)
+
+data MoveTx e = MoveTx (Account e) (Account e) Amount Word64
+                deriving stock (Generic)
+
+data QBLFDemoToken e =
+    Emit (SignedBox (EmitTx e) e)  --  proof: owner's  key
+  | Move (SignedBox (MoveTx e) e)  --  proof: wallet's key
+  deriving stock (Generic)
+
+instance ForRefChans e => Serialise (Actor e)
+
+instance Serialise DAppState
+
+instance Serialise Amount
+
+instance Serialise (PubKey 'Sign (Encryption e)) => Serialise (EmitTx e)
+
+instance Serialise (PubKey 'Sign (Encryption e)) => Serialise (MoveTx e)
+
+instance (Serialise (Account e), ForRefChans e) => Serialise (QBLFDemoToken e)
+
+type ForQBLFDemoToken e = ( Eq (PubKey 'Sign (Encryption e))
+                          , Eq (Signature (Encryption e))
+                          , Pretty (AsBase58 (PubKey 'Sign (Encryption e)))
+                          , ForSignedBox e
+                          , FromStringMaybe (PubKey 'Sign (Encryption e))
+                          , Serialise (PubKey 'Sign (Encryption e))
+                          , Serialise (Signature (Encryption e))
+                          , Hashable (PubKey 'Sign (Encryption e))
+                          )
+
+deriving stock instance (ForQBLFDemoToken e) => Eq (QBLFDemoToken e)
+
+instance ForQBLFDemoToken e => Hashable (QBLFDemoToken e) where
+  hashWithSalt salt = \case
+    Emit box  -> hashWithSalt salt box
+    Move box  -> hashWithSalt salt box
+
+newtype QBLFDemoTran e =
+  QBLFDemoTran (SignedBox (QBLFDemoToken e) e)
+  deriving stock Generic
+
+instance ForRefChans e => Serialise (QBLFDemoTran e)
+
+deriving newtype instance
+  (Eq (PubKey 'Sign (Encryption e)), Eq (Signature (Encryption e)))
+  => Eq (QBLFDemoTran e)
+
+deriving newtype instance
+  (Eq (Signature (Encryption e)), ForRefChans e)
+    => Hashable (QBLFDemoTran e)
+
+instance Serialise (QBLFDemoTran UNIX) => HasProtocol UNIX (QBLFDemoTran UNIX) where
+  type instance ProtocolId (QBLFDemoTran UNIX) = 0xFFFF0001
+  type instance Encoded UNIX = ByteString
+  decode = either (const Nothing) Just . deserialiseOrFail
+  encode = serialise
+
+makeEmitTx :: forall e m . ( MonadIO m
+                           , ForRefChans e
+                           , Signatures (Encryption e)
+                           )
+           => PubKey 'Sign (Encryption e)
+           -> PrivKey 'Sign (Encryption e)
+           -> Account e
+           -> Amount
+           -> m (QBLFDemoToken e)
+
+makeEmitTx pk sk acc amount = do
+  nonce <- randomIO
+  let box = makeSignedBox @e pk sk (EmitTx @e acc amount nonce)
+  pure (Emit @e box)
+
+makeMoveTx :: forall e m . ( MonadIO m
+                           , ForRefChans e
+                           , Signatures (Encryption e)
+                           )
+           => PubKey 'Sign (Encryption e)  -- from pk
+           -> PrivKey 'Sign (Encryption e) -- from sk
+           -> Account e
+           -> Amount                       -- amount
+           -> m (QBLFDemoToken e)
+
+makeMoveTx pk sk acc amount = do
+  nonce <- randomIO
+  let box = makeSignedBox @e pk sk (MoveTx @e pk acc amount nonce)
+  pure (Move @e box)
+
--- a/examples/refchan-qblf/lib/RefChanQBLF/App.hs
+++ b/examples/refchan-qblf/lib/RefChanQBLF/App.hs
@ -1,182 +0,0 @@
-module RefChanQBLF.App where
-
-import Codec.Serialise
-import Control.Monad.Cont
-import Control.Monad.Trans.Maybe
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy qualified as LBS
-import Data.Cache qualified as Cache
-import Data.HashSet qualified as HashSet
-import HBS2.Actors.Peer
-import HBS2.Actors.Peer.Types ()
-import HBS2.Clock
-import HBS2.Data.Types.Refs
-import HBS2.Data.Types.SignedBox
-import HBS2.Defaults
-import HBS2.Hash
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Messaging.Unix
-import HBS2.Net.Proto.QBLF
-import HBS2.Net.Proto.Service
-import HBS2.OrDie
-import HBS2.Peer.Proto.RefChan
-import HBS2.Prelude
-import HBS2.Storage.Simple
-import HBS2.System.Logger.Simple
-import Lens.Micro.Platform hiding ((.=))
-import System.Directory
-
-import RefChanQBLF.Common
-import RefChanQBLF.Impl
-import RefChanQBLF.RPCServer
-import RefChanQBLF.Transactions
-
-data QBLFAppConf = QBLFAppConf
-    { qapActorKeyring :: FilePath
-    , qapRefchanID :: RefChanId L4Proto
-    , qapSocket :: FilePath
-    , qapAppSocket :: FilePath
-    , qapDefState :: Maybe (Hash HbSync)
-    , qapStateRef :: MyRefKey
-    }
-
-withSimpleAnyStorage :: FilePath -> (AnyStorage -> IO r) -> IO r
-withSimpleAnyStorage storepath go = do
-    -- FIXME: fix-default-storage
-    xdg <- getXdgDirectory XdgData storepath <&> fromString
-    sto' <- simpleStorageInit @HbSync [StoragePrefix xdg]
-    flip runContT go do
-        replicateM 4 $ contAsync $ simpleStorageWorker sto'
-        pure $ AnyStorage sto'
-
-loadCreds :: FilePath -> IO (PeerCredentials 'HBS2Basic)
-loadCreds fpath = do
-    bs <- BS.readFile fpath
-    pure (parseCredentials @'HBS2Basic (AsCredFile bs)) `orDie` "bad keyring file"
-
-runQBLFApp :: (ForConsensus IO) => QBLFAppConf -> IO ()
-runQBLFApp QBLFAppConf {..} = withLogging do
-    creds <- loadCreds qapActorKeyring
-
-    whenM (doesFileExist qapSocket) $ removeFile qapSocket
-
-    -- FIXME: fix-hardcoded-timeout
-    fetches <- Cache.newCache (Just (toTimeSpec (TimeoutSec 30)))
-
-    flip runContT pure do
-        sto <- ContT $ withSimpleAnyStorage defStorePath
-
-        server <- newMessagingUnixOpts [MUNoFork] True 1.0 qapSocket
-        contAsync $ runMessagingUnix server
-
-        s0 <- lift $ readOrCreateStateRef qapDefState sto qapStateRef
-        debug $ "STATE0:" <+> pretty s0
-
-        let myEnv =
-                MyEnv
-                    { mySelf = fromString qapSocket -- Peer UNIX
-                    , myFab = (Fabriq server) -- Fabriq UNIX
-                    , myChan = qapRefchanID -- RefChanId UNIX
-                    , myRef = qapStateRef -- MyRefKey
-                    , mySto = sto -- AnyStorage
-                    , myCred = creds -- PeerCredentials 'HBS2Basic
-                    -- , myAppSoPath = appso                   -- TODO ?
-                    , myFetch = fetches -- Cache HashRef ()
-                    }
-
-        lift $ runMyAppT myEnv do
-            -- FIXME: timeout-hardcode
-            let w = realToFrac 5
-
-            -- получить голову
-            -- из головы получить акторов
-            headBlk <-
-                getRefChanHead @L4Proto sto (RefChanHeadKey qapRefchanID)
-                    `orDie` "can't read head block"
-
-            -- FIXME: use-actors-asap
-            let self = Actor $ view peerSignPk creds
-            let actors = fmap Actor $ HashSet.toList $ view refChanHeadAuthors headBlk
-            qblf <- qblfInit @ConsensusQBLF self actors (DAppState (HashRef s0)) w
-
-            flip runContT pure do
-                contAsync do
-                    pause @'Seconds 0.5
-                    qblfRun qblf
-
-                do
-                    srv <- liftIO $ newMessagingUnix True 1.0 qapAppSocket
-                    contAsync $ runMessagingUnix srv
-                    let qenv =
-                            QRPCEnv
-                                { qrpcenvQConsensus = qblf
-                                , qrpcenvRefchanId = qapRefchanID
-                                , qrpcenvFabriq = Fabriq srv
-                                , qrpcenvOwnPeer = fromString qapAppSocket
-                                }
-
-                    contAsync $ liftIO $ runQRPCT qenv do
-                        runProto @UNIX
-                            [ makeResponse (makeServer @QBLFAppRPC)
-                            ]
-
-                lift $ runProto [makeResponse (myProto myEnv qblf qapRefchanID)]
-  where
-    myProto
-        :: forall e m
-         . ( MonadIO m
-           , Request e (RefChanNotify e) m
-           , e ~ UNIX
-           )
-        => MyEnv
-        -> QBLF ConsensusQBLF
-        -> RefChanId e
-        -> RefChanNotify e
-        -> m ()
-
-    myProto _ _qblf _ (ActionRequest {}) = do
-        pure ()
-    myProto env qblf _chan (Notify _ msg) = do
-        void $ runMaybeT do
-            (_, wrapped) <- MaybeT $ pure $ unboxSignedBox0 msg
-            qbmess <-
-                MaybeT $
-                    pure $
-                        deserialiseOrFail @(QBLFMessage ConsensusQBLF) (LBS.fromStrict wrapped)
-                            & either (const Nothing) Just
-
-            states <- case qbmess of
-                QBLFMsgAnn _ (QBLFAnnounce s0 s1) -> do
-                    pure [s0, s1]
-                QBLFMsgHeartBeat _ _ s0 _ -> do
-                    pure [s0]
-                _ -> do
-                    pure mempty
-
-            -- FIXME: full-download-guarantee
-            lift $ forM_ states (fetchMissed env)
-
-            qblfAcceptMessage qblf qbmess
-    -- debug $ "RefChanQBLFMain(3)" <+> "got message" <+> pretty (AsBase58 chan) <+> pretty coco
-
-    readOrCreateStateRef :: Maybe (Hash HbSync) -> AnyStorage -> MyRefKey -> IO (Hash HbSync)
-    readOrCreateStateRef mbDs sto ref = do
-        debug $ "MyRef:" <+> pretty (hashObject @HbSync ref)
-        fix \spin -> do
-            mbref <- readStateHashMay sto ref
-            case mbref of
-                Nothing -> do
-                    debug "STATE is empty"
-                    mbDs & maybe none \ds -> do
-                        debug $ "UPDATE REF" <+> pretty (hashObject @HbSync ref) <+> pretty (HashRef ds)
-                        updateRef sto ref ds
-
-                    pause @'Seconds 0.25
-
-                    spin
-                Just val -> do
-                    pure val
-
-readStateHashMay :: AnyStorage -> MyRefKey -> IO (Maybe (Hash HbSync))
-readStateHashMay sto ref =
-    getRef @_ @HbSync sto ref
--- a/examples/refchan-qblf/lib/RefChanQBLF/CLI.hs
+++ b/examples/refchan-qblf/lib/RefChanQBLF/CLI.hs
@ -1,214 +0,0 @@
-module RefChanQBLF.CLI where
-
-import HBS2.Actors.Peer
-import HBS2.Actors.Peer.Types ()
-import HBS2.Base58
-import HBS2.Clock
-import HBS2.Data.Types.Refs
-import HBS2.Data.Types.SignedBox
-import HBS2.Defaults
-import HBS2.Hash
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Messaging.Unix
-import HBS2.Net.Proto.Service
-import HBS2.OrDie
-import HBS2.Peer.Proto.AnyRef
-import HBS2.Peer.Proto.RefChan
-import HBS2.Prelude
-import HBS2.Storage.Simple
-import HBS2.System.Logger.Simple
-
-import Codec.Serialise
-import Control.Arrow hiding ((<+>))
-import Control.Monad.Cont
-import Control.Monad.Except
-import Control.Monad.Reader
-import Data.ByteString qualified as BS
-import Data.ByteString.Char8 qualified as BS8
-import Data.ByteString.Lazy qualified as LBS
-import Data.Config.Suckless
-import Data.HashMap.Strict qualified as HashMap
-import Data.String.Conversions (cs)
-import Lens.Micro.Platform hiding ((.=))
-import Options.Applicative hiding (info)
-import Options.Applicative qualified as O
-import System.Directory
-import System.Exit qualified as Exit
-import UnliftIO
-
-import RefChanQBLF.App
-import RefChanQBLF.Common
-import RefChanQBLF.Impl
-import RefChanQBLF.RPCServer
-import RefChanQBLF.Transactions
-
-
-type Config = [Syntax C]
-
-main :: IO ()
-main = join . customExecParser (prefs showHelpOnError) $
-  O.info (helper <*> globalOptions)
-  (  fullDesc
-  <> header "refchan-qblf-worker"
-  <> progDesc "for test and demo purposed"
-  )
-  where
-
-    globalOptions = applyConfig <$> commonOpts <*> cli
-
-    applyConfig :: Maybe FilePath -> (Config -> IO ()) -> IO ()
-    applyConfig config m = do
-      maybe1 config (m mempty) $ \conf -> do
-        top <- readFile conf <&> parseTop <&> either (pure mempty) id
-        m top
-
-    commonOpts = optional $ strOption (long "config" <> short 'c' <> help "Config file")
-
-    cli = hsubparser (  command "run" (O.info pRun (progDesc "run qblf servant" ) )
-                     <> command "gen" (O.info pGen (progDesc "generate transcation") )
-                     <> command "post" (O.info pPostTx (progDesc "post transaction") )
-                     <> command "check" (O.info pCheckTx (progDesc "check transaction") )
-                     <> command "balances" (O.info pBalances (progDesc "show balances") )
-                     )
-
-    pGen = hsubparser
-           (   command "tx-emit" ( O.info pGenEmit (progDesc "generate emit") )
-            <> command "tx-move" ( O.info pGenMove (progDesc "generate move") )
-           )
-
-    pGenEmit = do
-      kr    <- strOption   ( long "keyring"  <> short 'k' <> help "keyring file" )
-      amnt <- option @Amount auto ( long "amount" <> short 'n' <> help "amount" )
-      dest <- strArgument ( metavar "ADDRESS" )
-      pure $ const $ silently do
-        sc <- BS.readFile kr
-        creds <- pure (parseCredentials @'HBS2Basic (AsCredFile sc)) `orDie` "bad keyring file"
-        let pk = view peerSignPk creds
-        let sk = view peerSignSk creds
-        acc <- pure (fromStringMay @(RefChanId L4Proto) dest) `orDie` "bad account address"
-        tx <- makeEmitDemoToken @_ @L4Proto pk sk acc amnt
-        LBS.putStr $ serialise tx
-
-    pGenMove = do
-      kr    <- strOption   ( long "wallet"  <> short 'w' <> help "wallet (keyring) file" )
-      amnt <- option @Amount auto ( long "amount" <> short 'n' <> help "amount" )
-      dest <- strArgument ( metavar "ADDRESS" )
-      pure $ const $ silently do
-        sc <- BS.readFile kr
-        creds <- pure (parseCredentials @'HBS2Basic (AsCredFile sc)) `orDie` "bad keyring file"
-        let pk = view peerSignPk creds
-        let sk = view peerSignSk creds
-        acc <- pure (fromStringMay @(RefChanId L4Proto) dest) `orDie` "bad account address"
-        tx <- makeMoveDemoToken @_ @L4Proto pk sk acc amnt
-        LBS.putStr $ serialise tx
-
-    pCheckTx = do
-      pure $ const do
-        tx <- either (Exit.die . ("QBLFDemoToken deserialise error: " <>) . show) pure
-              . deserialiseOrFail @(QBLFDemoToken 'HBS2Basic)
-            =<< LBS.getContents
-
-        case tx of
-          Emit box ->
-            BS8.hPutStrLn stderr . cs . show . pretty . first AsBase58
-                =<< pure (unboxSignedBox0 box) `orDie` "bad emit tx"
-
-          Move box ->
-            BS8.hPutStrLn stderr . cs . show . pretty . first AsBase58
-                =<< pure (unboxSignedBox0 box) `orDie` "bad move tx"
-
-        pure ()
-
-pBalances :: Parser (Config -> IO ())
-pBalances = do
-    mstateref <- optional do
-        option (fromStringP @HashRef "qblf state hash")
-            (long "state-hash" <> metavar "HASH-REF")
-    pure \syn -> withLogging do
-        bal <- flip runContT pure do
-            sto <- ContT $ withSimpleAnyStorage defStorePath
-            lift do
-                stateHashRef :: HashRef
-                    <- mstateref & flip maybe pure do
-                      either Exit.die pure =<< runExceptT do
-                        stref <- (flip runReader syn $ cfgValue @StateRefOpt @(Maybe String))
-                            & orE "state-ref key not found in config"
-                            <&> fromStringMay
-                            & orEM "state-ref key parse error"
-                        HashRef <$> do
-                          liftIO (readStateHashMay sto stref)
-                            & orEM "State is not created yed"
-                flip runReaderT sto $ do
-                    debug $ "calculating balances for" <+> pretty stateHashRef
-                    balances stateHashRef
-
-        forM_ (HashMap.toList bal) $ \(acc, qty) -> do
-            liftIO $ print $ pretty (AsBase58 acc) <+> pretty qty
-
-fromStringP :: (FromStringMaybe a) => String -> ReadM a
-fromStringP msg = eitherReader $
-      maybe (Left ("Can not parse " <> msg)) Right . fromStringMay . cs
-
-refchanP :: ReadM (RefChanId L4Proto)
-refchanP = fromStringP "refchan id"
-
-pPostTx :: Parser (Config -> IO ())
-pPostTx = do
-    pure \syn -> withLogging do
-        debug $ "runQBLFApp" <+> pretty syn
-
-        appsopath <- maybe (Exit.die "app-socket path not found in config") pure do
-            flip runReader syn do
-                cfgValue @AppSocketOpt @(Maybe String)
-
-        tx <- either (Exit.die . ("QBLFDemoToken deserialise error: " <>) . show) pure
-              . deserialiseOrFail @(QBLFDemoToken 'HBS2Basic)
-            =<< LBS.getContents
-
-        messagingUnix :: MessagingUnix <- newMessagingUnix False 1.0 appsopath
-        ep <- makeServiceCaller @QBLFAppRPC @UNIX (msgUnixSelf messagingUnix)
-        flip runContT pure do
-          contAsync $ runMessagingUnix messagingUnix
-          contAsync $ runReaderT (runServiceClient ep) messagingUnix
-          lift do
-
-            maybe (Exit.die "RPC server is not available") pure
-                =<< callRpcWaitMay @PingRPC (TimeoutSec 0.42) ep ()
-
-            r :: Text
-                <- callRpcWaitMay @PostTxRPC (TimeoutSec 3) ep tx
-                & peelMWith Exit.die do
-                      orE "RPC server timeout" >>> leftEM show >>> leftEM show
-
-            LBS.putStr . cs $ r
-
-pRun :: Parser (Config -> IO ())
-pRun = pure \conf -> withLogging do
-    debug $ "runQBLFApp" <+> pretty conf
-    runQBLFApp =<< (either Exit.die pure . parseQBLFAppConf) conf
-
-parseQBLFAppConf :: Config -> Either String QBLFAppConf
-parseQBLFAppConf = runReaderT do
-    qapActorKeyring <- cfgValue @ActorOpt @(Maybe String)
-        & orEM "actor's key not set"
-
-    qapRefchanID <- cfgValue @RefChanOpt @(Maybe String)
-        & orEM "refchan not set"
-        <&> fromStringMay @(RefChanId L4Proto)
-        & orEM "invalid REFCHAN value in config"
-
-    qapSocket <- cfgValue @SocketOpt @(Maybe String)
-        & orEM "socket not set"
-
-    qapAppSocket <- cfgValue @AppSocketOpt @(Maybe String)
-        & orEM "app socket not set"
-
-    qapDefState <- cfgValue @DefStateOpt @(Maybe String)
-        <&> (>>= fromStringMay)
-
-    qapStateRef <- cfgValue @StateRefOpt @(Maybe String)
-        & orEM "state-ref key not found in config"
-        <&> fromStringMay
-        & orEM "state-ref key parse error"
-
-    pure QBLFAppConf {..}
--- a/examples/refchan-qblf/lib/RefChanQBLF/Common.hs
+++ b/examples/refchan-qblf/lib/RefChanQBLF/Common.hs
@ -1,58 +0,0 @@
-module RefChanQBLF.Common where
-
-import HBS2.Data.Types
-import HBS2.Peer.RPC.Client.Unix ()
-
-import Control.Monad.Cont
-import Control.Monad.Except
-import Data.Bool
-import Data.Text (Text)
-import GHC.Generics (Generic)
-import Prettyprinter
-import UnliftIO
-
-data MyError
-    = DeserializationError
-    | SignatureError
-    | SignerDoesNotMatchRefchan Text Text
-    | TxUnsupported
-    | SomeOtherError
-    deriving stock (Generic, Show)
-instance Serialise MyError
-instance Exception MyError
-
-whenM :: (Monad m) => m Bool -> m () -> m ()
-whenM mb mu = bool (pure ()) mu =<< mb
-
-contAsync :: (MonadUnliftIO m) => m a -> ContT r m ()
-contAsync = (link =<<) . ContT . withAsync
-
-orE :: (MonadError e m) => e -> Maybe b -> m b
-orE msg = maybe (throwError msg) pure
-
-orEM :: (MonadError e m) => e -> m (Maybe b) -> m b
-orEM msg mb = orE msg =<< mb
-
-leftE :: (MonadError e m) => (a -> e) -> Either a b -> m b
-leftE toe = either (throwError . toe) pure
-
-leftEM :: (MonadError e m) => (a -> e) -> m (Either a b) -> m b
-leftEM toe meab = leftE toe =<< meab
-
-peelMWith
-    :: (Monad m)
-    => (e -> m a)
-    -> (b -> Either e a)
-    -> m b
-    -> m a
-peelMWith ema bea mb = either ema pure . bea =<< mb
-
-newtype PrettyEither e a = PrettyEither (Either e a)
-
-instance
-    (Pretty e, Pretty a)
-    => Pretty (PrettyEither e a)
-    where
-    pretty (PrettyEither ea) = case ea of
-        Left e -> "Left" <+> pretty e
-        Right a -> "Right" <+> pretty a
--- a/examples/refchan-qblf/lib/RefChanQBLF/Impl.hs
+++ b/examples/refchan-qblf/lib/RefChanQBLF/Impl.hs
@ -1,476 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# Language TemplateHaskell #-}
-{-# Language UndecidableInstances #-}
-{-# Language AllowAmbiguousTypes #-}
-module RefChanQBLF.Impl where
-
-import HBS2.Actors.Peer
-import HBS2.Actors.Peer.Types()
-import HBS2.Base58
-import HBS2.Data.Bundle
-import HBS2.Data.Detect
-import HBS2.Data.Types.Refs
-import HBS2.Data.Types.SignedBox
-import HBS2.Hash
-import HBS2.Merkle
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Messaging.Unix
-import HBS2.Net.Proto.QBLF
-import HBS2.Peer.Proto.AnyRef
-import HBS2.Peer.Proto.RefChan
-import HBS2.Prelude
-import HBS2.Storage.Simple
-import HBS2.System.Logger.Simple
-
-import RefChanQBLF.Common
-import RefChanQBLF.Transactions
-import Data.Config.Suckless
-import Control.Monad.Except
-import Control.Monad.Trans.Maybe
-import Codec.Serialise
-import Control.Monad.Reader
-import Data.ByteString.Lazy qualified as LBS
-import Data.List qualified as List
-import Lens.Micro.Platform hiding ((.=))
-import Options.Applicative hiding (info)
-import Data.HashSet qualified as HashSet
-import Data.HashMap.Strict (HashMap)
-import Data.HashMap.Strict qualified as HashMap
-import Data.Maybe
-import Data.Word
-import System.Random
-import UnliftIO
-
-import Data.Cache (Cache)
-import Data.Cache qualified as Cache
-
-{- HLINT ignore "Use newtype instead of data" -}
-
-- TODO: config
--  сделать конфиг, а то слишком много уже параметров в CLI
-
-data AppSocketOpt
-data RefChanOpt
-data SocketOpt
-data ActorOpt
-data DefStateOpt
-data StateRefOpt
-
-data QBLFRefKey
-type MyRefKey = AnyRefKey QBLFRefKey 'HBS2Basic
-
-instance HasCfgKey AppSocketOpt (Maybe String) where
-  key = "app-socket"
-
-instance HasCfgKey RefChanOpt (Maybe String)  where
-  key = "refchan"
-
-instance HasCfgKey SocketOpt (Maybe String)  where
-  key = "socket"
-
-instance HasCfgKey ActorOpt (Maybe String)  where
-  key = "actor"
-
-instance HasCfgKey DefStateOpt (Maybe String) where
-  key = "default-state"
-
-instance HasCfgKey StateRefOpt (Maybe String) where
-  key = "state-ref"
-
-class ToBalance s tx where
-  toBalance :: tx -> [(Account s, Amount)]
-
-tracePrefix :: SetLoggerEntry
-tracePrefix  = toStderr . logPrefix "[trace] "
-
-debugPrefix :: SetLoggerEntry
-debugPrefix  = toStderr . logPrefix "[debug] "
-
-errorPrefix :: SetLoggerEntry
-errorPrefix  = toStderr . logPrefix "[error] "
-
-warnPrefix :: SetLoggerEntry
-warnPrefix   = toStderr . logPrefix "[warn] "
-
-noticePrefix :: SetLoggerEntry
-noticePrefix = toStderr . logPrefix "[notice] "
-
-infoPrefix :: SetLoggerEntry
-infoPrefix = toStdout . logPrefix ""
-
-silently :: MonadIO m => m a -> m ()
-silently m = do
-  setLoggingOff @DEBUG
-  setLoggingOff @INFO
-  setLoggingOff @ERROR
-  setLoggingOff @WARN
-  setLoggingOff @NOTICE
-  void m
-
-withLogging :: MonadIO m => m a -> m ()
-withLogging m = do
-
-  -- setLogging @TRACE  tracePrefix
-  setLogging @DEBUG  debugPrefix
-  setLogging @INFO   infoPrefix
-  setLogging @ERROR  errorPrefix
-  setLogging @WARN   warnPrefix
-  setLogging @NOTICE noticePrefix
-
-  m
-
-  setLoggingOff @DEBUG
-  setLoggingOff @INFO
-  setLoggingOff @ERROR
-  setLoggingOff @WARN
-  setLoggingOff @NOTICE
-
-data MyEnv =
-  MyEnv
-  { mySelf  :: Peer UNIX
-  , myFab   :: Fabriq UNIX
-  , myChan  :: RefChanId UNIX
-  , myRef   :: MyRefKey
-  , mySto   :: AnyStorage
-  , myCred  :: PeerCredentials 'HBS2Basic
-  -- , myHttpPort :: Int
-  , myFetch :: Cache HashRef ()
-  }
-
-newtype MyAppT m a = MyAppT { fromQAppT :: ReaderT MyEnv m a }
-                  deriving newtype ( Functor
-                                   , Applicative
-                                   , Monad
-                                   , MonadIO
-                                   , MonadUnliftIO
-                                   , MonadReader MyEnv
-                                   , MonadTrans
-                                   )
-
-runMyAppT :: (MonadIO m, PeerMessaging UNIX) => MyEnv -> MyAppT m a -> m a
-runMyAppT env m = runReaderT (fromQAppT m) env
-
-instance Monad m => HasFabriq UNIX (MyAppT m) where
-  getFabriq = asks myFab
-
-instance Monad m => HasOwnPeer UNIX (MyAppT m) where
-  ownPeer = asks mySelf
-
-instance Monad m => HasStorage (MyAppT m) where
-  getStorage = asks mySto
-
-data ConsensusQBLF
-
-data StateQBLF = StateQBLF { fromStateQBLF :: HashRef }
-
-check :: MonadIO m => MyError -> Either e a -> ExceptT MyError m a
-check w  = \case
-  Right x -> ExceptT $ pure (Right x)
-  Left{}  -> ExceptT $ pure (Left w)
-
-fiasco :: MonadIO m => MyError -> ExceptT MyError m a
-fiasco x = ExceptT $ pure $ Left x
-
-ok :: MonadIO m => a -> ExceptT MyError m a
-ok x = ExceptT $ pure $ Right x
-
-
-type ForConsensus m = (MonadIO m, Serialise (QBLFMessage ConsensusQBLF))
-
-instance Serialise (QBLFMerge ConsensusQBLF)
-instance Serialise (QBLFMessage ConsensusQBLF)
-instance Serialise (QBLFAnnounce ConsensusQBLF)
-instance Serialise (QBLFCommit ConsensusQBLF)
-
-instance Monad m => HasTimeLimits UNIX (RefChanNotify UNIX) (MyAppT m) where
-  tryLockForPeriod _ _ = pure True
-
-instance (ForConsensus m, MonadUnliftIO m)  => IsQBLF ConsensusQBLF (MyAppT m) where
-  type QBLFActor ConsensusQBLF = Actor 'HBS2Basic
-  type QBLFTransaction ConsensusQBLF = QBLFDemoToken 'HBS2Basic
-  type QBLFState ConsensusQBLF = DAppState
-
-  qblfMoveForward _ s1 = do
-    env <- ask
-    fetchMissed env s1
-    pure True
-
-  qblfNewState (DAppState h0) txs = do
-    sto <- asks mySto
-    chan <- asks myChan
-    self <- asks mySelf
-    creds <- asks myCred
-    let sk = view peerSignSk creds
-    let pk = view peerSignPk creds
-
-    -- основная проблема в том, что мы пересортировываем весь state
-    -- однако, если считать его уже отсортированным, то, может быть,
-    -- все будет не так уж плохо.
-    -- так-то мы можем вообще его на диске держать
-
-    root <- if List.null txs then do
-              pure h0
-            else do
-              hashes <- liftIO $ mapM (putBlock sto . serialise) txs <&> catMaybes
-
-              current <- readLogThrow (getBlock sto) h0
-
-              let new = HashSet.fromList ( current <> fmap HashRef hashes )
-
-              let pt = toPTree (MaxSize 256) (MaxNum 256) (HashSet.toList new)
-
-              -- пробуем разослать бандлы с транзакциями
-              runMaybeT do
-                ref <- MaybeT $ createBundle sto (fmap HashRef hashes)
-                let refval = makeBundleRefValue @'HBS2Basic pk sk (BundleRefSimple ref)
-                r <- MaybeT $ liftIO $ putBlock sto (serialise refval)
-                lift $ request self (ActionRequest @UNIX chan (RefChanAnnounceBlock (HashRef r)))
-
-              r <- makeMerkle 0 pt $ \(hx,_,bs) -> do
-                _th <- liftIO (enqueueBlock sto bs)
-                debug $ "WRITE TX" <+> pretty hx
-
-              request self (ActionRequest @UNIX chan (RefChanAnnounceBlock (HashRef r)))
-
-              pure (HashRef r)
-
-    debug $ "PROPOSED NEW STATE:" <+> pretty root
-    pure $ DAppState root
-
-  qblfCommit s0 s1 = do
-    debug $ "COMMIT:" <+> pretty s0 <+> pretty s1
-    sto <- asks mySto
-    _chan <- asks myChan
-    ref  <- asks myRef
-
-    debug $ "UPDATING REF" <+> pretty ref <+> pretty s1
-    liftIO $ updateRef sto ref (fromHashRef (fromDAppState s1))
-    pure ()
-
-  qblfBroadCast msg = do
-      self <- asks mySelf
-      creds <- asks myCred
-      chan <- asks myChan
-
-      let sk = view peerSignSk creds
-      let pk = view peerSignPk creds
-      nonce <- randomIO @Word64 <&> serialise <&> LBS.toStrict
-      let box = makeSignedBox pk sk (LBS.toStrict (serialise msg) <> nonce)
-      let notify = Notify @UNIX chan box
-      request self notify
-
-      case msg of
-        QBLFMsgAnn _ (QBLFAnnounce _ _) -> do
-          -- TODO: maybe-announce-new-state-here
-          pure ()
-
-        _ -> none
-
-  -- TODO: optimize-qblf-merge
-  --   будет нормально работать до десятков/сотен тысяч транз,
-  --   а потом помрёт.
-  --   варианты:
-  --     1. перенести логику в БД
-  --     2. кэшировать всё, что можно
-  qblfMerge s0 s1 = do
-    chan <- asks myChan
-    _self <- asks mySelf
-
-    creds <- asks myCred
-    let _sk = view peerSignSk creds
-    let _pk = view peerSignPk creds
-
-    debug $ "MERGE. Proposed state:" <+> pretty s1
-
-    sto <- asks mySto
-    let readFn = liftIO . getBlock sto
-
-    tx1 <- mapM (readLogThrow readFn) (fmap fromDAppState s1) <&> mconcat
-    tx0 <- readLogThrow readFn (fromDAppState s0) <&> HashSet.fromList
-
-    let txNew = HashSet.fromList tx1 `HashSet.difference` tx0
-
-    if List.null txNew then do
-      pure s0
-    else do
-      debug $ "READ TXS" <+> pretty s1 <+> pretty (length tx1)
-
-      r <- forM tx1 $ \t -> runMaybeT do
-
-              -- игнорируем ранее добавленные транзакции
-              guard (not (HashSet.member t tx0))
-
-              bs <- MaybeT $ liftIO $ getBlock sto (fromHashRef t)
-
-              tx <- MaybeT $ pure $ deserialiseOrFail @(QBLFDemoToken 'HBS2Basic) bs & either (const Nothing) Just
-
-              case tx of
-                Emit box -> do
-                  (pk', e@(EmitTx a q _)) <- MaybeT $ pure $ unboxSignedBox0 @(EmitTx 'HBS2Basic) box
-                  guard ( chan == pk' )
-                  debug $ "VALID EMIT TRANSACTION" <+> pretty t <+> pretty (AsBase58 a) <+> pretty q
-                  pure ([(t,e)], mempty)
-
-                (Move box) -> do
-                  (_, m@(MoveTx _ _ qty _)) <- MaybeT $ pure $ unboxSignedBox0 @(MoveTx 'HBS2Basic) box
-
-                  guard (qty > 0)
-                  debug $ "MOVE TRANSACTION" <+> pretty t
-                  pure (mempty, [(t,m)])
-
-      let parsed = catMaybes r
-
-      let emits = foldMap (view _1) parsed
-
-      let moves = foldMap (view _2) parsed & List.sortOn fst
-
-      bal0 <- balances (fromDAppState s0)
-
-      -- баланс с учётом новых emit
-      let balE = foldMap (toBalance @'HBS2Basic. snd) emits
-                        & HashMap.fromListWith (+)
-                        & HashMap.unionWith (+) bal0
-
-      let moves' = updBalances @L4Proto balE moves
-
-      let merged = fmap fst emits <> fmap fst moves'
-
-      let pt = toPTree (MaxSize 256) (MaxNum 256) (HashSet.toList (tx0 <> HashSet.fromList merged))
-
-      root <- makeMerkle 0 pt $ \(_,_,bs) -> do
-                void $ liftIO (putBlock sto bs)
-
-      let new = DAppState (HashRef root)
-
-      -- FIXME: garbage-collect-discarded-states
-
-      async $ void $ balances (fromDAppState new)
-      debug $ "MERGED" <+> pretty new
-
-      pure new
-
-
-instance HasStorage (ReaderT AnyStorage IO) where
-  getStorage = ask
-
-
-
-instance ToBalance e (EmitTx e) where
-  toBalance (EmitTx a qty _) = [(a, qty)]
-
-instance ToBalance e (MoveTx e) where
-  toBalance (MoveTx a1 a2 qty _) = [(a1, -qty), (a2, qty)]
-
-balances :: forall e s m . ( e ~ L4Proto
-                           , MonadIO m
-                           , HasStorage m
-                           -- , FromStringMaybe (PubKey 'Sign s)
-                           , s ~ Encryption e
-                           , ToBalance s (EmitTx s)
-                           , ToBalance s (MoveTx s)
-                           , Pretty (AsBase58 (PubKey 'Sign s))
-                           )
-         => HashRef
-         -> m (HashMap (Account s) Amount)
-
-balances root = do
-  sto <- getStorage
-
-  let pk = SomeRefKey (HashRef "6ChGmfYkwM6646oKkj8r8MAjdViTsdtZSi6tgqk3tbh", root)
-
-  cached <- runMaybeT do
-    rval <- MaybeT $ liftIO $ getRef sto pk
-    val  <- MaybeT $ liftIO $ getBlock sto rval
-    MaybeT $ deserialiseOrFail @(HashMap (Account s) Amount) val
-          & either (const $ pure Nothing) (pure . Just)
-
-  case cached of
-    Just bal -> pure bal
-    Nothing -> do
-
-      txs <- readLogThrow (liftIO . getBlock sto) root
-
-      r <- forM txs $ \h -> runMaybeT do
-        blk <- MaybeT $ liftIO $ getBlock sto (fromHashRef h)
-        tx  <- MaybeT $ pure $ deserialiseOrFail @(QBLFDemoToken s) blk & either (const Nothing) Just
-
-        case tx of
-          Emit box -> do
-            (_, emit) <- MaybeT $ pure $  unboxSignedBox0 @(EmitTx s) box
-            pure $ toBalance @s emit
-
-          Move box -> do
-            (_, move) <- MaybeT $ pure $  unboxSignedBox0 @(MoveTx s) box
-            pure $ toBalance @s move
-
-      let val = catMaybes r & mconcat & HashMap.fromListWith (+)
-
-      runMaybeT do
-        checkComplete sto root >>= guard
-        rv <- MaybeT $ liftIO $ putBlock sto (serialise val)
-        liftIO $ updateRef sto pk rv
-
-      pure val
-
-
-- TODO: optimize-upd-balances
--  можно сгруппировать по аккаунтам
--  и проверять только те транзакции, которые относятся
--  к связанной (транзакциями) группе аккаунтов.
--  то есть, разбить на кластеры, у которых отсутствуют пересечения по
--  аккаунтам и проверять независимо и параллельно, например
--  причем, прямо этой функцией
--
-- updBalances :: HashMap (Account L4Proto) Amount
--              -> [(tx, b)]
--              -> [(tx, b)]
-
-updBalances :: forall e s a tx . (ForRefChans e, ToBalance s tx, s ~ Encryption e)
-            => HashMap (Account s) Amount
-            -> [(a, tx)]
-            -> [(a, tx)]
-
-updBalances = go
-  where
-    go _bal [] = empty
-
-    go bal (t:rest) =
-
-      if good then
-        t : go nb rest
-      else
-        go bal rest
-
-      where
-        nb = HashMap.unionWith (+) bal (HashMap.fromList (toBalance @s (snd t)))
-        good = HashMap.filter (<0) nb & HashMap.null
-
-
-fetchMissed :: forall e w m . ( MonadIO m
-                              , Request e (RefChanNotify e) m
-                              , e ~ UNIX
-                              , w ~ ConsensusQBLF
-                              )
-            => MyEnv
-            -> QBLFState w
-            -> m ()
-
-fetchMissed env s = do
-  let tube = mySelf env
-  let chan = myChan  env
-  let cache = myFetch env
-  let sto = mySto env
-
-  let href = fromDAppState s
-
-  here <- liftIO $ hasBlock sto (fromHashRef href) <&> isJust
-  wip <- liftIO $ Cache.lookup cache href <&> isJust
-
-  when here do
-    liftIO $ Cache.delete cache href
-
-  unless (here || wip) do
-    debug $ "We might be need to fetch" <+> pretty s
-    liftIO $ Cache.insert cache href ()
-    request @UNIX tube (ActionRequest @UNIX chan (RefChanFetch (fromDAppState s)))
-
--- a/examples/refchan-qblf/lib/RefChanQBLF/RPCServer.hs
+++ b/examples/refchan-qblf/lib/RefChanQBLF/RPCServer.hs
@ -1,141 +0,0 @@
-{-# LANGUAGE StrictData #-}
-
-module RefChanQBLF.RPCServer where
-
-import HBS2.Actors.Peer
-import HBS2.Base58
-import HBS2.Data.Types.SignedBox
-import HBS2.Hash
-import HBS2.Net.Messaging.Unix
-import HBS2.Net.Proto.QBLF
-import HBS2.Net.Proto.Service
-import HBS2.System.Logger.Simple
-
-import Codec.Serialise
-import Control.Monad
-import Control.Monad.Except
-import Control.Monad.Reader
-import Data.ByteString.Lazy (ByteString)
-import Data.Function
-import Data.String.Conversions (cs)
-import Data.Text (Text)
-import Data.Text qualified as T
-import GHC.Generics (Generic)
-import Prettyprinter
-import UnliftIO
-
-import RefChanQBLF.Common
-import RefChanQBLF.Impl
-import RefChanQBLF.Transactions
-
-data PingRPC
-data PostTxRPC
-
-type QBLFAppRPC =
-    '[ PingRPC
-     , PostTxRPC
-     ]
-
-instance HasProtocol UNIX (ServiceProto QBLFAppRPC UNIX) where
-    type ProtocolId (ServiceProto QBLFAppRPC UNIX) = 0x0B1F0B1F
-    type Encoded UNIX = ByteString
-    decode = either (const Nothing) Just . deserialiseOrFail
-    encode = serialise
-
-type instance Input PingRPC = ()
-type instance Output PingRPC = Text
-
-type instance Input PostTxRPC = QBLFDemoToken 'HBS2Basic
-type instance Output PostTxRPC = Either RPCServerError (Either MyError Text)
-
-data QRPCEnv = QRPCEnv
-    { qrpcenvQConsensus :: QBLF ConsensusQBLF
-    , qrpcenvRefchanId :: PubKey 'Sign 'HBS2Basic
-    , qrpcenvFabriq :: Fabriq UNIX
-    , qrpcenvOwnPeer :: Peer UNIX
-    }
-
-newtype QRPCAppT m a = QRPCAppT {fromQRPCAppT :: ReaderT QRPCEnv m a}
-    deriving newtype
-        ( Functor
-        , Applicative
-        , Monad
-        , MonadIO
-        , MonadUnliftIO
-        , MonadReader QRPCEnv
-        , MonadTrans
-        )
-
-instance (Monad m) => HasFabriq UNIX (QRPCAppT m) where
-    getFabriq = asks qrpcenvFabriq
-
-instance (Monad m) => HasOwnPeer UNIX (QRPCAppT m) where
-    ownPeer = asks qrpcenvOwnPeer
-
-instance (Monad m) => HasQBLFEnv (ResponseM UNIX (QRPCAppT m)) where
-    getQBLFEnv = lift ask
-
-runQRPCT
-    :: (MonadIO m, PeerMessaging UNIX)
-    => QRPCEnv
-    -> QRPCAppT m a
-    -> m a
-runQRPCT env m = runReaderT (fromQRPCAppT m) env
-
-class HasQBLFEnv m where
-    getQBLFEnv :: m QRPCEnv
-
-data RPCServerError = RPCServerError Text
-    deriving (Generic, Show)
-instance Serialise RPCServerError
-
-wrapErrors :: (MonadUnliftIO m) => m a -> m (Either RPCServerError a)
-wrapErrors =
-    UnliftIO.tryAny >=> flip either (pure . Right) \e -> do
-        debug $ "RPC ServerError" <+> viaShow e
-        pure $ (Left . RPCServerError . T.pack . show) e
-
-instance (MonadIO m, HasQBLFEnv m) => HandleMethod m PingRPC where
-    handleMethod _ = do
-        debug $ "RPC PING"
-        pure "pong"
-
-instance
-    ( MonadUnliftIO m
-    , HasQBLFEnv m
-    )
-    => HandleMethod m PostTxRPC
-    where
-    handleMethod tok = wrapErrors $ UnliftIO.try do
-        let txhash = (hashObject @HbSync . serialise) tok
-            ptok = pretty tok
-
-        debug $ "RPC got post tx" <+> pretty txhash <+> ptok
-
-        refchanId <- qrpcenvRefchanId <$> getQBLFEnv
-        validateQBLFToken refchanId tok
-            & either throwIO pure
-
-        qblf <- qrpcenvQConsensus <$> getQBLFEnv
-        qblfEnqueue qblf tok
-
-        debug $ "TX ENQUEUED OK" <+> ptok
-        pure $ "Enqueued: " <> (cs . show) ptok
-
-validateQBLFToken
-    :: (MonadError MyError m)
-    => PubKey 'Sign 'HBS2Basic
-    -> QBLFDemoToken 'HBS2Basic
-    -> m ()
-validateQBLFToken chan = \case
-    Emit box -> do
-        (signer, _tx) <- orE SignatureError $ unboxSignedBox0 box
-        unless (signer == chan) do
-            throwError
-                ( SignerDoesNotMatchRefchan
-                    ((cs . show . pretty . AsBase58) signer)
-                    ((cs . show . pretty . AsBase58) chan)
-                )
-    Move box -> do
-        (_sign, _tx) <- orE SignatureError $ unboxSignedBox0 box
-        pure ()
--- a/examples/refchan-qblf/lib/RefChanQBLF/Transactions.hs
+++ b/examples/refchan-qblf/lib/RefChanQBLF/Transactions.hs
@ -1,199 +0,0 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
-{-# LANGUAGE TypeOperators #-}
-{-# LANGUAGE UndecidableInstances #-}
-
-module RefChanQBLF.Transactions where
-
-import Data.String.Conversions (cs)
-import HBS2.Base58
-import HBS2.Data.Types.Refs (HashRef (..))
-import HBS2.Data.Types.SignedBox
-import HBS2.Hash
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Messaging.Unix (UNIX)
-import HBS2.Peer.Proto
-import HBS2.Prelude.Plated
-
-import Codec.Serialise
-import Control.Arrow hiding ((<+>))
-import Data.ByteString.Lazy (ByteString)
-import Data.Hashable (Hashable (..))
-import Data.Word (Word64)
-import System.Random
-
-import RefChanQBLF.Common
-
-newtype Actor s = Actor {fromActor :: PubKey 'Sign s}
-    deriving stock (Generic)
-
-deriving stock instance (Eq (PubKey 'Sign s)) => Eq (Actor s)
-deriving newtype instance (Hashable (PubKey 'Sign s)) => Hashable (Actor s)
-
-instance (Pretty (AsBase58 (PubKey 'Sign s))) => Pretty (Actor s) where
-    pretty (Actor a) = pretty (AsBase58 a)
-
-type Account s = PubKey 'Sign s
-
-newtype Amount = Amount Integer
-    deriving stock (Eq, Show, Ord, Data, Generic)
-    deriving newtype (Read, Enum, Num, Integral, Real, Pretty)
-
-newtype DAppState = DAppState {fromDAppState :: HashRef}
-    deriving stock (Eq, Show, Ord, Data, Generic)
-    deriving newtype (Hashable, Pretty)
-
-instance Hashed HbSync DAppState where
-    hashObject (DAppState (HashRef h)) = h
-
-data EmitTx s = EmitTx (Account s) Amount Word64
-    deriving stock (Generic)
-
-instance (Pretty (AsBase58 (PubKey 'Sign s))) => Pretty (EmitTx s) where
-    pretty (EmitTx acc amount n) =
-        "Emit"
-            <+> "to:"
-            <> pretty (AsBase58 acc)
-                <+> "amount:"
-            <> pretty amount
-                <+> "nonce:"
-            <> pretty n
-
-data MoveTx s = MoveTx (Account s) (Account s) Amount Word64
-    deriving stock (Generic)
-
-instance (Pretty (AsBase58 (PubKey 'Sign s))) => Pretty (MoveTx s) where
-    pretty (MoveTx accfrom accto amount n) =
-        "Move"
-            <+> "from:"
-            <> pretty (AsBase58 accfrom)
-                <+> "to:"
-            <> pretty (AsBase58 accto)
-                <+> "amount:"
-            <> pretty amount
-                <+> "nonce:"
-            <> pretty n
-
-data QBLFDemoToken s
-    = Emit (SignedBox (EmitTx s) s) --  proof: owner's  key
-    | Move (SignedBox (MoveTx s) s) --  proof: wallet's key
-    deriving stock (Generic)
-
-instance
-    ( Pretty (AsBase58 (PubKey 'Sign s))
-    , Signatures s
-    , Eq (Signature s)
-    , FromStringMaybe (PubKey 'Sign s)
-    , Serialise (PubKey 'Sign s)
-    , Serialise (Signature s)
-    , Hashable (PubKey 'Sign s)
-    )
-    => Pretty (QBLFDemoToken s)
-    where
-    pretty = \case
-        Emit box -> pretty (WhiteSignedBox @s box)
-        Move box -> pretty (WhiteSignedBox @s box)
-
-newtype WhiteSignedBox s a = WhiteSignedBox (SignedBox a s)
-
-instance
-    ( Pretty (AsBase58 (PubKey 'Sign s))
-    , Pretty a
-    , Serialise a
-    )
-    => Pretty (WhiteSignedBox s a)
-    where
-    pretty (WhiteSignedBox (SignedBox pk bs _sign)) =
-        "SignedBox"
-            <+> "Hash:"
-            <+> pretty ((hashObject @HbSync . serialise) bs)
-            <+> "SignedBy:"
-            <+> pretty (AsBase58 pk)
-            <+> "("
-            <> pretty ((PrettyEither . left show . deserialiseOrFail @a . cs) bs)
-            <> ")"
-
-instance (ForQBLFDemoToken s) => Serialise (Actor s)
-
-instance Serialise DAppState
-
-instance Serialise Amount
-
-instance (ForQBLFDemoToken s) => Serialise (EmitTx s)
-
-instance (ForQBLFDemoToken s) => Serialise (MoveTx s)
-
-instance (ForQBLFDemoToken s) => Serialise (QBLFDemoToken s)
-
-type ForQBLFDemoToken s =
-    ( Eq (PubKey 'Sign s)
-    , Eq (Signature s)
-    , Pretty (AsBase58 (PubKey 'Sign s))
-    , ForSignedBox s
-    , FromStringMaybe (PubKey 'Sign s)
-    , Serialise (PubKey 'Sign s)
-    , Serialise (Signature s)
-    , Hashable (PubKey 'Sign s)
-    )
-
-deriving stock instance (ForQBLFDemoToken s) => Eq (QBLFDemoToken s)
-
-instance (ForQBLFDemoToken s) => Hashable (QBLFDemoToken s) where
-    hashWithSalt salt = \case
-        Emit box -> hashWithSalt salt box
-        Move box -> hashWithSalt salt box
-
-newtype QBLFDemoTran e
-    = QBLFDemoTran (SignedBox (QBLFDemoToken (Encryption e)) (Encryption e))
-    deriving stock (Generic)
-
-instance (ForRefChans e) => Serialise (QBLFDemoTran e)
-
-deriving newtype instance
-    (Eq (PubKey 'Sign (Encryption e)), Eq (Signature (Encryption e)))
-    => Eq (QBLFDemoTran e)
-
-deriving newtype instance
-    (Eq (Signature (Encryption e)), ForRefChans e)
-    => Hashable (QBLFDemoTran e)
-
-instance HasProtocol UNIX (QBLFDemoTran UNIX) where
-    type ProtocolId (QBLFDemoTran UNIX) = 0xFFFF0001
-    type Encoded UNIX = ByteString
-    decode = either (const Nothing) Just . deserialiseOrFail
-    encode = serialise
-
-makeEmitDemoToken
-    :: forall s e m
-     . ( MonadIO m
-       , ForRefChans e
-       , ForQBLFDemoToken s
-       , Signatures (Encryption e)
-       , s ~ Encryption e
-       )
-    => PubKey 'Sign s
-    -> PrivKey 'Sign s
-    -> Account s
-    -> Amount
-    -> m (QBLFDemoToken s)
-makeEmitDemoToken pk sk acc amount = do
-    nonce <- randomIO
-    let box = makeSignedBox @s pk sk (EmitTx acc amount nonce)
-    pure (Emit @s box)
-
-makeMoveDemoToken
-    :: forall s e m
-     . ( MonadIO m
-       , ForQBLFDemoToken s
-       , ForRefChans e
-       , Signatures s
-       , s ~ Encryption e
-       )
-    => PubKey 'Sign s -- from pk
-    -> PrivKey 'Sign s -- from sk
-    -> Account s
-    -> Amount -- amount
-    -> m (QBLFDemoToken s)
-makeMoveDemoToken pk sk acc amount = do
-    nonce <- randomIO
-    let box = makeSignedBox @s pk sk (MoveTx pk acc amount nonce)
-    pure (Move @s box)
--- a/examples/refchan-qblf/refchan-qblf.cabal
+++ b/examples/refchan-qblf/refchan-qblf.cabal
@ -19,7 +19,6 @@ common warnings
 common common-deps
    build-depends:
          base, hbs2-core, hbs2-peer, hbs2-storage-simple, hbs2-qblf
-        , hbs2-qblf
        , aeson
        , async
        , bytestring
@ -58,18 +57,6 @@ common common-deps
        , interpolatedstring-perl6
        , unliftio

-        , attoparsec
-        , clock
-        , data-textual
-        , network
-        , network-ip
-        , optparse-applicative
-        , string-conversions
-        , text
-        , time
-
-
-
 common shared-properties
  ghc-options:
        -Wall
@ -107,48 +94,68 @@ common shared-properties
                     , MultiParamTypeClasses
                     , OverloadedStrings
                     , QuasiQuotes
-                     , RecordWildCards
                     , ScopedTypeVariables
                     , StandaloneDeriving
                     , TupleSections
                     , TypeApplications
-                     , TypeOperators
                     , TypeFamilies

-library
-    import:           shared-properties
-    import:           common-deps
-
-    hs-source-dirs:   lib
-
-    exposed-modules:
-      RefChanQBLF.App
-      RefChanQBLF.CLI
-      RefChanQBLF.Common
-      RefChanQBLF.Impl
-      RefChanQBLF.RPCServer
-      RefChanQBLF.Transactions
-
 executable refchan-qblf
    import:           shared-properties
    import:           common-deps
-
-    build-depends:
-        refchan-qblf
+    default-language: Haskell2010

    ghc-options:
      -- -prof
      -- -fprof-auto

+    other-modules:
+      Demo.QBLF.Transactions
+
    -- other-extensions:

    -- type:             exitcode-stdio-1.0
-    hs-source-dirs:   app
-    main-is:          Main.hs
+    hs-source-dirs:   app lib
+    main-is:          RefChanQBLFMain.hs
+
+    build-depends:
+          base, hbs2-core, hbs2-qblf, hbs2-storage-simple
+        , async
+        , attoparsec
+        , bytestring
+        , cache
+        , clock
+        , containers
+        , data-default
+        , data-textual
+        , directory
+        , hashable
+        , microlens-platform
+        , mtl
+        , mwc-random
+        , network
+        , network-ip
+        , optparse-applicative
+        , prettyprinter
+        , QuickCheck
+        , random
+        , safe
+        , serialise
+        , stm
+        , streaming
+        , tasty
+        , tasty-hunit
+        , text
+        , time
+        , transformers
+        , uniplate
+        , vector
+        , unliftio
+

 test-suite refchan-qblf-proto-test
    import:           shared-properties
-    import:           common-deps
+    default-language: Haskell2010

    other-modules:

--- a/examples/site/bar.ss
+++ b/examples/site/bar.ss
@ -1,35 +0,0 @@
-; это страница, на которую ссылается foo.ss
-
-(define (bar-page)
-
-[html :html [kw]
- [html :head [kw]
-   [html :title [kw] Suckless HTML Page]
-   [html :meta [kw :charset UTF-8]]
-   [html :style [kw]
-     [css body [kw font-family sans-serif margin-left 20px max-width 1024px]]
-     [css table [kw border-collapse collapse width auto]]
-
-     [css (list td th) [kw border [sym (unwords 1px solid #ccc)]
-                           padding 8px
-                           text-align left]]
-
-     [css th [kw background-color #f2f2f2 white-space nowrap]]
-     [css .che [kw margin-right 8px]]
-   ]
- ]
-
- [html :body [kw]
-   [html :h1 [kw] Some other page]
-   [html :h2 [kw] Built with Suckless Script]
-
-   [html :p [kw] This is an example page generated using hbs2.]
-
-   Just some text
-
- ]]
-
-)
-
-
-
--- a/examples/site/foo.ss
+++ b/examples/site/foo.ss
@ -1,96 +0,0 @@
-; это наш "сайт" -- poo.ss
-
-; просто какой-то левый json
-[define source [json:file miscellaneous/fuzzy-parse/nix/pkgs.json]]
-
-(define (foo-page bar)
-
-[html :html [kw]
-  [html :head [kw]
-    [html :title [kw] Suckless HTML Page]
-    [html :meta [kw :charset UTF-8]]
-    [html :style [kw]
-      [css body [kw font-family sans-serif margin-left 20px max-width 1024px]]
-      [css table [kw border-collapse collapse width auto]]
-
-      [css (list td th) [kw border [sym (unwords 1px solid #ccc)]
-                            padding 8px
-                            text-align left]]
-
-      [css th [kw background-color #f2f2f2 white-space nowrap]]
-      [css .che [kw margin-right 8px]]
-    ]
-  ]
-
-  [html :body [kw]
-    [html :h1 [kw] Super Cool HBS2 Suckless Script Example Page]
-    [html :h2 [kw] Built with Suckless Script]
-
-    [html :p [kw] This is an example page generated using hbs2.]
-
-    [html :p [kw] [html :a [kw href [concat ../../tree/ bar]] Referes to bar ] ]
-
-    [html :form [kw action # method POST]
-      [html :label [kw for cb1]
-        [html :input [kw :type checkbox name checkbox1 :id cb1 :class che]]
-        I agree with the terms
-      ]
-      [html :br]
-      [html :input [kw :type text :name username :placeholder "Enter your name"]]
-      [html :br]
-      [html :input [kw :type submit :value Submit]]
-    ]
-
-    [html :br]
-
-    [html :p [kw]
-      This text contains
-
-      [html :b [kw] bold]
-
-      chr:comma
-
-      [html :i [kw] italic]
-
-      :and
-
-      [html :u [kw] :underlined]
-
-      styles.
-    ]
-
-    [html :br]
-
-    ; Unicode test section
-    [html :p [kw] Russian: Привет, мир!]
-    [html :p [kw] Chinese: 你好，世界！]
-    [html :p [kw] Korean: 안녕하세요, 세계!]
-
-    [html :br]
-
-    [html :table [kw]
-      [html :thead [kw]
-        [html :tr [kw]
-          [html :th [kw] Package]
-          [html :th [kw] Version]
-        ]
-      ]
-
-      [html :tbody [kw]
-        [map [fn 1 [html :tr [kw] [html :th [kw] [car _1]]
-                   [html :td [kw] [nth 1 _1]]  ] ] source]
-      ]
-    ]
-
-    [html :br]
-
-    [html :p [kw]
-      For more information, visit
-      [html :a [kw href http://example.com] our website]
-      "."
-    ]
-  ]
-]
-
-)
-
--- a/examples/site/site.ss
+++ b/examples/site/site.ss
@ -1,44 +0,0 @@
-
-; [eval [cons :begin [top:file bar.ss]]]
-
-(import bar.ss)
-(import foo.ss)
-
-(define site-root-ref :4X65y4YvUjRL2gtA9Ec3YDDP4bnxjTGhfjpoah96t3z1)
-
-(define (as-html n) [kw :file-name n :mime-type "text/html; charset=utf-8"]) ; метаданные что бы hbs2-peer отображал как вебстраницу
-
-(define bar.html (bar-page)) ; генерим страничку
-
-(define bar.hash (hbs2:tree:metadata:string [as-html :bar.html] bar.html)) ; сохраняем как дерево с метаданными
-
-(define foo.html (foo-page bar.hash))
-
-(define foo.hash (hbs2:tree:metadata:string [as-html :foo.html] foo.html)) ; сохраняем как дерево с метаданными
-
-(define grove [hbs2:grove:annotated [kw webroot foo.hash] [list foo.hash bar.hash]])
-
-; println :bar.html space "hash:" space bar.hash
-
-println Grove: space grove ; hello.hash
-
-hbs2:lwwref:update site-root-ref grove
-
-; newline
-
-; print [hbs2:lwwref:get site-root-ref]
-
-(define url [sym [join / http://localhost:5000/ref site-root-ref]]) ; вычисляем url
-
-; newline
-
-; print url
-
-; print bar.html
-
-; print foo.html
-
-; print site-root-ref
-
-(call:proc "firefox" url) ; вызываем фарфокс
-
--- a/fixme-new/LICENSE
+++ b/fixme-new/LICENSE
@ -1,30 +0,0 @@
-Copyright (c) 2023, 
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of  nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--- a/fixme-new/README.md
+++ b/fixme-new/README.md
@ -1,22 +0,0 @@
-
-
-## The new glorious fixme
-
-This is a new fixme implementation! It's a re-implementation
-of fixme aiming for using multiple sources for issues, not
-only git repo, and able to share the state via hbs2
-privimites.
-
-It will replace the old good fixme and will reuse all the
-code from there that could be re-used.
-
-It's indendent to be mostly compatible with the old
-fixme, but we will see.
-
-The binary is called fixme-new in order not to be confused
-with old fixme, but it's only for a while.
-
-It will be replaced as soon, as this fixme will be fully
-operational.
-
-
--- a/fixme-new/app/FixmeMain.hs
+++ b/fixme-new/app/FixmeMain.hs
@ -1,8 +0,0 @@
-module Main where
-
-import Fixme.Run
-
-main :: IO ()
-main = do
-  runFixmeCLI runCLI
-
--- a/fixme-new/examples/config
+++ b/fixme-new/examples/config
@ -1,61 +0,0 @@
-
-; fixme-files **/*.hs docs/devlog.md
-
-; no-debug
-; debug
-
-fixme-prefix     FIXME:
-fixme-prefix     TODO:
-fixme-prefix     PR:
-fixme-prefix     REVIEW:
-
-fixme-git-scan-filter-days 30
-
-fixme-attribs assigned workflow type
-
-fixme-attribs resolution cat scope
-
-fixme-value-set workflow new backlog wip test fixed done
-
-; fixme-value-set cat bug feat refactor
-
-fixme-value-set scope mvp-0 mvp-1 backlog
-
-fixme-files **/*.txt docs/devlog.md
-fixme-files **/*.hs
-
-fixme-file-comments "*.scm" ";"
-
-fixme-comments ";" "--"
-
-(define-template short
-  (quot
-    (simple
-         (trim 10  $fixme-key) " "
-
-         (if (~ FIXME $fixme-tag)
-          (then (fgd red (align 6  $fixme-tag))  )
-          (else (if (~ TODO $fixme-tag)
-                  (then (fgd green (align 6  $fixme-tag)))
-                  (else (align 6  $fixme-tag)) ) )
-          )
-
-
-         (align 10  ("[" $workflow "]"))  " "
-         (align 8  $type)  " "
-         (align 12 $assigned)  " "
-         (align 20 (trim 20 $committer-name)) " "
-         (trim 50  ($fixme-title)) " "
-         (nl))
-    )
-)
-
-(set-template default short)
-
-(define (ls) (report))
-
-(define (ls:wip) (report workflow ~ wip))
-
-(define (stage) (fixme:stage:show))
-
-
--- a/fixme-new/examples/config-fixme-new-config
+++ b/fixme-new/examples/config-fixme-new-config
@ -1,6 +0,0 @@
-
-fixme-pager (quot (bat  "--file-name" $file "-H" $before))
-
-fixme-def-context 2 5
-
-
--- a/fixme-new/lib/Fixme.hs
+++ b/fixme-new/lib/Fixme.hs
@ -1,8 +0,0 @@
-module Fixme
-  ( module Fixme.Types
-  , module Fixme.Prelude
-  ) where
-
-import Fixme.Prelude
-import Fixme.Types
-
--- a/fixme-new/lib/Fixme/Config.hs
+++ b/fixme-new/lib/Fixme/Config.hs
@ -1,41 +0,0 @@
-module Fixme.Config where
-
-import Fixme.Prelude
-import Fixme.Types
-
-import HBS2.System.Dir
-import System.Environment
-import System.Directory (getXdgDirectory, XdgDirectory(..))
-
-binName :: FixmePerks m => m FilePath
-binName = pure "fixme-new" -- liftIO getProgName
-
-localConfigDir :: (FixmePerks m, MonadReader FixmeEnv m) =>  m FilePath
-localConfigDir = do
-  p <- asks fixmeEnvWorkDir >>= readTVarIO
-  b <- binName
-  pure (p </> ("." <> b))
-
-fixmeWorkDir :: (FixmePerks m, MonadReader FixmeEnv m) => m FilePath
-fixmeWorkDir = asks fixmeEnvWorkDir >>= readTVarIO
-
-localConfig:: (FixmePerks m, MonadReader FixmeEnv m) => m FilePath
-localConfig = localConfigDir <&> (</> "config")
-
-userConfigs :: FixmePerks m => m [FilePath]
-userConfigs= do
-  bin <- binName
-  h <- home
-  xdg <- liftIO (getXdgDirectory XdgConfig bin)
-
-  let conf1 = h </> ("." <> bin)
-  let conf2 = xdg </> "config"
-
-  pure [conf2, conf1]
-
-localDBName :: FilePath
-localDBName = "state.db"
-
-localDBPath :: (FixmePerks m, MonadReader FixmeEnv m) => m FilePath
-localDBPath = localConfigDir <&> (</> localDBName)
-
--- a/fixme-new/lib/Fixme/GK.hs
+++ b/fixme-new/lib/Fixme/GK.hs
@ -1,96 +0,0 @@
-{-# Language MultiWayIf #-}
-module Fixme.GK where
-
-import Fixme.Prelude
-import Fixme.Config
-import Fixme.Types
-
-import HBS2.OrDie
-- import HBS2.System.Dir
-import HBS2.Storage.Operations.ByteString
-import HBS2.Storage.Operations.Class
-
-import HBS2.Net.Auth.GroupKeySymm
-import HBS2.Peer.Proto.RefChan as RefChan
-import HBS2.System.Dir
-- import HBS2.Net.Auth.Credentials
-
-import Control.Monad.Trans.Maybe
-import Data.HashSet qualified as HS
-import Data.HashMap.Strict qualified as HM
-import Data.Maybe
-import Lens.Micro.Platform
-
-data GroupKeyOpError =
-    NoRefChanHead
-  | NoReadersSet
-  | GKLoadFailed
-  deriving (Eq,Ord,Show,Typeable)
-
-instance Exception GroupKeyOpError
-
-
-groupKeyFile :: forall m . (FixmePerks m, MonadReader FixmeEnv m) => m FilePath
-groupKeyFile = do
-  dir <- localConfigDir
-  pure $ dir </> "gk0"
-
-- TODO: rotate-group-key
-
-loadGroupKey :: forall s m . (s ~ 'HBS2Basic, FixmePerks m) => FixmeM m (Maybe (HashRef, GroupKey 'Symm s))
-loadGroupKey = do
-
-  sto <- getStorage
-  gkF <- groupKeyFile
-
-  runMaybeT do
-
-    rchan <- lift (asks fixmeEnvRefChan >>= readTVarIO) >>= toMPlus
-
-    rch <- getRefChanHead @L4Proto sto (RefChanHeadKey rchan)
-             >>= orThrow NoRefChanHead
-
-    guard ( not $ HS.null (view refChanHeadReaders  rch) )
-
-    flip fix 0 $ \next -> \case
-
-      attempt | attempt > 2 -> throwIO GKLoadFailed
-
-      attempt -> do
-
-        let readers = view refChanHeadReaders rch
-
-        gkHash <- liftIO (try @_ @IOError $ readFile gkF)
-                    <&> either (const Nothing) ( (=<<) (fromStringMay @HashRef) . headMay . lines )
-
-        debug $ "GK0" <+> pretty gkHash
-
-        case gkHash of
-          Nothing -> do
-            debug "generate new group key"
-            gknew <- generateGroupKey @'HBS2Basic Nothing (HS.toList readers)
-            ha <- writeAsMerkle sto (serialise gknew)
-            liftIO $ writeFile gkF (show $ pretty ha)
-            next (succ attempt)
-
-          Just h -> do
-            now <- liftIO $ getPOSIXTime <&> round
-            gk' <- loadGroupKeyMaybe @s sto h
-
-            (_,gk) <- maybe1 gk' (rm gkF >> next (succ attempt)) (pure . (h,))
-
-            let ts = getGroupKeyTimestamp gk & fromMaybe 0
-
-            -- FIXME: timeout-hardcode
-            --   $class: hardcode
-            if | now - ts > 2592000 -> do
-                 rm gkF
-                 next (succ attempt)
-
-               | HM.keysSet (recipients gk) /= readers -> do
-                 rm gkF
-                 next (succ attempt)
-
-               | otherwise -> do
-                  pure (h,gk)
-
--- a/fixme-new/lib/Fixme/Prelude.hs
+++ b/fixme-new/lib/Fixme/Prelude.hs
@ -1,24 +0,0 @@
-module Fixme.Prelude
-  ( module All
-  , GitHash(..)
-  , GitRef(..)
-  , Serialise(..)
-  , serialise, deserialiseOrFail, deserialise
-  , module Exported
-  ) where
-
-import HBS2.Prelude.Plated as All
-import HBS2.Hash as All
-import HBS2.Data.Types.Refs as All
-import HBS2.Misc.PrettyStuff as All
-import HBS2.System.Logger.Simple.ANSI as All
-import HBS2.Git.Local (GitHash(..),GitRef(..))
-import Codec.Serialise (Serialise(..),serialise,deserialise,deserialiseOrFail)
-import Data.Functor as All
-import Data.Function as All
-import UnliftIO as All
-import System.FilePattern as All
-import Control.Monad.Reader as All
-
-import Data.Config.Suckless.Script as Exported
-
--- a/fixme-new/lib/Fixme/Run.hs
+++ b/fixme-new/lib/Fixme/Run.hs
@ -1,592 +0,0 @@
-module Fixme.Run where
-
-import Prelude hiding (init)
-import Fixme.Prelude hiding (indent)
-import Fixme.Types
-import Fixme.Config
-import Fixme.State
-import Fixme.Run.Internal
-import Fixme.Run.Internal.RefChan
-import Fixme.Scan.Git.Local as Git
-import Fixme.Scan as Scan
-import Fixme.GK as GK
-
-import Data.Config.Suckless.Script.File
-
-import HBS2.KeyMan.Keys.Direct
-
-import HBS2.Git.Local.CLI
-import HBS2.Peer.Proto.RefChan.Types
-
-import HBS2.CLI.Run.KeyMan (keymanNewCredentials)
-
-import HBS2.OrDie
-import HBS2.Peer.CLI.Detect
-import HBS2.Net.Auth.GroupKeySymm
-import HBS2.Data.Types.SignedBox
-import HBS2.Base58
-import HBS2.Storage.Operations.ByteString
-import HBS2.Net.Auth.Credentials
-import HBS2.Merkle
-import HBS2.Data.Types.Refs
-import HBS2.Storage
-import HBS2.Storage.Compact
-import HBS2.System.Dir
-import DBPipe.SQLite hiding (field)
-import Data.Config.Suckless
-
-import Data.Aeson.Encode.Pretty as Aeson
-import Data.ByteString (ByteString)
-import Data.ByteString.Lazy qualified as LBS
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.Either
-import Data.Maybe
-import Data.HashSet qualified as HS
-import Data.HashMap.Strict (HashMap)
-import Data.HashMap.Strict qualified as HM
-import Data.HashSet (HashSet)
-import Data.Set qualified as Set
-import Data.Generics.Product.Fields (field)
-import Data.List qualified as List
-import Data.Text qualified as Text
-import Data.Text.IO qualified as Text
-import Text.InterpolatedString.Perl6 (qc)
-import Data.Coerce
-import Control.Monad.Identity
-import Lens.Micro.Platform
-import System.Environment
-import System.Process.Typed
-import Control.Monad
-import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe
-import System.IO.Temp qualified as Temp
-import System.IO qualified as IO
-
-import Streaming.Prelude qualified as S
-
-{- HLINT ignore "Functor law" -}
-
-
-recover :: (FixmePerks m) => FixmeEnv -> m a -> m a
-recover env m = flip fix 0 $ \next attempt
-    -> do m
-        `catch` (\PeerNotConnected  -> do
-                    if attempt < 1 then do
-                      runWithRPC env $ next (succ attempt)
-                    else do
-                      throwIO PeerNotConnected
-               )
-
-withFixmeCLI :: (FixmePerks m, MonadReader FixmeEnv m) => FixmeEnv -> FixmeM m a -> m a
-withFixmeCLI env m = do
-  recover env do
-    withFixmeEnv env m
-
-runWithRPC :: (FixmePerks m) => FixmeEnv ->  m a -> m a
-runWithRPC FixmeEnv{..} m = do
-
-  soname <- detectRPC
-              `orDie` "can't locate hbs2-peer rpc"
-
-  flip runContT pure do
-
-    client <- lift $ race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname)
-                >>= orThrowUser ("can't connect to" <+> pretty soname)
-
-    void $ ContT $ withAsync $ runMessagingUnix client
-
-    peerAPI    <- makeServiceCaller @PeerAPI (fromString soname)
-    refChanAPI <- makeServiceCaller @RefChanAPI (fromString soname)
-    storageAPI <- makeServiceCaller @StorageAPI (fromString soname)
-
-    let endpoints = [ Endpoint @UNIX  peerAPI
-                    , Endpoint @UNIX  refChanAPI
-                    , Endpoint @UNIX  storageAPI
-                    ]
-
-    void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client
-
-
-    let newEnv = Just (MyPeerClientEndpoints soname peerAPI refChanAPI storageAPI)
-    liftIO $ atomically $ writeTVar fixmeEnvMyEndpoints newEnv
-    lift m
-
-runFixmeCLI :: forall a m . FixmePerks m => FixmeM m a -> m a
-runFixmeCLI m = do
-  git <- findGitDir
-  env <- FixmeEnv
-            <$>  newMVar ()
-            <*>  newTVarIO mempty
-            <*>  (pwd >>= newTVarIO)
-            <*>  newTVarIO Nothing
-            <*>  newTVarIO git
-            <*>  newTVarIO mempty
-            <*>  newTVarIO mempty
-            <*>  newTVarIO mempty
-            <*>  newTVarIO builtinAttribs
-            <*>  newTVarIO builtinAttribVals
-            <*>  newTVarIO mempty
-            <*>  newTVarIO defCommentMap
-            <*>  newTVarIO Nothing
-            <*>  newTVarIO mzero
-            <*>  newTVarIO mempty
-            <*>  newTVarIO mempty
-            <*>  newTVarIO defaultCatAction
-            <*>  newTVarIO defaultTemplate
-            <*>  newTVarIO mempty
-            <*>  newTVarIO (1,3)
-            <*>  newTVarIO mzero
-            <*>  newTVarIO mzero
-            <*>  newTVarIO mzero
-            <*>  newTVarIO mzero
-            <*>  newTVarIO mempty
-
-  -- FIXME: defer-evolve
-  --   не все действия требуют БД,
-  --   хорошо бы, что бы она не создавалась,
-  --   если не требуется
-  recover env do
-    runReaderT ( setupLogger >> fromFixmeM (handle @_ @SomeException (err . viaShow) evolve >> m) ) env
-                   `finally` flushLoggers
-  where
-    setupLogger = do
-      setLogging @ERROR  $ toStderr . logPrefix "[error] "
-      setLogging @WARN   $ toStderr . logPrefix "[warn] "
-      setLogging @NOTICE $ toStdout . logPrefix ""
-      pure ()
-
-    flushLoggers = do
-      silence
-
-    -- FIXME: tied-fucking-context
-    defaultCatAction = CatAction $ \dict lbs -> do
-      LBS.putStr lbs
-      pure ()
-
-silence :: FixmePerks m => m ()
-silence = do
-  setLoggingOff @DEBUG
-  setLoggingOff @ERROR
-  setLoggingOff @WARN
-  setLoggingOff @NOTICE
-  setLoggingOff @TRACE
-
-
-readConfig :: (FixmePerks m) => FixmeM m [Syntax C]
-readConfig = do
-
-  user <- userConfigs
-  lo   <- localConfig
-
-  w <- for (lo : user) $ \conf -> do
-    try @_ @IOException (liftIO $ readFile conf)
-      <&> fromRight mempty
-      <&> parseTop
-      >>= either (error.show) pure
-
-  updateScanMagic
-
-  pure $ mconcat w
-
-
-runCLI :: FixmePerks m => FixmeM m ()
-runCLI = do
-  argz <- liftIO getArgs
-  forms <- parseTop (unlines $ unwords <$> splitForms argz)
-           & either  (error.show) pure
-
-  runTop forms
-
-
-runTop :: forall m . FixmePerks m => [Syntax C] -> FixmeM m ()
-runTop forms = do
-
-  tvd  <- newTVarIO mempty
-
-  let dict = makeDict @C do
-
-       internalEntries
-
-       entry $ bindMatch "--help" $ nil_ \case
-         HelpEntryBound what -> helpEntry what
-         [StringLike s]      -> helpList False (Just s)
-         _                   -> helpList False Nothing
-
-       entry $ bindMatch "fixme-prefix" $ nil_ \case
-        [StringLike pref] -> do
-
-          t <- lift $ asks fixmeEnvTags
-          atomically (modifyTVar t (HS.insert (FixmeTag $ fromString pref)))
-
-        _ -> throwIO $ BadFormException @C nil
-
-
-       entry $ bindMatch "fixme-attribs" $ nil_ \case
-        StringLikeList xs -> do
-          ta <- lift $ asks fixmeEnvAttribs
-          atomically $ modifyTVar ta (<> HS.fromList (fmap fromString xs))
-
-        _ -> throwIO $ BadFormException @C nil
-
-
-       entry $ bindMatch "fixme-files" $ nil_ \case
-        StringLikeList xs -> do
-          w <- lift fixmeWorkDir
-          t <- lift $ asks fixmeEnvFileMask
-          atomically (modifyTVar t (<> fmap (w </>) xs))
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "fixme-exclude" $ nil_ \case
-        StringLikeList xs -> do
-          w <- lift fixmeWorkDir
-          t <- lift $ asks fixmeEnvFileExclude
-          atomically (modifyTVar t (<> fmap (w </>) xs))
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "fixme-file-comments" $ nil_ $ \case
-         [StringLike ft, StringLike b] -> do
-            let co = Text.pack b & HS.singleton
-            t <- lift $ asks fixmeEnvFileComments
-            atomically (modifyTVar t (HM.insertWith (<>) (commentKey ft) co))
-
-         _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "fixme-comments" $ nil_  \case
-         (StringLikeList xs) -> do
-            t <- lift $ asks fixmeEnvDefComments
-            let co = fmap Text.pack xs & HS.fromList
-            atomically $ modifyTVar t (<> co)
-
-         _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch  "fixme-value-set" $ nil_ \case
-         (StringLike n : StringLikeList xs)  -> do
-           t <- lift $ asks fixmeEnvAttribValues
-           let name = fromString n
-           let vals = fmap fromString xs & HS.fromList
-           atomically $ modifyTVar t (HM.insertWith (<>) name vals)
-
-         _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "fixme-pager" $ nil_ \case
-         [ListVal cmd0] -> do
-            t <- lift $ asks fixmeEnvCatAction
-            let action =  CatAction $ \dict lbs -> do
-
-                  let ccmd = case inject dict cmd0 of
-                               (StringLike p : StringLikeList xs) -> Just (p, xs)
-                               _  -> Nothing
-
-
-                  debug $ pretty ccmd
-
-                  maybe1 ccmd none $ \(p, args) -> do
-
-                    let input = byteStringInput lbs
-                    let cmd = setStdin input $ setStderr closed
-                                             $ proc p args
-
-                    void $ runProcess cmd
-
-            atomically $ writeTVar t action
-
-         _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "fixme-def-context" $ nil_ \case
-        [LitIntVal a, LitIntVal b] -> do
-          t <- lift $ asks fixmeEnvCatContext
-          atomically $ writeTVar t (fromIntegral a, fromIntegral b)
-
-        _ -> throwIO $ BadFormException @C nil
-
-
-       entry $ bindMatch "modify" $ nil_ \case
-        [ FixmeHashLike w, StringLike k, StringLike v ] -> lift do
-          void $ runMaybeT do
-            key <- lift (selectFixmeKey w) >>= toMPlus
-            lift $ modifyFixme key [(fromString k, fromString v)]
-
-        _ -> throwIO $ BadFormException @C nil
-
-
-       entry $ bindMatch "delete" $ nil_ \case
-        [ FixmeHashLike w ] -> lift do
-          void $ runMaybeT do
-            key <- lift (selectFixmeKey w) >>= toMPlus
-            lift $ modifyFixme key [("deleted", "true")]
-
-        _ -> throwIO $ BadFormException @C nil
-
-
-       entry $ bindMatch "cat" $ nil_ $ \case
-        [ FixmeHashLike w ] -> lift do
-          cat_ w
-
-        _ -> throwIO $ BadFormException @C nil
-
-
-       entry $ bindMatch "create" $ nil_ $ \syn -> do
-
-        me' <- lookupValue "me"
-
-        me <- case me' of
-                StringLike who -> pure who
-                _ -> do
-                  user    <- liftIO $ lookupEnv "USER" <&> fromMaybe "stranger"
-                  try @_ @SomeException (readProcess (shell [qc|git config user.name|]))
-                               <&> either (const user) (headDef user . lines . LBS8.unpack . view _2)
-
-        let title = case syn of
-                        StringLikeList xs -> unwords xs
-                        _ -> "new-issue"
-
-        lift $ edit_ (Left (me,title))
-
-       entry $ bindMatch "edit" $ nil_ $ \case
-        [ FixmeHashLike w] -> lift $ void $ runMaybeT do
-          key <- lift (selectFixmeKey w) >>= toMPlus
-          fme <- lift (getFixme key) >>= toMPlus
-          lift $ edit_ (Right fme)
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "dump" $ nil_ $ \case
-        [ FixmeHashLike w ] -> lift $ void $ runMaybeT do
-          key <- lift (selectFixmeKey w) >>= toMPlus
-          fme <- lift $ getFixme key
-          liftIO $ print $ pretty fme
-
-        _ -> throwIO $ BadFormException @C nil
-          -- magic <- lift $ asks fixmeEnvScanMagic >>= readTVarIO
-          -- liftIO $ print $ pretty magic
-
-
-       entry $ bindMatch "report" $ nil_ $ lift . \case
-        ( SymbolVal "template" : StringLike t : p )  -> do
-          report (Just t) p
-
-        ( SymbolVal "--template" : StringLike t : p )  -> do
-          report (Just t) p
-
-        p -> do
-          report Nothing p
-
-       entry $ bindMatch "fixme:key:show" $ nil_ \case
-        [ FixmeHashLike w ] -> lift $ void $ runMaybeT do
-          key <- lift (selectFixmeKey w) >>= toMPlus
-          liftIO $ print $ pretty key
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "fixme:scan-magic" $ nil_ $ const do
-          magic <- lift $ asks fixmeEnvScanMagic >>= readTVarIO
-          liftIO $ print $ pretty magic
-
-       entry $ bindMatch "fixme:gk:show" $ nil_ $ const do
-        w <- lift loadGroupKey
-        case w of
-          Just (h,_) -> do
-            liftIO $ print $ pretty h
-          _ -> do
-            liftIO $ print $ pretty "none"
-
-       entry $ bindMatch "fixme:path" $ nil_ $ const do
-          path <- lift fixmeWorkDir
-          liftIO $ print $ pretty path
-
-       entry $ bindMatch "fixme:files" $ nil_ $ const do
-          w <- lift fixmeWorkDir
-          incl <- lift (asks fixmeEnvFileMask >>= readTVarIO)
-          excl <- lift (asks fixmeEnvFileExclude >>= readTVarIO)
-          glob incl excl w  $ \fn -> do
-            liftIO $ putStrLn (makeRelative w fn)
-            pure True
-
-       entry $ bindMatch "fixme:state:drop" $ nil_ $ const $ lift do
-        cleanupDatabase
-
-       entry $ bindMatch "fixme:state:cleanup" $ nil_ $ const $ lift do
-        cleanupDatabase
-
-
-       entry $ bindMatch "fixme:state:count-by-attribute" $ nil_ $ \case
-        [StringLike s] -> lift do
-            rs <- countByAttribute (fromString s)
-            for_ rs $ \(n,v) -> do
-              liftIO $ print $ pretty n <+> pretty v
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "fixme:git:import" $ nil_ $ const $ lift do
-          import_
-
-       entry $ bindMatch "fixme:git:list" $ nil_ $ const do
-          fxs <- lift scanFiles
-          for_ fxs $ \fme -> do
-            liftIO $ print $ pretty fme
-
-       -- TODO: some-uncommited-shit
-
-       -- TODO: some-shit
-       --  one
-
-       -- TODO: some-shit
-       --  new text
-
-       entry $ bindMatch "env:show" $ nil_ $ const $ do
-        lift printEnv
-
-       entry $ bindMatch "refchan:show" $ nil_ $ const do
-          tref <- lift $ asks fixmeEnvRefChan
-          r <- readTVarIO tref
-          liftIO $ print $ pretty (fmap AsBase58 r)
-
-       entry $ bindMatch "refchan" $ nil_ \case
-        [SignPubKeyLike rchan] -> do
-          tref<- lift $ asks fixmeEnvRefChan
-          atomically  $ writeTVar tref (Just rchan)
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "author" $ nil_ \case
-        [SignPubKeyLike au] -> do
-          t <- lift $ asks fixmeEnvAuthor
-          atomically  $ writeTVar t (Just au)
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "reader" $ nil_ \case
-        [EncryptPubKeyLike reader] -> do
-          t <- lift $ asks fixmeEnvReader
-          atomically  $ writeTVar t (Just reader)
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "git:commits" $ const $ do
-        co <- lift listCommits <&> fmap (mkStr @C . view _1)
-        pure $ mkList co
-
-       entry $ bindMatch "fixme:refchan:export" $ nil_ $ \case
-          [SymbolVal "dry"] -> do
-            notice $ yellow "export is running in dry mode"
-            void $ lift $ refchanExport [RefChanExportDry]
-
-          _ ->  void $ lift $ refchanExport ()
-
-       entry $ bindMatch "fixme:refchan:import" $ nil_ $ \case
-          _ ->  void $ lift $ refchanImport
-
-       entry $ bindMatch "fixme:gk:export" $ nil_ $ \case
-          _ ->  void $ lift $ refchanExportGroupKeys
-
-       entry $ bindMatch "source" $ nil_ $ \case
-        [StringLike path] -> do
-
-          ppath <- if List.isPrefixOf "." path then do
-                      dir <- lift localConfigDir
-                      let rest = tail $ splitDirectories path
-                      pure $ joinPath (dir:rest)
-                   else do
-                      canonicalizePath path
-
-          debug $ red "SOURCE FILE" <+> pretty ppath
-
-          -- FIXME: raise-warning?
-          content <- liftIO $ try @_ @IOException (readFile ppath)
-                        <&> fromRight mempty
-                        <&> parseTop
-                        >>= either (error.show) pure
-
-          lift $ runEval tvd content
-
-        _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "update" $ nil_ $ const $ lift do
-        refchanUpdate
-
-       entry $ bindMatch "update" $ nil_ $ const $ lift do
-        refchanUpdate
-
-       entry $ bindMatch "fixme:refchan:update" $ nil_ $ const $ lift do
-        refchanUpdate
-
-
-       entry $ bindMatch "cache:ignore" $ nil_ $ const $ lift do
-        tf <- asks fixmeEnvFlags
-        atomically $ modifyTVar tf (HS.insert FixmeIgnoreCached)
-
-       entry $ bindMatch "git:blobs" $  \_ -> do
-        blobs <- lift (listBlobs Nothing)
-
-        elems <- for blobs $ \(f,h) -> do
-                    pure $ mkList @C [ mkStr f, mkSym ".", mkStr h ]
-
-        pure $ mkList @C elems
-
-       entry $ bindMatch "init" $ nil_ $ const $ do
-        lift init
-
-       brief "initializes a new refchan" $
-         desc ( vcat [
-                   "Refchan is an ACL-controlled CRDT channel useful for syncronizing"
-                 , "fixme-new state amongst the different remote setups/peers/directories"
-                 , "use it if you want to use fixme-new in a distributed fashion"
-                 ]
-              ) $
-         args [] $
-         returns "string" "refchan-key" $ do
-         entry $ bindMatch "fixme:refchan:init" $ nil_ $ \case
-          [] -> lift $ fixmeRefChanInit Nothing
-          [SignPubKeyLike rc] -> lift $ fixmeRefChanInit (Just rc)
-          _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "set-template" $ nil_ \case
-         [SymbolVal who, SymbolVal w] -> do
-           templates <- lift $ asks fixmeEnvTemplates
-           t <- readTVarIO templates
-           for_ (HM.lookup w t) $ \tpl -> do
-             atomically $ modifyTVar templates (HM.insert who tpl)
-
-         _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "define-template" $ nil_ $ \case
-         [SymbolVal who, IsSimpleTemplate body ] -> do
-          t <- lift $ asks fixmeEnvTemplates
-          atomically $ modifyTVar t (HM.insert who (Simple (SimpleTemplate body)))
-
-         _ -> throwIO $ BadFormException @C nil
-
-       entry $ bindMatch "log:trace:on" $ nil_ $ const do
-          lift $ setLogging @TRACE $ toStderr . logPrefix ""
-
-       entry $ bindMatch "log:trace:off" $ nil_ $ const do
-          lift $ setLoggingOff @TRACE
-
-       entry $ bindMatch "log:debug:on" $ nil_ $ const do
-          lift $ setLogging @DEBUG $ toStderr . logPrefix ""
-
-       entry $ bindMatch "log:debug:off" $ nil_ $ const do
-          lift $ setLoggingOff @DEBUG
-
-       entry $ bindMatch "debug:peer:check" $ nil_ $ const do
-        peer <- lift $ getClientAPI @PeerAPI @UNIX
-        poked <- callRpcWaitMay @RpcPoke (TimeoutSec 1) peer ()
-                   <&> fromMaybe "hbs2-peer not connected"
-        liftIO $ putStrLn poked
-
-
-  argz <- liftIO getArgs
-
-  conf <- readConfig
-
-  let args = zipWith (\i s -> bindValue (mkId ("$_" <> show i)) (mkStr @C s )) [1..] argz
-               & HM.unions
-
-  let finalDict = dict <> args -- :: Dict C (FixmeM m)
-
-  atomically $ writeTVar tvd finalDict
-
-  runEval tvd (conf <> forms) >>= eatNil display
-
--- a/fixme-new/lib/Fixme/Run/Internal.hs
+++ b/fixme-new/lib/Fixme/Run/Internal.hs
@ -1,960 +0,0 @@
-{-# Language PatternSynonyms #-}
-{-# Language ViewPatterns #-}
-module Fixme.Run.Internal where
-
-import Prelude hiding (init)
-import Fixme.Prelude hiding (indent)
-import Fixme.Types
-import Fixme.Config
-import Fixme.State
-import Fixme.Scan.Git.Local as Git
-import Fixme.Scan as Scan
-import Fixme.GK
-
-import HBS2.Git.Local.CLI
-import HBS2.CLI.Run.MetaData (createTreeWithMetadata,getTreeContents,getGroupKeyHash)
-import HBS2.Merkle.MetaData
-
-import HBS2.OrDie
-import HBS2.Base58
-import HBS2.Net.Auth.GroupKeySymm
-import HBS2.Data.Types.SignedBox
-import HBS2.Peer.Proto.RefChan as RefChan
-import HBS2.Peer.RPC.Client.RefChan
-import HBS2.Storage.Operations.ByteString
-import HBS2.System.Dir
-import HBS2.Net.Auth.Credentials
-import DBPipe.SQLite hiding (field)
-
-import HBS2.CLI.Run.KeyMan (keymanNewCredentials)
-import HBS2.KeyMan.Keys.Direct
-
-import Data.Config.Suckless.Script.File
-
-import Data.List qualified as L
-import Data.List.Split (chunksOf)
-import Data.Aeson.Encode.Pretty as Aeson
-import Data.ByteString.Lazy qualified as LBS
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.ByteString qualified as BS
-import Data.Either
-import Data.Map qualified as Map
-import Data.Set qualified as Set
-import Data.Maybe
-import Data.Generics.Product.Fields (field)
-import Data.HashSet qualified as HS
-import Data.HashMap.Strict (HashMap)
-import Data.HashMap.Strict qualified as HM
-import Data.Text qualified as Text
-import Data.Text.Encoding (encodeUtf8)
-import Text.InterpolatedString.Perl6 (qc)
-import Data.Coerce
-import Data.Word
-import Data.UUID.V4 qualified as UUID
-import Lens.Micro.Platform
-import System.Process.Typed
-import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe
-import Control.Monad.Except
-import Control.Concurrent.STM (flushTQueue)
-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
-import System.Directory (getModificationTime)
-
-
-import System.IO as IO
-import System.Environment (lookupEnv)
-import System.IO.Temp qualified as Temp
-
-import Streaming.Prelude qualified as S
-
-pattern IsSimpleTemplate ::  forall {c} . [Syntax c] -> Syntax c
-pattern IsSimpleTemplate xs <- ListVal (SymbolVal "simple" : xs)
-
-{- HLINT ignore "Functor law" -}
-
-
-defaultTemplate :: HashMap Id FixmeTemplate
-defaultTemplate = HM.fromList [ ("default", Simple (SimpleTemplate short)) ]
-  where
-    short = parseTop s & fromRight mempty
-    s = [qc|
-(trim 10  $fixme-key) " "
-(align 6  $fixme-tag) " "
-(trim 50  ($fixme-title))
-(nl)
-    |]
-
-
-templateExample :: String
-templateExample = [qc|
-
-; this is an optional template example
-; for nicer fixme list
-;(define-template short
-;  (quot
-;    (simple
-;         (trim 10  $fixme-key) " "
-;
-;         (if (~ FIXME $fixme-tag)
-;          (then (fgd red (align 6  $fixme-tag))  )
-;          (else (if (~ TODO $fixme-tag)
-;                  (then (fgd green (align 6  $fixme-tag)))
-;                  (else (align 6  $fixme-tag)) ) )
-;          )
-;
-;
-;         (align 10  ("[" $workflow "]"))  " "
-;         (align 8  $class)  " "
-;         (align 12 $assigned)  " "
-;         (align 20 (trim 20 $committer-name)) " "
-;         (trim 50  ($fixme-title)) " "
-;         (nl))
-;    )
-;)
-; (set-template default short)
-
-|]
-
-
-init :: FixmePerks m => FixmeM m ()
-init = do
-
-  lo <- localConfigDir
-
-  let lo0 = takeFileName lo
-
-  mkdir lo
-  touch (lo </> "config")
-
-  let gitignore = lo </> ".gitignore"
-  here <- doesPathExist gitignore
-
-  confPath <- localConfig
-
-  unless here do
-
-    liftIO $ appendFile confPath $ show $ vcat
-      [ mempty
-      , ";; this is a default fixme config"
-      , ";;"
-      , "fixme-prefix"    <+> "FIXME:"
-      , "fixme-prefix"    <+> "TODO:"
-      , "fixme-value-set" <+> hsep [":workflow", ":new",":wip",":backlog",":done"]
-      , "fixme-file-comments" <+> dquotes "*.scm" <+> dquotes ";"
-      , "fixme-comments" <+> dquotes ";"  <+> dquotes "--" <+> dquotes "#"
-      , mempty
-      ]
-
-    exts <- listBlobs Nothing
-              <&> fmap (takeExtension . fst)
-              <&> HS.toList . HS.fromList
-
-    for_ exts $ \e -> do
-      unless (e `elem` [".gitignore",".local"] )  do
-        liftIO $ appendFile confPath $
-          show $ ( "fixme-files" <+> dquotes ("**/*" <> pretty e) <> line )
-
-    liftIO $ appendFile confPath $ show $ vcat
-      [ "fixme-exclude" <+> dquotes "**/.**"
-      ]
-
-    liftIO $ appendFile confPath $ show $ vcat
-      [ mempty
-      , pretty templateExample
-      , ";; uncomment to source any other local settings file"
-      , ";; source ./my.local"
-      , mempty
-      ]
-
-  unless here do
-    liftIO $ writeFile gitignore $ show $
-      vcat [ pretty ("." </> localDBName)
-           ]
-
-  notice $ green "default config created:" <+> ".fixme-new/config" <> line
-             <> "edit it for your project" <> line
-             <> "typically you need to add it to git"
-             <> line
-             <> "use (source ./some.local) form to add your personal settings" <> line
-             <> "which should not be shared amongst the whole project" <> line
-             <> "and add " <> yellow ".fixme-new/some.local" <+> "file to .gitignore"
-             <> line
-
-  notice $ "run" <> line <> vcat [
-      mempty
-    , "git add" <+> pretty (lo0  </> ".gitignore")
-    , "git add" <+> pretty (lo0  </> "config")
-    , mempty
-    ]
-
-
-printEnv :: FixmePerks m => FixmeM m ()
-printEnv = do
-  g <- asks fixmeEnvGitDir >>= readTVarIO
-  masks <- asks fixmeEnvFileMask >>= readTVarIO
-  excl  <- asks fixmeEnvFileExclude >>= readTVarIO
-  tags  <- asks fixmeEnvTags >>= readTVarIO
-  days  <- asks fixmeEnvGitScanDays >>= readTVarIO
-  comments1 <- asks fixmeEnvDefComments >>= readTVarIO <&> HS.toList
-
-  comments2 <- asks fixmeEnvFileComments >>= readTVarIO
-                 <&> HM.toList
-                 <&> fmap  (over _2 HS.toList)
-
-  attr <- asks fixmeEnvAttribs >>= readTVarIO <&> HS.toList
-  vals <- asks fixmeEnvAttribValues >>= readTVarIO <&> HM.toList
-
-  dir <- asks fixmeEnvWorkDir >>= readTVarIO
-
-  liftIO $ print $ "; workdir" <+> pretty dir
-
-  for_ tags $ \m -> do
-    liftIO $ print $ "fixme-prefix" <+> pretty m
-
-  for_ masks $ \m -> do
-    liftIO $ print $ "fixme-files" <+> dquotes (pretty m)
-
-  for_ excl $ \m -> do
-    liftIO $ print $ "fixme-exclude" <+> dquotes (pretty m)
-
-  for_ days $ \d -> do
-    liftIO $ print $ "fixme-git-scan-filter-days" <+> pretty d
-
-  for_ comments1 $ \d -> do
-    liftIO $ print $ "fixme-comments" <+> dquotes (pretty d)
-
-  for_ comments2 $ \(ft, comm') -> do
-    for_ comm' $ \comm -> do
-      liftIO $ print $ "fixme-file-comments"
-                  <+> dquotes (pretty ft) <+> dquotes (pretty  comm)
-
-  for_ attr $ \a -> do
-      liftIO $ print $ "fixme-attribs"
-                  <+> pretty a
-
-  for_ vals$ \(v, vs) -> do
-      liftIO $ print $ "fixme-value-set" <+> pretty v <+> hsep (fmap pretty (HS.toList vs))
-
-  for_ g $ \git -> do
-    liftIO $ print $ "fixme-git-dir" <+> dquotes (pretty git)
-
-  dbPath <- localDBPath
-  liftIO $ print $ "; fixme-state-path" <+> dquotes (pretty dbPath)
-
-  (before,after) <- asks fixmeEnvCatContext >>= readTVarIO
-
-  liftIO $ print $ "fixme-def-context" <+> pretty before <+> pretty after
-
-  ma <- asks fixmeEnvMacro >>= readTVarIO <&> HM.toList
-
-  for_ ma $ \(n, syn) -> do
-    liftIO $ print $ parens ("define-macro" <+> pretty n <+> pretty syn)
-
-  rchan <- asks fixmeEnvRefChan >>= readTVarIO
-
-  liftIO $ print $ ("refchan" <+> pretty (AsBase58 <$> rchan))
-
-  author <- asks fixmeEnvAuthor >>= readTVarIO
-
-  liftIO $ print $ ("author" <+> pretty (AsBase58 <$> author))
-
-  reader <- asks fixmeEnvReader >>= readTVarIO
-
-  liftIO $ print $ ("reader" <+> pretty (AsBase58 <$> reader))
-
-scanOneFile :: FixmePerks m => FilePath -> FixmeM m [Fixme]
-scanOneFile fn = do
-  lbs <- liftIO $ LBS.readFile fn
-  scanBlob (Just fn) lbs
-
-scanFiles :: FixmePerks m => FixmeM m [Fixme]
-scanFiles = do
-  w <- fixmeWorkDir
-  incl <- asks fixmeEnvFileMask >>= readTVarIO
-  excl <- asks fixmeEnvFileExclude >>= readTVarIO
-
-  keys <- newTVarIO (mempty :: HashMap Text Integer)
-
-  S.toList_ do
-
-    glob incl excl w  $ \fn -> do
-
-      ts <- liftIO $ getModificationTime fn <&> round . utcTimeToPOSIXSeconds
-
-      let fnShort = makeRelative w fn
-
-      lbs <- liftIO (try @_ @IOException $ LBS.readFile fn)
-               <&> fromRight mempty
-
-      fxs0 <- lift $ scanBlob (Just fn) lbs
-
-      for_ fxs0 $ \fme -> do
-        let key = fromString (fnShort <> "#") <> coerce (fixmeTitle fme) <> ":" :: Text
-        atomically $ modifyTVar keys (HM.insertWith (+) key 1)
-        no <- readTVarIO keys <&> HM.lookup key <&> fromMaybe 0
-        let keyText = key <> fromString (show no)
-        let keyHash = FixmeKey $ fromString $ show $ pretty $ hashObject @HbSync (serialise keyText)
-        let f2 = mempty { fixmeTs = Just (fromIntegral ts)
-                        , fixmeKey = keyHash
-                        , fixmeAttr = HM.fromList
-                            [   ( "fixme-key-string", FixmeAttrVal keyText)
-                              , ( "file", FixmeAttrVal (fromString fnShort))
-                            ]
-                        , fixmePlain = fixmePlain fme
-                        }
-        let fmeNew = (fme <> f2) & fixmeDerivedFields
-        S.yield fmeNew
-
-      pure True
-
-
-report :: (FixmePerks m, HasPredicate q, HasItemOrder q) => Maybe FilePath -> q -> FixmeM m ()
-report t q = do
-
-  tpl <- asks fixmeEnvTemplates >>= readTVarIO
-            <&> HM.lookup (maybe "default" fromString t)
-
-  fxs <- listFixme (WithLimit Nothing q)
-
-  case tpl of
-    Nothing ->
-      liftIO $ LBS.putStr $ Aeson.encodePretty (fmap fixmeAttr fxs)
-
-    Just (Simple (SimpleTemplate simple)) -> do
-      for_ fxs $ \(Fixme{..}) -> do
-        let subst = [ (mkId k, mkStr @C v) | (k,v) <- HM.toList fixmeAttr ]
-        let what = render (SimpleTemplate (inject  subst simple))
-                      & fromRight "render error"
-
-        liftIO $ hPutDoc stdout what
-
-
-edit_ :: FixmePerks m
-         => Either (String,String) Fixme
-         -> FixmeM m ()
-
-edit_ what = do
-
-  now <- liftIO $ getPOSIXTime <&> round
-
-  editor <- liftIO $ lookupEnv "EDITOR" >>= orThrowUser "EDITOR not set"
-
-  let txt = case what of
-              Right fx0 -> do
-                let fxm = fx0 & set (field @"fixmeAttr") mempty
-                              & set (field @"fixmeStart") mzero
-                              & set (field @"fixmeEnd") mzero
-                show $ pretty fxm
-
-              Left (me,title) -> [qc|TODO: {title}
-$commit-time:    {pretty now}
-$committer-name: {pretty me}
-
-Issue text...
-|]
-
-  let setKey k fx = case what of
-                      Right w -> fx & set (field @"fixmeKey") (fixmeKey w)
-                      Left{}  -> fx & set (field @"fixmeKey") (fromString p)
-        where
-         p = show $ pretty
-                  $ hashObject @HbSync
-                  $ fromString @LBS8.ByteString
-                  $ show k
-
-  flip runContT pure $ callCC \exit -> do
-   fname <- liftIO $ Temp.writeTempFile "." "fixme-issue" txt
-
-   ContT $ bracket none (const $ rm fname)
-
-   h1 <- liftIO (BS.readFile fname)
-            <&> hashObject @HbSync
-
-   debug $ "hash1" <+> pretty  h1
-
-   void $ runProcess $ shell [qc|{editor} {fname}|]
-
-   s <- liftIO $ BS.readFile fname <&> LBS.fromStrict
-
-   let h2 = hashObject @HbSync s
-
-   fxs <- lift $ scanBlobOpts NoIndents Nothing s
-
-   debug $ "hash before/after" <+> pretty  h1 <+> pretty h2
-
-   when (h1 == h2) $ exit ()
-
-   lift $ withState $ transactional do
-     for fxs $ \f -> do
-       key <- liftIO $ UUID.nextRandom <&> show
-       let norm = f & set (field @"fixmeStart") mzero
-                    & set (field @"fixmeEnd") mzero
-                    & setKey key
-                    & set (field @"fixmeTs") (Just $ fromIntegral now)
-                    & fixmeDerivedFields
-
-       notice $ "fixme" <+> pretty (fixmeKey norm)
-       insertFixme norm
-
-
-import_ :: FixmePerks m => FixmeM m ()
-import_ = do
-  fxs0 <- scanFiles
-
-  fxs <- flip filterM fxs0 $ \fme -> do
-           let fn = fixmeGet "file" fme <&> Text.unpack . coerce
-           seen <- maybe1 fn (pure False) selectIsAlreadyScannedFile
-           pure (not seen)
-
-  hashes <- catMaybes <$> flip runContT pure do
-      p <- ContT $ bracket startGitHash stopProcess
-      let files = mapMaybe (fixmeGet "file") fxs
-                      & HS.fromList
-                      & HS.toList
-                      & fmap (Text.unpack . coerce)
-      for files $ \f -> do
-        mbHash <- lift $ gitHashPathStdin p f
-        case mbHash of
-          Just ha ->
-            pure $ Just (f, ha)
-          Nothing ->
-            pure Nothing
-
-  versioned <- listBlobs Nothing <&> HM.fromList
-  let commited = HM.elems versioned & HS.fromList
-
-  let blobs = HM.fromList hashes
-
-  let isVersioned = maybe False (`HM.member` versioned)
-
-  withState $ transactional do
-    for_ fxs $ \fme -> do
-      let fn = fixmeGet "file" fme <&> Text.unpack . coerce
-      fmeRich <- lift $ maybe1 fn (pure mempty) (`getMetaDataFromGitBlame` fme)
-
-      let blob = fn >>= flip HM.lookup blobs
-                    >>= \b -> pure (fixmeSet "blob" (fromString (show $ pretty $ b)) mempty)
-
-      notice $ "fixme" <+> pretty (fixmeKey fme) <+> pretty fn
-      insertFixme (fromMaybe mempty blob <> fmeRich <> fme)
-
-      -- TODO: add-scanned-only-on-commited
-      --   $workflow: test
-      --   поведение: если файл в гите И закоммичен -- то
-      --   добавляем в сканированные.
-      --
-      --   если не в гите -- то добавляем в сканированные
-      --
-      for_ fn $ \f -> do
-        let add = not (isVersioned fn)
-                   || maybe False (`HS.member` commited) (HM.lookup f blobs)
-
-        when add do
-          insertScannedFile f
-
-cat_ :: FixmePerks m => Text -> FixmeM m ()
-cat_ hash = do
-
-  (before,after)  <- asks fixmeEnvCatContext >>= readTVarIO
-  gd  <- fixmeGetGitDirCLIOpt
-
-  CatAction action <- asks fixmeEnvCatAction >>= readTVarIO
-
-  dir  <- fixmeWorkDir
-
-  void $ flip runContT pure do
-    callCC \exit -> do
-
-      mha <- lift $ selectFixmeKey hash
-
-      ha <- ContT $ maybe1 mha (pure ())
-
-      fme' <- lift $ getFixme ha
-
-      fx@Fixme{..} <- ContT $ maybe1 fme' (pure ())
-
-      let dict = [ ("$file", mkStr @C (show $ pretty fixmeKey)) ]
-                 <>
-                 [ (mkId k, mkStr @C   v) | (k,v) <- HM.toList fixmeAttr ]
-                 <>
-                 [ (mkId "$before", mkStr @C (FixmeAttrVal $ Text.pack $ show 1))
-                 ] & HM.fromList
-
-
-      let fallText0 = [qc|{show $ pretty fixmeTag} {show $ pretty fixmeTitle}|]
-                       & encodeUtf8
-                       & LBS8.fromStrict
-
-      let fallback = LBS8.unlines $ fallText0 : fmap (LBS8.fromStrict . encodeUtf8 . coerce) fixmePlain
-
-      let fbAction = action (HM.toList dict)
-
-      let gh' = HM.lookup "blob" fixmeAttr
-
-      -- FIXME: define-fallback-action
-      gh <- ContT $ maybe1 gh' (liftIO (fbAction fallback))
-
-      let cmd = [qc|git {gd} cat-file blob {pretty gh}|] :: String
-
-      w <- gitRunCommand cmd
-              <&> either (const Nothing) Just
-
-      maybe1 w (liftIO $ fbAction fallback) $ \lbs -> do
-
-        let start = fromMaybe 0 fixmeStart & fromIntegral  & (\x -> x - before) & max 0
-
-        -- FIXME: off-by-one-error
-        let bbefore = if start == 0 then 1 else before + 1
-
-        -- warn $ red "before" <+> pretty before <+> pretty bbefore
-
-        let origLen = maybe  0 fromIntegral fixmeEnd - maybe 0 fromIntegral fixmeStart & max 1
-        let lno   =   max 1 $ origLen + after + before
-        let val = mkStr @C (FixmeAttrVal $ Text.pack $ show bbefore)
-        let ddict = HM.toList (HM.insert "$before" val dict)
-        let piece = LBS8.lines lbs & drop start & take lno
-        liftIO $ action ddict (LBS8.unlines piece)
-        exit ()
-
-
-class HasRefChanExportOpts a where
-  refchanExportDry :: a -> Bool
-
-data RefChanExportOpts =
-  RefChanExportDry
-  deriving (Eq,Ord,Show,Enum)
-
-instance HasRefChanExportOpts [RefChanExportOpts] where
-  refchanExportDry what = RefChanExportDry `elem` what
-
-instance HasRefChanExportOpts () where
-  refchanExportDry _ = False
-
-refchanExport :: (FixmePerks m, HasRefChanExportOpts a) => a -> FixmeM m Int
-refchanExport opts = do
-
-  let dry = refchanExportDry opts
-
-  sto <- getStorage
-  rchanAPI <- getClientAPI @RefChanAPI @UNIX
-
-
-  chan <- asks fixmeEnvRefChan
-           >>= readTVarIO
-           >>= orThrowUser "refchan not set"
-
-  au <- asks fixmeEnvAuthor
-           >>= readTVarIO
-           >>= orThrowUser "author's key not set"
-
-  creds <- runKeymanClientRO $ loadCredentials au
-             >>= orThrowUser "can't read credentials"
-
-
-  let (pk,sk) = (view peerSignPk creds, view peerSignSk creds)
-
-  gk0 <- loadGroupKey
-
-  -- TODO: this-may-cause-to-tx-flood
-  --   сделать какой-то период релакса,
-  --   что ли
-  now <- liftIO $ getPOSIXTime <&> round
-
-  withState do
-    what <- select  @FixmeExported [qc|
-      select distinct o,?,k,cast (v as text)
-      from object obj
-      where not exists (select null from scanned where hash = obj.nonce)
-      order by o, k, v, w
-      |] (Only now)
-
-    let chu  = chunksOf 10000 what
-
-    flip runContT pure do
-
-      for_ chu $ \x -> callCC \next -> do
-
-        -- FIXME: encrypt-tree
-
-        --   6. как делать доступ к историческим данным
-        --   6.1 новые ключи в этот же рефчан
-        --   6.2 или новые ключи в какой-то еще рефчан
-
-        let s = maybe "[ ]" (const $ yellow "[@]") gk0
-
-        let gk = snd <$> gk0
-
-        href <- liftIO $ createTreeWithMetadata sto gk mempty (serialise x)
-                  >>= orThrowPassIO
-
-        let tx = AnnotatedHashRef Nothing href
-
-        lift do
-
-          let lbs = serialise tx
-
-          let box = makeSignedBox @'HBS2Basic @BS.ByteString pk sk (LBS.toStrict lbs)
-
-          warn $ "POST" <+> pretty (length x) <+> s <> "tree" <+> pretty href <+> pretty (hashObject @HbSync (serialise box))
-
-          unless dry do
-            r <- callRpcWaitMay @RpcRefChanPropose (TimeoutSec 1) rchanAPI (chan, box)
-
-            when (isNothing r) do
-              err $ red "hbs2-peer rpc calling timeout"
-
-      pure $ length what
-
-
-refchanUpdate :: FixmePerks m => FixmeM m ()
-refchanUpdate = do
-
-  refchanImport
-
-  rchan <- asks fixmeEnvRefChan
-             >>= readTVarIO
-             >>= orThrowUser "refchan not set"
-
-  api   <- getClientAPI @RefChanAPI @UNIX
-
-  sto <- getStorage
-
-  h0 <- callService @RpcRefChanGet api rchan
-         >>= orThrowUser "can't request refchan head"
-
-  rch <-  RefChan.getRefChanHead @L4Proto sto (RefChanHeadKey rchan)
-              >>= orThrowUser "can't request refchan head"
-
-  let w = view refChanHeadWaitAccept rch
-
-  refchanExportGroupKeys
-
-  txn <- refchanExport ()
-
-  unless (txn == 0) do
-
-    notice $ "wait refchan" <+> pretty (AsBase58 rchan) <+> "to update..."
-
-    -- TODO: implement-refchan-update-notifications
-
-    -- FIXME: use-wait-time-from-refchan-head
-
-    -- TODO: fix-this-lame-polling
-    flip fix 0 $ \next -> \case
-      n | n >= w -> pure ()
-      n  -> do
-
-        h <- callService @RpcRefChanGet api rchan
-               >>= orThrowUser "can't request refchan head"
-
-        if h0 /= h then
-          pure ()
-        else do
-          pause @'Seconds 1
-          liftIO $ hPutStr stderr (show $ pretty (w - n) <> "    \r")
-          next (succ n)
-
-    none
-
-  refchanImport
-
-refchanImport :: FixmePerks m => FixmeM m ()
-refchanImport = do
-
-  sto <- getStorage
-
-  chan <- asks fixmeEnvRefChan
-           >>= readTVarIO
-           >>= orThrowUser "refchan not set"
-
-
-  ttsmap  <- newTVarIO HM.empty
-  accepts <- newTVarIO HM.empty
-
-  tq <- newTQueueIO
-
-  ignCached <- asks fixmeEnvFlags >>= readTVarIO <&> HS.member FixmeIgnoreCached
-
-  let goodToGo x | ignCached = pure True
-                 | otherwise  = do
-        here <- selectIsAlreadyScanned x
-        pure $ not here
-
-  fixmeGkSign <- putBlock sto "FIXMEGROUPKEYBLOCKv1" <&> fmap HashRef
-                    >>= orThrowUser "hbs2 storage error. aborted"
-
-  walkRefChanTx @UNIX goodToGo chan $ \txh u -> do
-
-    case  u of
-
-      A (AcceptTran (Just ts) _ what) -> do
-        debug $ red "ACCEPT" <+> pretty ts <+> pretty what
-        atomically $ modifyTVar ttsmap (HM.insertWith max what (coerce @_ @Word64 ts))
-        atomically $ modifyTVar accepts (HM.insertWith (<>) what (HS.singleton txh))
-
-        scanned <- selectIsAlreadyScanned what
-        when scanned do
-           withState $ insertScanned txh
-
-      A _  -> none
-
-      P1 ppk orig (ProposeTran _ box) -> void $ runMaybeT do
-        (_, bs) <- unboxSignedBox0 box & toMPlus
-
-        AnnotatedHashRef sn href <- deserialiseOrFail @AnnotatedHashRef (LBS.fromStrict bs)
-                                    & toMPlus . either (const Nothing) Just
-
-        scanned <- lift $ selectIsAlreadyScanned href
-
-        when (not scanned || ignCached) do
-
-          let isGk = sn == Just fixmeGkSign
-
-          if isGk then do
-
-            atomically $ writeTQueue tq (Left (txh, orig, href, href))
-
-          else do
-            what <- liftIO (runExceptT $ getTreeContents sto href)
-                      <&> either (const Nothing) Just
-                      >>= toMPlus
-
-            let exported = deserialiseOrFail @[FixmeExported] what
-                              & either (const Nothing) Just
-
-            case exported of
-              Just e -> do
-                for_ e $ \x -> do
-                  atomically $ writeTQueue tq (Right (txh, orig, href, x))
-
-              Nothing -> do
-                lift $ withState $ insertScanned txh
-
-  imported <- atomically $ flushTQueue tq
-
-  withState $ transactional do
-    for_ imported $ \case
-      Left (txh, orig, href, gk) -> do
-        -- hx <- writeAsMerkle sto (serialise gk)
-        -- notice $ "import GK" <+> pretty hx <+> "from" <+> pretty href
-        -- let tx = AnnotatedHashRef _ href <- deserialiseOrFail @AnnotatedHashRef (LBS.fromStrict bs)
-        --                             & toMPlus . either (const Nothing) Just
-        insertScanned txh
-        -- TODO: ASAP-notify-hbs2-keyman
-        --   у нас два варианта:
-        --     1. звать runKeymanClient и в нём записывать в БД
-        --        с возможностью блокировок
-        --     2. каким-то образом делать отложенную запись,
-        --        например, писать лог групповых ключей
-        --        куда-то, откуда hbs2-keyman сможет
-        --        обновить их при запуске
-        --
-        --        лог групповых ключей мы можем писать:
-        --          1.  в рефлог, на который подписан и кейман
-        --          2.  в рефчан, на который подписан и кейман
-        --                неожиданные плюсы:
-        --                  + у нас уже есть такой рефчан!
-        --                    всё, что надо сделать  -- это записать ключи туда
-        --                    с одной стороны туповато: перекладывать транзы из
-        --                    рефчана в рефчан. с другой стороны -- не нужны никакие
-        --                    новые механизмы. рефчан, в общем-то, локальный(?),
-        --                    блоки никуда за пределы хоста не поедут (?) и сеть
-        --                    грузить не будут (?)
-        --
-        --          3.  в рефчан, используя notify
-        --          4.  в еще какую переменную, которая будет
-        --              локальна
-        --          5.  в какой-то лог. который кейман будет
-        --              процессировать при hbs2-keyman update
-        --
-        --      поскольку БД кеймана блокируется целиком при апдейтах,
-        --      единственное, куда писать проблематично -- это сама БД.
-        --
-        pure ()
-
-      Right (txh, h, href, i) -> do
-        w <- readTVarIO ttsmap <&> fromMaybe (exportedWeight i) . HM.lookup h
-        let item = i { exportedWeight = w }
-
-        if exportedWeight item /= 0 then do
-          notice $ "import" <+> pretty (exportedKey item) <+> pretty (exportedWeight item)
-          insertFixmeExported (localNonce (href,i)) item
-        else do
-          debug $ "SKIP TX!" <+> pretty txh
-
-        atx <- readTVarIO accepts <&> fromMaybe mempty . HM.lookup h
-        insertScanned txh
-        insertScanned href
-        for_ atx insertScanned
-
-
-
-
-refchanExportGroupKeys :: FixmePerks m => FixmeM m ()
-refchanExportGroupKeys = do
-
-  let gkHash x = hashObject @HbSync ("GKSCAN" <> serialise x) & HashRef
-
-  sto <- getStorage
-
-  chan <- asks fixmeEnvRefChan
-           >>= readTVarIO
-           >>= orThrowUser "refchan not set"
-
-  ignCached <- asks fixmeEnvFlags >>= readTVarIO <&> HS.member FixmeIgnoreCached
-
-  let goodToGo x | ignCached = pure True
-                 | otherwise = do
-        here <- selectIsAlreadyScanned (gkHash x)
-        pure $ not here
-
-  debug "refchanExportGroupKeys"
-
-  skip <- newTVarIO HS.empty
-  gkz <- newTVarIO HS.empty
-
-  fixmeSign <- putBlock sto "FIXMEGROUPKEYBLOCKv1" <&> fmap HashRef
-
-  walkRefChanTx @UNIX goodToGo chan $ \txh u -> do
-
-    case u of
-      P orig (ProposeTran _ box) -> void $ runMaybeT do
-        (_, bs) <- unboxSignedBox0 box & toMPlus
-
-        AnnotatedHashRef _ href <- deserialiseOrFail @AnnotatedHashRef (LBS.fromStrict bs)
-                                    & toMPlus . either (const Nothing) Just
-
-        result <- lift $ try @_ @OperationError  (getGroupKeyHash href)
-
-        case result of
-          Right (Just gk,_) -> do
-            atomically do
-              modifyTVar gkz  (HS.insert gk)
-              modifyTVar skip (HS.insert txh)
-
-          Right (Nothing,_) -> do
-            atomically $ modifyTVar skip (HS.insert txh)
-
-          Left UnsupportedFormat -> do
-            debug $ "unsupported" <+> pretty href
-            atomically $ modifyTVar skip (HS.insert txh)
-
-          Left e -> do
-             debug $ "other error" <+> viaShow e
-
-      _ -> none
-
-  l <- readTVarIO skip <&> HS.toList
-  r <- readTVarIO gkz <&> HS.toList
-
-  withState $ transactional do
-    for_ l (insertScanned . gkHash)
-
-  rchan <- asks fixmeEnvRefChan
-             >>= readTVarIO
-             >>= orThrowUser "refchan not set"
-
-  api   <- getClientAPI @RefChanAPI @UNIX
-
-  rch <-  RefChan.getRefChanHead @L4Proto sto (RefChanHeadKey rchan)
-              >>= orThrowUser "can't request refchan head"
-
-  au <- asks fixmeEnvAuthor
-           >>= readTVarIO
-           >>= orThrowUser "author's key not set"
-
-  creds <- runKeymanClientRO $ loadCredentials au
-             >>= orThrowUser "can't read credentials"
-
-
-  let (pk,sk) = (view peerSignPk creds, view peerSignSk creds)
-
-  keyz <- Set.fromList <$> S.toList_ do
-    for_ r $ \gkh -> void $ runMaybeT do
-
-      debug $ red $ "FOR GK" <+> pretty gkh
-
-      gk <- loadGroupKeyMaybe @'HBS2Basic sto gkh >>= toMPlus
-
-      -- the original groupkey should be indexed as well
-      lift $ S.yield gkh
-
-      gks <- liftIO (runKeymanClientRO $ findMatchedGroupKeySecret sto gk)
-
-      when (isNothing gks) do
-      --   lift $ withState (insertScanned (gkHash txh))
-        warn $ "unaccessible group key" <+> pretty gkh
-        mzero
-
-      gk1 <- generateGroupKey @'HBS2Basic gks (HS.toList $ view refChanHeadReaders rch)
-      let lbs = serialise gk1
-      gkh1 <- writeAsMerkle sto lbs  <&> HashRef
-      debug $  red "prepare new gk0" <+> pretty (LBS.length lbs) <+> pretty gkh <+> pretty (groupKeyId gk)
-      lift $ S.yield gkh1
-
-  notice $ yellow $ "new gk:" <+> pretty (Set.size keyz)
-
-  -- let nitems = 262144 `div` (125 * HS.size (view refChanHeadReaders rch) )
-  -- let chunks = Map.elems keyz & chunksOf nitems
-
-  -- TODO: gk:performance-vs-reliability
-  --   ситуация такова: групповой ключ это меркл-дерево
-  --   для одного и того же блоба могут быть разные меркл-деревья,
-  --   так как могут быть разные настройки.
-  --
-  --   если распространять ключи по-одному, то хотя бы тот же ключ,
-  --   который мы создали изначально -- будет доступен по своему хэшу,
-  --   как отдельный артефакт.
-  --
-  --   Если писать их пачками, где каждый ключ представлен непосредственно,
-  --   то на принимающей стороне нет гарантии, что меркл дерево будет писаться
-  --   с таким же параметрами, хотя и может.
-  --
-  --   Решение:  делать групповой ключ БЛОКОМ. тогда его размер будет ограничен,
-  --   но он хотя бы будет всегда однозначно определён хэшем.
-  --
-  --   Решение: ссылаться не на групповой ключ, а на хэш его секрета
-  --   что ломает текущую схему и обратная совместимость будет морокой.
-  --
-  --   Решение: добавить в hbs2-keyman возможно индексации единичного
-  --   ключа, и индексировать таким образом *исходные* ключи.
-  --
-  --   Тогда можно эти вот ключи писать пачками, их хэши не имеют особого значения,
-  --   если мы проиндексируем оригинальный ключ и будем знать, на какой секрет он
-  --   ссылается.
-  --
-  --   Заметим, что в один блок поместится аж >2000 читателей, что должно быть
-  --   более, чем достаточно => при таких группах вероятность утечки секрета
-  --   стремится к 1.0, так как большинство клало болт на меры безопасности.
-  --
-  --   Кстати говоря, проблема недостаточного количества авторов в ключе легко
-  --   решается полем ORIGIN, т.к мы можем эти самые ключи разделять.
-  --
-  --   Что бы не стоять перед такой проблемой, мы всегда можем распостранять эти ключи
-  --   по-одному, ЛИБО добавить в производный ключ поле
-  --   ORIGIN: где будет хэш изначального ключа.
-  --
-  --   Это нормально, так как мы сможем проверить, что у этих ключей
-  --   (текущий и ORIGIN) одинаковые хэши секретов.
-  --
-  --   Это всё равно оставляет возможность еще одной DoS атаки на сервис,
-  --   с распространением кривых ключей, но это хотя бы выяснимо, ну и атака
-  --   может быть только в рамках рефчана, т.е лечится выкидыванием пиров /
-  --   исключением зловредных авторов.
-
-  for_ (Set.toList keyz) $ \href -> do
-
-      let tx = AnnotatedHashRef fixmeSign href
-
-      let lbs = serialise tx
-
-      let box = makeSignedBox @'HBS2Basic @BS.ByteString pk sk (LBS.toStrict lbs)
-
-      warn $ "post gk tx" <+> "tree" <+> pretty href
-
-      result <- callRpcWaitMay @RpcRefChanPropose (TimeoutSec 1) api (chan, box)
-
-      when (isNothing result) do
-        err $ red "hbs2-peer rpc calling timeout"
-
-
--- a/fixme-new/lib/Fixme/Run/Internal/RefChan.hs
+++ b/fixme-new/lib/Fixme/Run/Internal/RefChan.hs
@ -1,284 +0,0 @@
-{-# Language MultiWayIf #-}
-module Fixme.Run.Internal.RefChan (fixmeRefChanInit) where
-
-import Prelude hiding (init)
-import Fixme.Prelude hiding (indent)
-import Fixme.Types
-import Fixme.Config
-
-import HBS2.OrDie
-import HBS2.Base58
-import HBS2.Net.Auth.GroupKeySymm
-import HBS2.Data.Types.SignedBox
-import HBS2.Peer.Proto.RefChan as RefChan
-import HBS2.Storage.Operations.ByteString
-import HBS2.System.Dir
-import HBS2.Net.Auth.Credentials
-
-import HBS2.CLI.Run.KeyMan (keymanNewCredentials)
-import HBS2.KeyMan.Keys.Direct
-
-
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.Either
-import Data.Maybe
-import Data.List qualified as List
-import Data.HashSet qualified as HS
-import Data.HashMap.Strict qualified as HM
-import Text.InterpolatedString.Perl6 (qc)
-import Lens.Micro.Platform
-import System.Process.Typed
-import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe
-import Data.Word
-import System.IO qualified as IO
-
-{- HLINT ignore "Functor law"-}
-
-notEmpty :: [a] -> Maybe [a]
-notEmpty = \case
-  [] -> Nothing
-  x  -> Just x
-
-
-data RefChanInitFSM =
-    InitInit
-  | SetupNewRefChan
-  | SetupExitFailure
-  | CheckRefChan (PubKey 'Sign 'HBS2Basic)
-  | RefChanHeadFound (PubKey 'Sign 'HBS2Basic) (RefChanHeadBlock L4Proto)
-  | WaitRefChanHeadStart (PubKey 'Sign 'HBS2Basic) Word64
-  | WaitRefChanHead (PubKey 'Sign 'HBS2Basic) Word64
-
-fixmeRefChanInit :: FixmePerks m => Maybe (PubKey 'Sign 'HBS2Basic) -> FixmeM m ()
-fixmeRefChanInit mbRc = do
-   let rch0 = refChanHeadDefault @L4Proto
-   sto <- getStorage
-   peer <- getClientAPI @PeerAPI @UNIX
-   rchanApi <- getClientAPI @RefChanAPI @UNIX
-
-   dir <- localConfigDir
-   confFile <- localConfig
-
-   rchan <- asks fixmeEnvRefChan
-              >>= readTVarIO
-
-   poked <- callRpcWaitMay @RpcPoke (TimeoutSec 1) peer ()
-              >>= orThrowUser "hbs2-peer not connected"
-              <&> parseTop
-              <&> fromRight mempty
-
-   pkey <- [ fromStringMay @(PubKey 'Sign 'HBS2Basic) x
-           | ListVal [SymbolVal "peer-key:", StringLike x ] <- poked
-           ] & headMay . catMaybes & orThrowUser "hbs2-peer key not set"
-
-
-   let refChanClause r = mkList @C [ mkSym "refchan"
-                                   , mkSym (show $ pretty (AsBase58 r))
-                                   ]
-
-   flip runContT pure $ callCC \done -> do
-
-    flip fix InitInit $ \next -> \case
-      InitInit -> do
-
-        case (rchan, mbRc) of
-          (Nothing, Nothing) -> next SetupNewRefChan
-          (_, Just r2)  -> next (CheckRefChan r2)
-          (Just r1, Nothing) -> next (CheckRefChan r1)
-
-      CheckRefChan rc -> do
-        notice $ "check refchan:" <+> pretty (AsBase58 rc)
-
-        notice $ "subscribe to refchan" <+> pretty (AsBase58 rc)
-
-        -- FIXME: poll-time-hardcode
-        --   $class: hardcode
-        void $ callService @RpcPollAdd peer (rc, "refchan", 17)
-
-        notice $ "fetch refchan head" <+> pretty (AsBase58 rc)
-        void $ lift $ callRpcWaitMay  @RpcRefChanHeadFetch (TimeoutSec 1) rchanApi rc
-
-        now <- liftIO $ getPOSIXTime <&> round
-        pause @'Seconds 1
-        next $ WaitRefChanHead rc now
-
-      WaitRefChanHeadStart rc t -> do
-        notice $ "wait for refchan head" <+> pretty (AsBase58 rc)
-        next (WaitRefChanHead rc t)
-
-      WaitRefChanHead rc t -> do
-        now <- liftIO $ getPOSIXTime <&> round
-        let s = 60 - (now -t)
-        hd <- getRefChanHead @L4Proto sto (RefChanHeadKey rc)
-
-        liftIO $ IO.hPutStr stderr $ show $ "waiting" <+> pretty s <+> "      \r"
-
-        if | now - t < 60 && isNothing hd -> do
-             pause @'Seconds 1
-             next $ WaitRefChanHead rc t
-
-           | now - t > 60 && isNothing hd -> do
-             err "refchan wait timeout"
-             next $ SetupExitFailure
-
-           | isJust hd -> do
-              next $ RefChanHeadFound rc (fromJust hd)
-
-           | otherwise -> next $ SetupExitFailure
-
-      RefChanHeadFound rc hd -> do
-        notice $ "found refchan head for" <+> pretty (AsBase58 rc)
-        void $ lift $ callRpcWaitMay  @RpcRefChanFetch (TimeoutSec 1) rchanApi rc
-
-        author <- lift $ asks fixmeEnvAuthor >>= readTVarIO
-
-        let readers = view refChanHeadReaders hd
-        let authors = view refChanHeadAuthors hd
-
-        -- hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs
-        rs <- liftIO (runKeymanClientRO $ loadKeyRingEntries (HS.toList readers))
-
-        let isReader = case rs of
-                           [] -> False
-                           _  -> True
-
-        let canRead = if isReader then
-                        green "yes"
-                      else
-                        red "no"
-
-        notice $ "reader:" <+> canRead
-
-        let isAuthor = maybe1 author False (`HS.member` authors)
-
-        let canWrite = if isAuthor
-                        then green "yes"
-                        else red "no"
-
-        notice $ "author:" <+> canWrite
-
-        unless isReader do
-          warn $ yellow "no reader key found" <> line
-                 <>  "it's may be ok, if this refchan is not encrypted" <> line
-                 <>  "otherwise, make your encryption key a member of this refchan head"
-                 <> line
-
-        unless isAuthor do
-          warn $ red "no author key found" <> line
-                 <>  "it's may be ok if you have only read-only access to this refchan" <> line
-                 <>  "otherwise, use" <+> yellow "author KEY" <+> "settings in the .fixme-new/config" <> line
-                 <>  "and make sure it is added to the refchan head"
-                 <> line
-
-        unless (isJust rchan) do
-          notice $ "adding refchan to" <+> pretty confFile
-          liftIO do
-            appendFile confFile $ show $
-                line
-                <> vcat [ pretty (refChanClause rc) ]
-
-      SetupExitFailure -> do
-        err "refchan init failed"
-
-      SetupNewRefChan -> do
-
-        notice $ green "default peer" <+> pretty (AsBase58 pkey)
-
-        signK' <- lift $ runKeymanClientRO $ listCredentials
-                <&> headMay
-
-        signK <- ContT $ maybe1 signK' (throwIO $ userError "no default author key found in hbs2-keyman")
-
-        notice $ green "default author" <+> pretty (AsBase58 signK)
-
-        -- TODO: use-hbs2-git-api?
-        (_, gkh', _) <- readProcess (shell [qc|git hbs2 key|])
-                         <&> over _2 (  (fromStringMay @HashRef)  <=< (notEmpty . headDef "" . lines . LBS8.unpack) )
-                         <&> \x ->  case view _1 x of
-                               ExitFailure _ -> set _2 Nothing x
-                               ExitSuccess   -> x
-
-        notice $ green "group key" <+> maybe "none" pretty gkh'
-
-        readers <- fromMaybe mempty <$> runMaybeT do
-                     gh <- toMPlus gkh'
-                     gk <- loadGroupKeyMaybe @'HBS2Basic sto gh
-                              >>= toMPlus
-                     pure $ HM.keys (recipients gk)
-
-        notice $ green "readers" <+> pretty (length readers)
-
-        rk <- lift $ runKeymanClientRO $ loadKeyRingEntries readers
-                <&> fmap snd . headMay
-
-
-        let rch1 = rch0 & set refChanHeadReaders (HS.fromList readers)
-                        & set refChanHeadAuthors (HS.singleton signK)
-                        & set refChanHeadPeers   (HM.singleton pkey 1)
-
-
-        let unlucky =    HM.null (view refChanHeadPeers rch1)
-                      || HS.null (view refChanHeadAuthors rch1)
-
-        liftIO $ print $ pretty rch1
-
-        if unlucky then do
-           warn $ red $ "refchan definition is not complete;" <+>
-                        "you may add missed keys, edit the"   <+>
-                        "defition and add if manually or repeat init attempt"
-                        <> line
-        else do
-           notice "refchan definition seems okay, adding new refchan"
-
-           refchan <- lift $ keymanNewCredentials (Just "refchan") 0
-
-           creds <- lift $ runKeymanClientRO $ loadCredentials refchan
-                          >>= orThrowUser "can't load credentials"
-
-           let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch1
-
-           href <- writeAsMerkle sto  (serialise box)
-
-           callService @RpcPollAdd peer (refchan, "refchan", 17)
-               >>= orThrowUser "can't subscribe to refchan"
-
-           callService @RpcRefChanHeadPost rchanApi (HashRef href)
-               >>= orThrowUser "can't post refchan head"
-
-
-           let nonce = take 6 $ show $ pretty (AsBase58 refchan)
-           let rchanFile = "refchan-" <> nonce <> ".local"
-           let rchanFilePath = dir </> rchanFile
-
-           let note =    ";; author and reader are inferred automatically" <> line
-                      <> ";; from hbs2-keyman data" <> line
-                      <> ";; edit them if needed" <> line
-                      <> ";; reader is *your* reading public key." <> line
-                      <> ";; author is *your* signing public key." <> line
-
-           let theirReaderKeyClause = maybe1 rk ";; reader ..."$ \(KeyringEntry pk _ _) -> do
-                  pretty $ mkList @C [ mkSym "reader", mkSym (show $ pretty (AsBase58 pk) )  ]
-
-           let theirAuthorClause  = mkList @C [ mkSym "author", mkSym (show $ pretty (AsBase58 signK) ) ]
-
-           let content =    line
-                         <> note
-                         <> line
-                         <> vcat [ theirReaderKeyClause
-                                 , pretty theirAuthorClause
-                                 ]
-
-           liftIO do
-             writeFile rchanFilePath $
-               show content
-
-           notice $ "adding refchan to" <+> pretty confFile
-           liftIO do
-             appendFile confFile $ show $
-                 line
-                 <> vcat [ pretty (refChanClause refchan) ]
-
-           next $ CheckRefChan refchan
-
-
--- a/fixme-new/lib/Fixme/Scan.hs
+++ b/fixme-new/lib/Fixme/Scan.hs
@ -1,250 +0,0 @@
-{-# Language MultiWayIf #-}
-module Fixme.Scan
-  ( scanBlobOpts
-  , scanBlob
-  , scanMagic
-  , updateScanMagic
-  , NoIndents(..)
-  ) where
-
-import Fixme.Prelude hiding (indent)
-import Fixme.Types
-
-import Data.ByteString.Lazy.Char8 (ByteString)
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.Text qualified as Text
-import Data.Text.Encoding (decodeUtf8With)
-import Data.Text.Encoding.Error (ignore)
-import Data.Char (isSpace)
-
-import Data.Maybe
-import Data.HashSet qualified as HS
-import Data.HashMap.Strict qualified as HM
-import Data.Coerce
-
-import Data.Generics.Product.Fields (field)
-import Lens.Micro.Platform
-import Text.InterpolatedString.Perl6 (qc)
-
-import Streaming.Prelude qualified as S
-
-{- HLINT ignore "Functor law" -}
-
-
-data SfEnv =
-  SfEnv { lno :: Int  -- ^ line number
-        , l0  :: Int  -- ^ fixme indent
-        , eln :: Int  -- ^ empty lines counter
-        }
-        deriving stock Generic
-
-
-succEln :: SfEnv -> ByteString -> SfEnv
-succEln f s | LBS8.null s = over (field @"eln") succ f
-            | otherwise = set (field @"eln") 0 f
-
-data Sx = S0 | Sf SfEnv
-
-data S = S Sx [(Int,ByteString)]
-
-
-data FixmePart = FixmePart Int FixmeWhat
-                 deriving stock (Show,Data,Generic)
-
-data FixmeWhat = FixmeHead Int Int Text Text
-               | FixmeLine Text
-               | FixmeAttr FixmeAttrName FixmeAttrVal
-                 deriving stock (Show,Data,Generic)
-
-data P = P0 [FixmePart] | P1 Int Fixme [FixmePart]
-
-
-scanMagic :: FixmePerks m => FixmeM m HashRef
-scanMagic = do
-  env <- ask
-  w <- atomically do
-         tagz <- fixmeEnvTags env          & readTVar
-         co   <- fixmeEnvDefComments  env  & readTVar
-         fco  <- fixmeEnvFileComments env  & readTVar
-         m    <- fixmeEnvFileMask env      & readTVar
-         e    <- fixmeEnvFileExclude env   & readTVar
-         a    <- fixmeEnvAttribs env       & readTVar
-         v    <- fixmeEnvAttribValues env  & readTVar
-
-         pure $ serialise (tagz, co, fco, m, e, a, v)
-  pure $ HashRef $ hashObject w
-
-updateScanMagic :: (FixmePerks m) => FixmeM m ()
-updateScanMagic = do
-  t <- asks fixmeEnvScanMagic
-  magic <- scanMagic
-  atomically $ writeTVar t (Just magic)
-
-class IsScanBlobOptions a where
-  ignoreIndents :: a -> Bool
-
-data NoIndents = NoIndents
-
-instance IsScanBlobOptions () where
-  ignoreIndents = const False
-
-instance IsScanBlobOptions NoIndents where
-  ignoreIndents = const True
-
-scanBlob ::  forall m . (FixmePerks m)
-         => Maybe FilePath
-         -> ByteString
-         -> FixmeM m [Fixme]
-
-scanBlob = scanBlobOpts ()
-
-
-scanBlobOpts ::  forall o m . (IsScanBlobOptions o, FixmePerks m)
-             => o
-             -> Maybe FilePath
-             -> ByteString
-             -> FixmeM m [Fixme]
-
-scanBlobOpts o fpath lbs = do
-
-  let indents = not (ignoreIndents o)
-
-  tagz <- asks fixmeEnvTags
-              >>= readTVarIO
-              <&> HS.toList
-              <&> fmap (Text.unpack . coerce)
-              <&> filter (not . null)
-              <&> fmap LBS8.pack
-
-  comments <- fixmeGetCommentsFor fpath
-                <&> filter (not . LBS8.null) . fmap (LBS8.pack . Text.unpack)
-
-  anames  <- asks fixmeEnvAttribs >>= readTVarIO <&> HS.toList
-
-  let setters = [ ( LBS8.pack [qc|${show $ pretty n}:|], n ) | n <- anames ]
-
-  let ls = LBS8.lines lbs & zip [0..]
-
-  parts <- S.toList_ do
-
-      flip fix (S S0 ls) $ \next -> \case
-        S S0 ((lno,x):xs) -> do
-
-          (l,bs)  <- eatPrefix0 Nothing comments x
-
-          let mtag = headMay [ t | t <- tagz, LBS8.isPrefixOf t bs ]
-
-          case mtag of
-            Nothing ->
-              next (S S0 xs)
-
-            Just tag -> do
-              emitFixmeStart lno l tag (LBS8.drop (LBS8.length tag) bs)
-              next (S (Sf (SfEnv lno l 0)) xs)
-
-        S sf@(Sf env@(SfEnv{..})) (x : xs) -> do
-
-          (li,bs)  <- eatPrefix0 (Just l0) comments (snd x)
-
-          if | eln > 1 -> next (S S0 (x:xs))
-
-             | indents && li <= l0 && not (LBS8.null bs) -> next (S S0 (x:xs))
-
-             | otherwise -> do
-
-                let stripped = LBS8.dropWhile isSpace bs
-                let attr = headMay [ (s, LBS8.drop (LBS8.length a) stripped)
-                                   | (a,s) <- setters, LBS8.isPrefixOf a stripped
-                                   ]
-
-                case attr of
-                  Just (a,v) -> do
-                    let vv = LBS8.toStrict v & decodeUtf8With ignore & Text.strip
-                    emitFixmeAttr (fst x) l0 a (FixmeAttrVal vv)
-                  Nothing -> do
-                    emitFixmeLine (fst x) l0 bs
-
-                next (S (Sf (succEln env bs)) xs)
-
-        S _ [] -> pure ()
-  -- debug $ vcat (fmap viaShow parts)
-
-  S.toList_ do
-    flip fix (P0 parts) $ \next -> \case
-
-        (P0 (FixmePart l h@FixmeHead{} : rs)) -> do
-          next (P1 l (fromHead h) rs)
-
-        (P1 _ fx (FixmePart l h@FixmeHead{} : rs)) -> do
-          emitFixme fx
-          next (P1 l (fromHead h) rs)
-
-        (P1 _ fx (FixmePart lno (FixmeLine what) : rs)) -> do
-          next (P1 lno (setLno lno $ over (field @"fixmePlain") (<> [FixmePlainLine what]) fx) rs)
-
-        (P1 _ fx (FixmePart lno (FixmeAttr a v) : rs)) -> do
-          next (P1 lno (setLno lno $ over (field @"fixmeAttr") (<> HM.singleton a v) fx) rs)
-
-        (P1 _ fx []) -> emitFixme fx
-        (P0 ( _ : rs ) ) -> next (P0 rs)
-        (P0 []) -> pure ()
-
-  where
-
-    setLno lno fx@Fixme{} = do
-      let lno1 = Just (FixmeOffset (fromIntegral lno))
-      set (field @"fixmeEnd") lno1 fx
-
-    emitFixme e = do
-      S.yield $ over (field @"fixmePlain") dropEmpty e
-      where
-        dropEmpty = dropWhile $ \case
-          FixmePlainLine "" -> True
-          _                 -> False
-
-    -- FIXME: jopakita
-    fromHead = \case
-      FixmeHead lno  _ tag title ->
-          Fixme (FixmeTag tag)
-                (FixmeTitle title)
-                mempty
-                Nothing
-                (Just (FixmeOffset (fromIntegral lno)))
-                Nothing
-                mempty
-                mempty
-
-      _ -> mempty
-
-    emitFixmeStart lno lvl tagbs restbs = do
-      let tag  = decodeUtf8With ignore  (LBS8.toStrict tagbs) & Text.strip
-      let rest = decodeUtf8With ignore  (LBS8.toStrict restbs) & Text.strip
-      S.yield (FixmePart lno (FixmeHead lno lvl tag rest))
-
-    emitFixmeAttr lno _ name val = do
-      S.yield (FixmePart lno (FixmeAttr name val))
-
-    emitFixmeLine lno _ restbs = do
-      let rest = decodeUtf8With ignore  (LBS8.toStrict restbs) & Text.stripEnd
-      S.yield (FixmePart lno (FixmeLine rest))
-
-    eatPrefix0 lim' comments x = do
-      over _2 LBS8.pack <$> do
-
-        flip fix (0, LBS8.unpack x) $ \next w@(k, left) -> do
-
-          let lim = fromMaybe (succ k) lim'
-
-          if k > lim then
-            pure (k, left)
-          else
-            case w of
-              (n, ' '  : rest) -> next (n+1, if k == lim then ' ' : rest else rest)
-              (n, '\t' : rest) -> next (n+8, if k == lim then '\t' : rest else rest)
-
-              (n, rest) -> do
-                let comm = headMay [ co | co <- comments, LBS8.isPrefixOf co (LBS8.pack rest) ]
-                case comm of
-                  Nothing -> pure (n, rest)
-                  Just co -> next (n+1, drop (fromIntegral $ LBS8.length co) rest)
-
--- a/fixme-new/lib/Fixme/Scan/Git/Local.hs
+++ b/fixme-new/lib/Fixme/Scan/Git/Local.hs
@ -1,369 +0,0 @@
-{-# Language MultiWayIf #-}
-{-# Language PatternSynonyms #-}
-{-# Language ViewPatterns #-}
-module Fixme.Scan.Git.Local where
-
-
-import Prelude hiding (init)
-import Fixme.Prelude hiding (indent)
-import Fixme.Types
-import Fixme.State
-import Fixme.Scan as Scan
-
-import HBS2.Storage
-import HBS2.Storage.Compact
-import HBS2.System.Dir
-import HBS2.Git.Local.CLI
-
-import DBPipe.SQLite hiding (field)
-import Data.Config.Suckless
-import Data.Text.Fuzzy.Tokenize
-
-import Data.ByteString.Char8 qualified as BS
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.ByteString.Lazy (ByteString)
-import Data.Either
-import Data.Fixed
-import Data.List qualified as List
-import Data.List.Split (chunksOf)
-import Data.Maybe
-import Data.HashMap.Strict (HashMap)
-import Data.HashMap.Strict qualified as HM
-import Data.HashSet qualified as HS
-import Data.HashSet (HashSet)
-import Data.Text qualified as Text
-import Data.Text.Encoding (decodeUtf8With)
-import Data.Text.Encoding.Error (ignore)
-import Data.Word
-import Text.InterpolatedString.Perl6 (qc)
-import Data.Coerce
-import Data.Generics.Product.Fields (field)
-import Lens.Micro.Platform
-import System.Process.Typed
-import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe
-import System.IO qualified as IO
-import System.IO.Temp (emptySystemTempFile)
-import System.TimeIt
-
-import Data.Map qualified as Map
-
-import Streaming.Prelude qualified as S
-
-
-{- HLINT ignore "Functor law" -}
-
-
-listCommits :: FixmePerks m => FixmeM m [(GitHash, HashMap FixmeAttrName FixmeAttrVal)]
-listCommits = do
-  gd <- fixmeGetGitDirCLIOpt
-
-  days <- asks fixmeEnvGitScanDays
-            >>= readTVarIO
-            <&> fmap ( \x -> "--since" <+> squotes (pretty x <+> "days ago"))
-            <&> fromMaybe mempty
-            <&> show
-
-  let cmd = [qc|git {gd} log --all --format="%H '%cn' '%ce' %ct" {days}|]
-
-  debug $ yellow "listCommits" <+> pretty cmd
-
-  gitRunCommand cmd
-    <&> fromRight mempty
-    <&> LBS8.lines
-    <&> mapMaybe extract
-
-  where
-    extract :: ByteString -> Maybe (GitHash, HashMap FixmeAttrName FixmeAttrVal)
-    extract lbs = do
-      let txt = decodeUtf8With ignore (LBS8.toStrict lbs)
-      let r = tokenize @Text spec txt
-      case r of
-        [co, n, e, t] -> do
-          let gh = fromStringMay @GitHash (Text.unpack co)
-
-          let bag = [ ("commit", co)
-                    , ("commit-time", t)
-                    , ("committer-name", n)
-                    , ("committer-email", e)
-                    , ("committer", [qc|{n} <{e}>|])
-                    ] & fmap ( over _1 FixmeAttrName . over _2 FixmeAttrVal)
-                      & HM.fromList
-
-          (,) <$> gh <*> pure bag
-
-        _ -> Nothing
-
-    spec = sq <> delims " \t"
-
-listBlobs :: (FixmePerks m, MonadReader FixmeEnv m) => Maybe GitHash -> m [(FilePath,GitHash)]
-listBlobs mco = do
-  gd <- fixmeGetGitDirCLIOpt
-
-  let what = maybe "HEAD" (show . pretty) mco
-
-  gitRunCommand [qc|git {gd} ls-tree -r -l -t {what}|]
-    <&> fromRight mempty
-    <&> fmap LBS8.words . LBS8.lines
-    <&> mapMaybe
-          (\case
-             [a,"blob",h,_,fn] -> (LBS8.unpack fn,) <$> fromStringMay @GitHash (LBS8.unpack h)
-             _                 -> Nothing)
-
-filterBlobs0 :: FixmePerks m
-            => [(Bool,FilePattern)]
-            -> [(FilePath,GitHash)]
-            -> FixmeM m [(FilePath,GitHash)]
-
-filterBlobs0 pat xs = do
-  -- pat <- asks fixmeEnvFileMask >>= readTVarIO <&> fmap (True,)
-  let src = [ ((f,h),f) | (f,h) <- xs ]
-  let r = [(h,f) | (_,(f,h),_) <- matchMany pat src] & HM.fromList & HM.toList
-  pure $ [ (b,a) | (a,b) <- r ]
-
-filterBlobs :: FixmePerks m
-            => [(FilePath,GitHash)]
-            -> FixmeM m [(FilePath,GitHash)]
-
-filterBlobs xs = do
-  pat <- asks fixmeEnvFileMask >>= readTVarIO <&> fmap (True,)
-  filterBlobs0 pat xs
-
-listRelevantBlobs :: FixmePerks m
-                  => FixmeM m [(FilePath, GitHash)]
-listRelevantBlobs =  do
-  commits <- listCommits
-  S.toList_ $ do
-    for_ commits $ \(co, _) -> do
-      found <- lift $ listBlobs (Just co) >>= filterBlobs
-      S.each found
-
-listFixmies :: FixmePerks m
-            => FixmeM m [Fixme]
-listFixmies = do
-
-  flip runContT pure do
-
-      blobs <- lift listRelevantBlobs
-
-      gitCat <- ContT $ bracket startGitCatFile (hClose . getStdin)
-
-      let ssin   = getStdin gitCat
-      let ssout  = getStdout gitCat
-
-      liftIO $ IO.hSetBuffering ssin LineBuffering
-
-      for_ blobs $ \(fp,h) -> do
-        liftIO $ IO.hPrint ssin (pretty h) >> IO.hFlush ssin
-        prefix <- liftIO (BS.hGetLine ssout) <&> BS.words
-
-        case prefix of
-          [bh, "blob", ssize] -> do
-            let mslen = readMay @Int (BS.unpack ssize)
-            len <- ContT $ maybe1 mslen (pure ())
-            blob <- liftIO $ LBS8.hGet ssout len
-            void $ liftIO $ BS.hGetLine ssout
-
-            poor <- lift (Scan.scanBlob (Just fp) blob)
-
-            liftIO $ mapM_ (print . pretty) poor
-
-          _ -> pure ()
-
-
-
-  pure mempty
-
-
-gitListStage :: (FixmePerks m)
-             => FixmeM m [Either (FilePath, GitHash) (FilePath, GitHash)]
-gitListStage = do
-  gd <- fixmeGetGitDirCLIOpt
-  modified <- gitRunCommand [qc|git {gd} status --porcelain|]
-                <&> fromRight mempty
-                <&> fmap LBS8.words . LBS8.lines
-                <&> mapMaybe ( \case
-                       ["M", fn] -> Just (LBS8.unpack fn)
-                       _         -> Nothing
-                    )
-
-  new <- S.toList_ $ do
-            for_ modified $ \fn -> void $ runMaybeT do
-
-              e <- gitRunCommand [qc|git {gd} hash-object {fn}|]
-                     >>= toMPlus
-                     <&> maybe mempty LBS8.unpack . headMay . LBS8.words
-                     <&> fromStringMay @GitHash
-                     >>= toMPlus
-
-              lift (S.yield $ (fn,e))
-
-  old <- gitRunCommand [qc|git {gd} ls-files -s|]
-          <&> fromRight mempty
-          <&> fmap LBS8.words . LBS8.lines
-          <&> mapMaybe ( \case
-                [_, h, _, fn] -> (LBS8.unpack fn,) <$> fromStringMay @GitHash (LBS8.unpack h)
-                _             -> Nothing
-                )
-
-  new1 <- filterBlobs new <&> fmap Left
-  old1 <- filterBlobs old <&> fmap Right
-
-  pure (old1 <> new1)
-
-
-getMetaDataFromGitBlame :: FixmePerks m => FilePath -> Fixme -> FixmeM m Fixme
-getMetaDataFromGitBlame f fx0 = do
-  gd <- fixmeGetGitDirCLIOpt
-  fromMaybe mempty <$> runMaybeT do
-    l0 <- fixmeStart fx0 & toMPlus <&> fromIntegral <&> succ
-    let cmd = [qc|git {gd} blame {f} -L{l0},{l0} -t -l -p|]
-
-    s0 <- gitRunCommand cmd
-             <&> LBS8.unpack . fromRight mempty
-
-    s <- parseTop s0 & toMPlus
-
-    let ko = headMay (words <$> lines s0)
-                   >>= headMay
-                   >>= (\z -> do
-                         if z == "0000000000000000000000000000000000000000"
-                           then Nothing
-                           else Just z )
-                   >>= fromStringMay @GitHash
-
-    pieces <- for s $ \case
-      ListVal (SymbolVal "committer" : StringLikeList  w) | isJust ko -> do
-        let co = FixmeAttrVal $ fromString $ unwords w
-        pure $ mempty { fixmeAttr = HM.singleton "committer-name" co }
-
-      ListVal (SymbolVal "committer-mail" : StringLikeList  w) | isJust ko -> do
-        let co = FixmeAttrVal $ fromString $ unwords w
-        pure $ mempty { fixmeAttr = HM.singleton "committer-email" co }
-
-      ListVal [SymbolVal "committer-time", TimeStampLike t] | isJust ko  -> do
-        let ct = FixmeAttrVal $ fromString $ show t
-        pure $ mempty { fixmeAttr = HM.singleton "commit-time" ct, fixmeTs = Just t }
-
-      _ -> pure mempty
-
-    let coco = mempty { fixmeAttr = maybe mempty (HM.singleton "commit" . fromString . show . pretty) ko }
-
-    pure $ mconcat pieces <> coco
-
-gitExtractFileMetaData :: FixmePerks m => [FilePath] -> FixmeM m (HashMap FilePath Fixme)
-gitExtractFileMetaData fns = do
-  -- FIXME: magic-number
-  let chunks = chunksOf 64 fns
-
-  gd <- fixmeGetGitDirCLIOpt
-
-  commitz <- S.toList_ $ for_ chunks $ \chu -> do
-      let filez = unwords chu
-      let cmd = [qc|git {gd} log --diff-filter=AMR --pretty=format:'entry %H %at "%an" "%ae"' -- {filez}|]
-      ss <- gitRunCommand cmd
-             <&> fromRight mempty
-             <&> fmap LBS8.unpack . LBS8.lines
-
-      for_ ss $ \s -> do
-        let syn = parseTop s & fromRight mempty
-        case syn of
-          [ListVal [SymbolVal "entry", SymbolVal (Id e), LitIntVal t, StringLike n, StringLike m]] -> do
-            -- liftIO $ print $ pretty e <+> pretty syn
-            S.yield (fromString @GitHash (Text.unpack e), (t,n,m) )
-
-          _ -> pure ()
-
-  let co = HM.fromList commitz
-             & HM.toList
-
-  rich0 <- S.toList_ $ do
-    for_ co $ \(c, (t,n,m)) -> do
-      let pat = [ (True, f) | f <- fns ]
-      blobz <- lift $ listBlobs (Just c) >>= filterBlobs0 pat
-
-      for_ blobz $ \(f,h) -> do
-        let attr = HM.fromList [ ("commit",          FixmeAttrVal (fromString $ show $ pretty c))
-                               , ("commit-time",     FixmeAttrVal (fromString $ show $ pretty t))
-                               , ("committer-name",  FixmeAttrVal (fromString n))
-                               , ("committer-email", FixmeAttrVal (fromString m))
-                               , ("committer",       FixmeAttrVal (fromString $ [qc|{n} <{m}>|]))
-                               , ("file",            FixmeAttrVal (fromString f))
-                               , ("blob",            FixmeAttrVal (fromString $ show $ pretty $ h))
-                               ]
-        let what = mempty { fixmeAttr = attr }
-        S.yield (f,t,what)
-
-  let rich = List.sortBy (\a b -> compare (view _2 a) (view _2 b)) rich0
-
-  pure $ HM.fromList [ (view _1 w, view _3 w) | w <- rich ]
-
-
-data GitBlobInfo = GitBlobInfo FilePath GitHash
-                   deriving stock (Eq,Ord,Data,Generic,Show)
-
-instance Hashable GitBlobInfo
-
-data GitIndexEntry =
-       GitCommit Word64 (HashSet GitBlobInfo)
-       deriving stock (Eq,Ord,Data,Generic,Show)
-
-instance Serialise GitBlobInfo
-instance Serialise GitIndexEntry
-
-listCommitForIndex :: forall m . (FixmePerks m, MonadReader FixmeEnv m) => ( (GitHash, GitIndexEntry) -> m ()) -> m ()
-listCommitForIndex fn = do
-
-  gd <- fixmeGetGitDirCLIOpt
-  let cmd = [qc|git {gd} log --all --format="%H %ct"|]
-
-  debug $ yellow "listCommits" <+> pretty cmd
-
-  s0 <- gitRunCommand cmd
-    <&> fromRight mempty
-    <&> fmap (words . LBS8.unpack) . LBS8.lines
-    <&> mapMaybe ( \case
-         [a,b] -> (,) <$> fromStringMay @GitHash a <*> makeIndexEntry0 a b
-         _     -> Nothing
-         )
-
-  for_ s0 $ \(h, GitCommit w _) -> do
-    blobz <- listBlobs (Just h) <&> HS.fromList . fmap ( uncurry GitBlobInfo  )
-    fn (h, GitCommit w blobz)
-
-  where
-    makeIndexEntry0 _ t = GitCommit <$> readMay t <*> pure mempty
-
-gitCatBlob :: (FixmePerks m, MonadReader FixmeEnv m) => GitHash -> m ByteString
-gitCatBlob h = do
-  gd <- fixmeGetGitDirCLIOpt
-  (_,s,_)  <- readProcess $ shell [qc|git {gd} cat-file blob {pretty h}|]
-  pure s
-
-
-startGitHash ::  (FixmePerks m, MonadReader FixmeEnv m) => m (Process Handle Handle ())
-startGitHash = do
-  gd <- fixmeGetGitDirCLIOpt
-  let cmd = [qc|git {gd} hash-object --stdin-paths|]
-  debug $ pretty cmd
-  let config = setStdin createPipe $ setStdout createPipe $ setStderr closed $ shell cmd
-  startProcess config
-
-gitHashPathStdin :: FixmePerks m => (Process Handle Handle e) -> FilePath -> FixmeM m (Maybe GitHash)
-gitHashPathStdin prc file  = do
-  let ssin = getStdin prc
-  let sout = getStdout prc
-  liftIO $ IO.hPutStrLn ssin file >> IO.hFlush ssin
-  liftIO (IO.hGetLine sout) <&> fromStringMay @GitHash
-
-startGitCatFile ::  (FixmePerks m, MonadReader FixmeEnv m) => m (Process Handle Handle ())
-startGitCatFile = do
-  gd <- fixmeGetGitDirCLIOpt
-  let cmd = [qc|git {gd} cat-file --batch|]
-  debug $ pretty cmd
-  let config = setStdin createPipe $ setStdout createPipe $ setStderr closed $ shell cmd
-  -- ssin <- getStdin config
-  startProcess config
-
-
-
--- a/fixme-new/lib/Fixme/State.hs
+++ b/fixme-new/lib/Fixme/State.hs
@ -1,599 +0,0 @@
-{-# LANGUAGE PatternSynonyms, ViewPatterns #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Fixme.State
-  ( evolve
-  , withState
-  , cleanupDatabase
-  , listFixme
-  , countFixme
-  , countByAttribute
-  , insertFixme
-  , insertFixmeExported
-  , modifyFixme
-  , insertScannedFile
-  , insertScanned
-  , selectIsAlreadyScannedFile
-  , selectIsAlreadyScanned
-  , listAllScanned
-  , selectFixmeKey
-  , getFixme
-  , insertTree
-  , FixmeExported(..)
-  , HasPredicate(..)
-  , SelectPredicate(..)
-  , HasLimit(..)
-  , HasItemOrder(..)
-  , ItemOrder(..)
-  , Reversed(..)
-  , LocalNonce(..)
-  , WithLimit(..)
-  , QueryOffset(..)
-  , QueryLimit(..)
-  , QueryLimitClause(..)
-  ) where
-
-import Fixme.Prelude hiding (key)
-import Fixme.Types
-import Fixme.Config
-
-import HBS2.Base58
-import HBS2.System.Dir
-import DBPipe.SQLite hiding (field)
-
-import Data.HashSet (HashSet)
-import Data.HashSet qualified as HS
-import Data.Aeson as Aeson
-import Data.ByteString.Lazy qualified as LBS
-import Data.HashMap.Strict qualified as HM
-import Text.InterpolatedString.Perl6 (qc)
-import Data.Text qualified as Text
-import Data.Text.Encoding qualified as Text
-import Data.Maybe
-import Data.List qualified as List
-import Control.Monad.Trans.Maybe
-import Data.Coerce
-import Data.Word (Word64)
-import System.Directory (getModificationTime)
-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
-
-- TODO: runPipe-omitted
--   runPipe нигде не запускается, значит, все изменения
--   будут закоммичены в БД только по явному вызову
--   commitAll или transactional
--   это может объясняеть некоторые артефакты.
--   Но это и удобно: кажется, что можно менять БД
--   на лету бесплатно
-
-
-newtype SomeHash h = SomeHash { fromSomeHash :: h }
-                     deriving newtype (IsString)
-
-instance Pretty (AsBase58 h) => ToField (SomeHash h) where
-  toField (SomeHash h) = toField ( show $ pretty (AsBase58 h))
-
-instance IsString (SomeHash h) => FromField (SomeHash h) where
-  fromField = fmap fromString . fromField @String
-
-pattern Operand :: forall {c} . Text -> Syntax c
-pattern Operand what <- (operand -> Just what)
-
-pattern BinOp :: forall {c} . Id -> Syntax c
-pattern BinOp what <- (binOp -> Just what)
-
-binOp :: Syntax c -> Maybe Id
-binOp = \case
-  SymbolVal "~"  -> Just "like"
-  SymbolVal "&&" -> Just "and"
-  SymbolVal "||" -> Just "or"
-  _              -> Nothing
-
-operand :: Syntax c -> Maybe Text
-operand = \case
-  SymbolVal c -> Just (coerce c)
-  LitStrVal s -> Just s
-  LitIntVal i -> Just (Text.pack (show i))
-  LitScientificVal v -> Just (Text.pack (show v))
-  _ -> Nothing
-
-
-instance ToField HashRef where
-  toField x = toField $ show $ pretty x
-
-instance FromField HashRef where
-  fromField = fmap (fromString @HashRef) . fromField @String
-
-evolve :: FixmePerks m => FixmeM  m ()
-evolve = do
-  dbPath <- localDBPath
-  debug $ "evolve" <+> pretty dbPath
-  mkdir (takeDirectory dbPath)
-  withState do
-    createTables
-
-withState :: forall m a . (FixmePerks m, MonadReader FixmeEnv m) => DBPipeM m a ->  m a
-withState what = do
-  lock <- asks fixmeLock
-
-  db <- withMVar lock $ \_ -> do
-          t <- asks fixmeEnvDb
-          mdb <- readTVarIO t
-          case mdb of
-            Just d  -> pure (Right d)
-            Nothing -> do
-              path <- localDBPath
-              newDb <- try @_ @IOException (newDBPipeEnv dbPipeOptsDef path)
-              case newDb of
-                Left e   -> pure (Left e)
-                Right db -> do
-                  debug "set-new-db"
-                  atomically $ writeTVar t (Just db)
-                  pure $ Right db
-
-  either throwIO (`withDB` what) db
-
-createTables :: FixmePerks m => DBPipeM m ()
-createTables = do
-
-  -- ddl [qc| create table if not exists tree
-  --          ( hash   text not null
-  --          , nonce  text not null
-  --          , primary key (hash,nonce)
-  --          )
-  --        |]
-
-  ddl [qc| create table if not exists scanned
-           ( hash text not null primary key )
-         |]
-
-  ddl [qc| create table if not exists object
-           ( o   text    not null
-           , w   integer not null
-           , k   text    not null
-           , v   blob    not null
-           , nonce text  null
-           , primary key (o,k)
-           )
-         |]
-
-
-class HasPredicate a where
-  predicate :: a -> SelectPredicate
-
-class HasLimit a where
-  limit :: a -> Maybe QueryLimitClause
-
-data ItemOrder = Direct | Reverse
-
-class HasItemOrder a where
-  itemOrder :: a -> ItemOrder
-  itemOrder = const Direct
-
-newtype Reversed a = Reversed a
-
-instance HasItemOrder (Reversed a) where
-  itemOrder = const Reverse
-
-- TODO: move-to-db-pipe?
-newtype QueryOffset = QueryOffset Word64
-                      deriving newtype (Show,Eq,Ord,Num,Enum,Integral,Real,ToField,FromField,Pretty)
-
-- TODO: move-to-db-pipe?
-newtype QueryLimit = QueryLimit Word64
-                      deriving newtype (Show,Eq,Ord,Num,Enum,Integral,Real,ToField,FromField,Pretty)
-
-type QueryLimitClause = (QueryOffset, QueryLimit)
-
-instance HasLimit () where
-  limit _ = Nothing
-
-data WithLimit q = WithLimit (Maybe QueryLimitClause) q
-
-instance HasItemOrder q => HasItemOrder (WithLimit q) where
-  itemOrder (WithLimit _ q) = itemOrder q
-
-instance HasItemOrder [Syntax c] where
-  itemOrder = const Direct
-
-instance HasItemOrder () where
-  itemOrder = const Direct
-
-instance HasPredicate q => HasPredicate (WithLimit q) where
-  predicate (WithLimit _ query) = predicate query
-
-instance HasLimit (WithLimit a) where
-  limit (WithLimit l _) = l
-
-instance HasPredicate q => HasPredicate (Reversed q) where
-  predicate (Reversed q) = predicate q
-
-instance HasLimit q => HasLimit (Reversed q) where
-  limit (Reversed q) = limit q
-
-data SelectPredicate =
-    All
-  | FixmeHashExactly Text
-  | AttrLike Text Text
-  | And SelectPredicate SelectPredicate
-  | Or SelectPredicate SelectPredicate
-  | Not SelectPredicate
-  | Ignored
-  deriving stock (Data,Generic,Show)
-
-
-instance HasPredicate () where
-  predicate = const All
-
-instance HasPredicate SelectPredicate where
-  predicate = id
-
-instance IsContext c => HasPredicate [Syntax c] where
-  predicate s = goPred $ unlist $ go s
-    where
-
-      goPred :: Syntax c -> SelectPredicate
-      goPred = \case
-        ListVal [SymbolVal "not", a]     ->  Not (goPred a)
-        ListVal [SymbolVal "or", a, b]   ->  Or (goPred a) (goPred b)
-        ListVal [SymbolVal "and", a, b]  ->  And (goPred a) (goPred b)
-        ListVal [SymbolVal "like", StringLike a, StringLike b] ->  AttrLike (Text.pack a) (Text.pack b)
-        _ -> Ignored
-
-      go :: [Syntax c] -> Syntax c
-      go = \case
-
-        ( SymbolVal "!" : rest ) -> do
-            mkList [mkSym "not", unlist (go rest)]
-
-        ( Operand a : SymbolVal "~" : Operand b  : rest ) -> do
-          go (mkList [mkSym "like", mkStr a, mkStr b] : rest)
-
-        ( w : SymbolVal "&&" : rest ) -> do
-          mkList [mkSym "and", unlist w, unlist (go rest)]
-
-        ( w : SymbolVal "||" : rest ) -> do
-          mkList [mkSym "or", unlist w, unlist (go rest)]
-
-        w -> mkList w
-
-      unlist = \case
-        ListVal [x] -> x
-        x -> x
-
-
-{- HLINT ignore "Functor law" -}
-{- HLINT ignore "Eta reduce" -}
-
-data Bound = forall a . (ToField a, Show a) => Bound a
-
-instance ToField Bound where
-  toField (Bound x) = toField x
-
-instance Show Bound where
-  show (Bound x) = show x
-
-genPredQ  :: Text -> SelectPredicate -> (Text, [Bound])
-genPredQ tbl what = go what
-  where
-    go = \case
-      All -> ("true", mempty)
-
-      FixmeHashExactly x ->
-        ([qc|(o.o = ?)|], [Bound x])
-
-      AttrLike name val -> do
-        let x = val <> "%"
-        let binds = [Bound x]
-        ([qc|(json_extract({tbl}.blob, '$."{name}"') like ?)|], binds)
-
-      Not a -> do
-        let (sql, bound) = go a
-        ([qc|(coalesce(not {sql},true))|], bound)
-
-      And a b -> do
-        let (asql, abound) = go a
-        let (bsql, bbound) = go b
-        ([qc|{asql} and {bsql}|], abound <> bbound)
-
-      Or a b -> do
-        let asql = go a
-        let bsql = go b
-        ([qc|{fst asql} or {fst bsql}|], snd asql <> snd bsql)
-
-      Ignored -> ("true", mempty)
-
-
-cleanupDatabase :: (FixmePerks m, MonadReader FixmeEnv m) => m ()
-cleanupDatabase = do
-  warn $ red "cleanupDatabase"
-  withState $ transactional do
-    update_ [qc|delete from object|]
-    update_ [qc|delete from scanned|]
-
-scannedKey :: (FixmePerks m, MonadReader FixmeEnv m) => Fixme -> m HashRef
-scannedKey fme = do
-  magic <- asks fixmeEnvScanMagic >>= readTVarIO
-  let file = fixmeAttr fme & HM.lookup "file"
-  let w  = fixmeTs fme
-  pure $ hashObject @HbSync ( serialise (magic,w,file) ) & HashRef
-
-scannedKeyForFile :: (FixmePerks m, MonadReader FixmeEnv m) => FilePath-> m HashRef
-scannedKeyForFile  file = do
-  dir <- fixmeWorkDir
-  magic <- asks fixmeEnvScanMagic >>= readTVarIO
-  let fn = dir </> file
-  w <- liftIO $ getModificationTime fn <&> round . utcTimeToPOSIXSeconds
-  pure $ hashObject @HbSync ( serialise (magic,w,file) ) & HashRef
-
-selectIsAlreadyScannedFile :: (FixmePerks m, MonadReader FixmeEnv m) => FilePath -> m Bool
-selectIsAlreadyScannedFile file = do
-  k <- scannedKeyForFile file
-  selectIsAlreadyScanned k
-
-selectIsAlreadyScanned :: (FixmePerks m, MonadReader FixmeEnv m) => HashRef -> m Bool
-selectIsAlreadyScanned k = withState do
-  what <- select @(Only Int) [qc|select 1 from scanned where hash = ? limit 1|] (Only k)
-  pure $ not $ List.null what
-
-
-insertTree :: FixmePerks m => HashRef -> FixmeKey -> FixmeAttrName -> DBPipeM m ()
-insertTree h o k = do
-  insert [qc|  insert into tree (hash,o,k)
-               values (?,?,?)
-               on conflict (hash,o,k) do nothing
-         |] (h,o,k)
-
-listAllScanned :: (FixmePerks m, MonadReader FixmeEnv m) => m (HashSet HashRef)
-listAllScanned = withState do
-  select_ [qc|select hash from scanned|] <&> HS.fromList . fmap ( fromSomeHash . fromOnly )
-
-insertScannedFile :: (FixmePerks m, MonadReader FixmeEnv m) => FilePath -> DBPipeM m ()
-insertScannedFile file = do
-  k <- lift $ scannedKeyForFile file
-  insertScanned k
-
-insertScanned:: (FixmePerks m) => HashRef -> DBPipeM m ()
-insertScanned k = do
-  insert [qc| insert into scanned (hash)
-              values(?)
-              on conflict (hash) do nothing|]
-         (Only k)
-
-selectFixmeKey :: (FixmePerks m, MonadReader FixmeEnv m) => Text -> m (Maybe FixmeKey)
-selectFixmeKey s = do
-  withState do
-    select @(Only FixmeKey) [qc|select distinct(o) from object where o like ? order by w desc|] (Only (s<>"%"))
-       <&> fmap fromOnly
-       <&> headMay
-
-
-sqliteToAeson :: FromJSON a => Text -> Maybe a
-sqliteToAeson = Aeson.decode . LBS.fromStrict . Text.encodeUtf8
-
-
-countFixme :: (FixmePerks m, MonadReader FixmeEnv m) => m Int
-countFixme = do
-
-  let present = [qc|coalesce(json_extract(s1.blob, '$.deleted'),'false') <> 'true' |] :: String
-
-  let sql = [qc|
-    with s1 as (
-      select cast (json_insert(json_group_object(o.k, o.v), '$.w', max(o.w)) as text) as blob
-      from object o
-      group by o.o
-    )
-    select count(s1.blob) from s1
-    where
-      {present}
-    |]
-
-  debug $ pretty sql
-
-  withState $ select_ @_ @(Only Int) sql
-    <&> maybe 0 fromOnly . headMay
-
-
-countByAttribute :: ( FixmePerks m
-                    , MonadReader FixmeEnv m
-                    )
-                 => FixmeAttrName
-                 -> m [(FixmeAttrVal, Int)]
-countByAttribute name = do
-  let sql = [qc|
-
-
-    select v, count(1) from object o
-    where not exists
-      ( select null from object o1
-        where o1.o = o.o
-          and o1.k = 'deleted' and o1.v == 'true'
-      )
-    and o.k = ?
-    group by v
-
-    |]
-
-  withState $ select sql (Only name)
-
-listFixme :: ( FixmePerks m
-             , MonadReader FixmeEnv m
-             , HasPredicate q
-             , HasLimit q
-             , HasItemOrder q
-             )
-          => q
-          -> m [Fixme]
-listFixme expr = do
-
-  let (w,bound) = genPredQ "s1" (predicate expr)
-
-  let present = [qc|and coalesce(json_extract(s1.blob, '$.deleted'),'false') <> 'true' |] :: String
-
-  let (limitClause, lbound) = case limit expr of
-                                 Just (o,l) -> ([qc|limit ? offset ?|] :: String, [Bound l, Bound o])
-                                 Nothing -> (mempty, [])
-
-  let o = case itemOrder expr of
-            Direct  -> "asc" :: String
-            Reverse -> "desc"
-
-  let sql = [qc|
-    with s1 as (
-      select cast (json_insert(json_group_object(o.k, o.v), '$.fixme-timestamp', cast(max(o.w) as text)) as text) as blob
-      from object o
-      group by o.o
-    )
-    select s1.blob from s1
-    where
-      {w}
-      {present}
-    order by
-        json_extract(s1.blob, '$.commit-time') {o} nulls last,
-        json_extract(s1.blob, '$.w') {o} nulls last
-    {limitClause}
-    |]
-
-  debug $ pretty sql
-
-  withState $ select @(Only Text) sql (bound <> lbound)
-        <&> fmap (sqliteToAeson . fromOnly)
-        <&> catMaybes
-
-getFixme :: (FixmePerks m, MonadReader FixmeEnv m) => FixmeKey -> m (Maybe Fixme)
-getFixme key = do
-
-  let sql = [qc|
-    select cast (json_insert(json_group_object(o.k, o.v), '$.fixme-timestamp', cast(max(o.w) as text)) as text) as blob
-    from object o
-    where o.o = ?
-    group by o.o
-    limit 1
-    |]
-
-  runMaybeT do
-
-    lift (withState $ select @(Only Text) sql (Only key))
-      <&> fmap (sqliteToAeson . fromOnly)
-      <&> catMaybes
-      <&> headMay
-      >>= toMPlus
-
-
-modifyFixme :: (FixmePerks m)
-            => FixmeKey
-            -> [(FixmeAttrName, FixmeAttrVal)]
-            -> FixmeM m ()
-modifyFixme o a' = do
-  FixmeEnv{..} <- ask
-
-  attrNames <- readTVarIO fixmeEnvAttribs
-  values    <- readTVarIO fixmeEnvAttribValues
-
-  now <- liftIO getPOSIXTime <&> fromIntegral . round
-
-  let a = [ (k,v) | (k,v) <- a'
-          , k `HS.member` attrNames
-          , not (HM.member k values) || v `HS.member` fromMaybe mempty (HM.lookup k values)
-          ]
-
-  let w = mempty { fixmeAttr = HM.fromList a, fixmeKey = o, fixmeTs = Just now }
-
-  withState $ insertFixme w
-
-insertFixme :: (FixmePerks m, MonadReader FixmeEnv m) => Fixme -> DBPipeM m ()
-insertFixme fme = do
-
-  void $ runMaybeT do
-
-    let o = fixmeKey fme
-    w   <-  fixmeTs fme & toMPlus
-    let attrs   = fixmeAttr fme
-    let txt = fixmePlain fme & Text.unlines . fmap coerce
-
-    let sql = [qc|
-      insert into object (o, w, k, v)
-      values (?, ?, ?, ?)
-      on conflict (o, k)
-      do update set
-        v = case
-              when excluded.w > object.w and (excluded.v <> object.v) then excluded.v
-              else object.v
-            end,
-        w = case
-              when excluded.w > object.w and (excluded.v <> object.v) then excluded.w
-              else object.w
-            end,
-        nonce = case when excluded.w > object.w and (excluded.v <> object.v) then excluded.nonce
-                     else object.nonce
-                end
-      |]
-
-    for_ (fixmeStart fme) $ \s -> do
-      lift $ insert sql (o,w,"fixme-start",s)
-
-    for_ (fixmeEnd fme) $ \s -> do
-      lift $ insert sql (o,w,"fixme-end",s)
-
-    for_ (HM.toList attrs) $ \(k,v) -> do
-      lift $ insert sql (o,w,k,v)
-
-    lift $ insert sql (o,w,"fixme-text",txt)
-
-
-data FixmeExported =
-  FixmeExported
-  { exportedKey    :: FixmeKey
-  , exportedWeight :: Word64
-  , exportedName   :: FixmeAttrName
-  , exportedValue  :: FixmeAttrVal
-  }
-  deriving stock Generic
-
-instance FromRow FixmeExported
-instance ToRow  FixmeExported
-instance Serialise FixmeExported
-
-class LocalNonce a where
-  localNonce :: a -> HashRef
-
-instance LocalNonce FixmeExported where
-  localNonce FixmeExported{..} =
-    HashRef $ hashObject @HbSync
-            $ serialise (exportedKey,exportedName,exportedValue,exportedWeight)
-
-instance LocalNonce (HashRef, FixmeExported) where
-  localNonce (h, e) =  HashRef $ hashObject @HbSync
-                               $ serialise (h, localNonce e)
-
-data WithNonce a = WithNonce HashRef a
-
-instance ToRow (WithNonce FixmeExported) where
-  toRow (WithNonce nonce f@FixmeExported{..}) = toRow (exportedKey, exportedWeight, exportedName, exportedValue, nonce)
-
-insertFixmeExported :: FixmePerks m => HashRef -> FixmeExported -> DBPipeM m ()
-insertFixmeExported h item = do
-
-  let sql = [qc|
-
-      insert into object (o, w, k, v, nonce)
-      values (?, ?, ?, ?, ?)
-      on conflict (o, k)
-      do update set
-        v = case
-              when excluded.w > object.w  then excluded.v
-              else object.v
-            end,
-        w = case
-              when excluded.w > object.w  then excluded.w
-              else object.w
-            end,
-        nonce = case
-                  when excluded.w > object.w then excluded.nonce
-                  else object.nonce
-                end
-  |]
-
-  insert sql (WithNonce h item)
-  insertScanned h
-
-
--- a/fixme-new/lib/Fixme/Types.hs
+++ b/fixme-new/lib/Fixme/Types.hs
@ -1,759 +0,0 @@
-{-# LANGUAGE PatternSynonyms, ViewPatterns, TemplateHaskell #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Fixme.Types
-  ( module Fixme.Types
-  , module Exported
-  ) where
-
-import Fixme.Prelude hiding (align)
-import HBS2.Base58
-
-import DBPipe.SQLite hiding (field)
-import HBS2.Git.Local
-
-import HBS2.OrDie
-import HBS2.System.Dir
-import HBS2.Storage as Exported
-import HBS2.Peer.CLI.Detect
-import HBS2.Peer.RPC.Client as Exported hiding (encode,decode)
-import HBS2.Peer.RPC.Client.Unix as Exported  hiding (encode,decode)
-import HBS2.Peer.RPC.API.Peer as Exported
-import HBS2.Peer.RPC.API.RefChan as Exported
-import HBS2.Peer.RPC.API.Storage as Exported
-import HBS2.Peer.RPC.Client.StorageClient as Exported
-
-
-import Data.Config.Suckless
-
-import Prettyprinter.Render.Terminal
-import Control.Applicative
-import Data.Aeson as Aeson
-import Data.Aeson.KeyMap as Aeson hiding (null)
-import Data.Aeson.Key qualified as Aeson
-import Data.Aeson.Types as Aeson
-import Data.ByteString (ByteString)
-import Data.ByteString.Char8 qualified as BS8
-import Data.ByteString.Lazy qualified as LBS
-import Data.HashMap.Strict (HashMap)
-import Data.HashMap.Strict qualified as HM
-import Data.HashSet (HashSet)
-import Data.HashSet qualified as HS
-import Data.Word (Word64,Word32)
-import Data.Maybe
-import Data.Coerce
-import Data.Text qualified as Text
-import Data.List qualified as List
-import Data.Map qualified as Map
-import System.FilePath
-import Text.InterpolatedString.Perl6 (qc)
-import Data.Generics.Product.Fields (field)
-import Lens.Micro.Platform
-
-
-data MyPeerClientEndpoints =
-  MyPeerClientEndpoints
-  { _peerSocket      :: FilePath
-  , _peerPeerAPI     :: ServiceCaller PeerAPI UNIX
-  , _peerRefChanAPI  :: ServiceCaller RefChanAPI UNIX
-  , _peerStorageAPI  :: ServiceCaller StorageAPI UNIX
-  }
-
-makeLenses 'MyPeerClientEndpoints
-
-- FIXME: move-to-suckless-conf
-
-pattern FixmeHashLike :: forall {c} . Text -> Syntax c
-pattern FixmeHashLike  e <- (fixmeHashFromSyn -> Just e)
-
-
-pattern TimeStampLike :: forall {c} . FixmeTimestamp -> Syntax c
-pattern TimeStampLike  e <- (tsFromFromSyn -> Just e)
-
-instance MkId FixmeAttrName where
-  mkId (k :: FixmeAttrName) = Id ("$" <> coerce k)
-
-
-
-fixmeHashFromSyn :: Syntax c -> Maybe Text
-fixmeHashFromSyn = \case
-  StringLike s -> do
-    let (_,value) = span (`elem` "#%~:") s
-    Just $ Text.pack value
-
-  _            -> Nothing
-
-tsFromFromSyn :: Syntax c -> Maybe FixmeTimestamp
-tsFromFromSyn = \case
-  LitIntVal n -> Just (fromIntegral n)
-  _ -> Nothing
-
-newtype FixmeTag = FixmeTag { fromFixmeTag :: Text }
-                   deriving newtype (Eq,Ord,Show,IsString,Hashable,Semigroup,Monoid,ToField,FromField,FromJSON,ToJSON)
-                   deriving stock (Data,Generic)
-
-newtype FixmeTitle = FixmeTitle { fromFixmeTitle :: Text }
-                     deriving newtype (Eq,Ord,Show,IsString,Semigroup,Monoid,ToField,FromField,Hashable,FromJSON,ToJSON)
-                     deriving stock (Data,Generic)
-
-newtype FixmePlainLine = FixmePlainLine { fromFixmeText :: Text }
-                         deriving newtype (Eq,Ord,Show,IsString,Semigroup,Monoid,ToField,FromField,FromJSON,ToJSON)
-                         deriving stock (Data,Generic)
-
-
-newtype FixmeAttrName = FixmeAttrName { fromFixmeAttrName :: Text }
-                        deriving newtype (Eq,Ord,Show,IsString,Hashable)
-                        deriving newtype (ToField,FromField)
-                        deriving newtype (ToJSON,FromJSON,ToJSONKey,FromJSONKey)
-                        deriving stock (Data,Generic)
-
-
-newtype FixmeAttrVal = FixmeAttrVal { fromFixmeAttrVal :: Text }
-                        deriving newtype (Eq,Ord,Show,IsString,Hashable,ToField,FromField,ToJSON,FromJSON,Semigroup,Monoid)
-                        deriving stock (Data,Generic)
-
-newtype FixmeTimestamp = FixmeTimestamp Word64
-                        deriving newtype (Eq,Ord,Show,Enum,Num,Integral,Real,ToField,FromField,ToJSON)
-                        deriving stock (Data,Generic)
-
-
-newtype FixmeKey  = FixmeKey Text
-                    deriving newtype (Eq,Ord,Show,ToField,FromField,Pretty,FromJSON,ToJSON,Semigroup,Monoid,IsString)
-                    deriving stock (Data,Generic)
-
-newtype FixmeOffset = FixmeOffset Word32
-                     deriving newtype (Eq,Ord,Show,Num,ToField,FromField,ToJSON)
-                     deriving newtype (Integral,Real,Enum)
-                     deriving stock (Data,Generic)
-
-instance FromStringMaybe FixmeKey where
-  fromStringMay s = pure (fromString s)
-
-
-data Fixme =
-  Fixme
-  { fixmeTag       :: FixmeTag
-  , fixmeTitle     :: FixmeTitle
-  , fixmeKey       :: FixmeKey
-  , fixmeTs        :: Maybe FixmeTimestamp
-  , fixmeStart     :: Maybe FixmeOffset
-  , fixmeEnd       :: Maybe FixmeOffset
-  , fixmePlain     :: [FixmePlainLine]
-  , fixmeAttr      :: HashMap FixmeAttrName FixmeAttrVal
-  }
-  deriving stock (Ord,Eq,Show,Data,Generic)
-
-instance Monoid Fixme where
-  mempty = Fixme mempty mempty mempty Nothing Nothing Nothing mempty mempty
-
-instance Semigroup Fixme where
-  (<>) a b = b { fixmeTs  = fixmeTs b <|> fixmeTs a
-               , fixmeTitle = fixmeAttrNonEmpty (fixmeTitle a) (fixmeTitle b)
-               , fixmeTag   = fixmeAttrNonEmpty (fixmeTag a) (fixmeTag b)
-               , fixmeStart = fixmeStart b <|> fixmeStart a
-               , fixmeEnd = fixmeEnd b <|> fixmeEnd a
-               , fixmePlain = fixmePlain b
-               , fixmeAttr = fixmeAttr a <> fixmeAttr b
-               }
-
-fixmeGet :: FixmeAttrName -> Fixme -> Maybe FixmeAttrVal
-fixmeGet name Fixme{..} = HM.lookup name fixmeAttr
-
-fixmeSet :: FixmeAttrName -> FixmeAttrVal -> Fixme -> Fixme
-fixmeSet name val fx = fx { fixmeAttr = HM.insert name val (fixmeAttr fx) }
-
-instance FromJSON FixmeOffset where
-  parseJSON = \case
-    Number x -> pure (FixmeOffset  (ceiling x))
-
-    String s  -> do
-      n <- maybe (fail "invalid FixmeOffset value") pure (readMay (Text.unpack s))
-      pure $ FixmeOffset n
-
-    _ -> fail "invalid FixmeOffset value"
-
-
-instance FromJSON FixmeTimestamp where
-  parseJSON = \case
-    Number x -> pure (FixmeTimestamp (ceiling x))
-
-    String s  -> do
-      n <- maybe (fail "invalid FixmeOffset value") pure (readMay (Text.unpack s))
-      pure $ FixmeTimestamp n
-
-    _ -> fail "invalid FixmeTimestamp value"
-
-
-instance FromJSON Fixme where
-  parseJSON = withObject "Fixme" $ \o -> do
-    fixmeKey   <- o .:  "fixme-key"
-    fixmeTag   <- o .:  "fixme-tag"
-    fixmeTitle <- o .:  "fixme-title"
-    fixmeStart <- o .:? "fixme-start"
-    fixmeEnd   <- o .:? "fixme-end"
-    fixmeTs    <- o .:? "fixme-timestamp"
-
-    fixmePlainTxt <- o .:? "fixme-text" <&> fromMaybe mempty
-    let fixmePlain = fmap FixmePlainLine (Text.lines fixmePlainTxt)
-
-    let wtf = [ unpackItem k v
-              | (k,v) <- Aeson.toList o
-              , k /= "fixme-text"
-              ] & catMaybes
-
-    let fixmeAttr = HM.fromList wtf
-
-    return Fixme{..}
-
-    where
-      unpackItem k v = do
-        (FixmeAttrName (Aeson.toText k),) <$>
-          case v of
-           String x -> pure (FixmeAttrVal x)
-           Number x -> pure (FixmeAttrVal (Text.pack $ show x))
-           _        -> Nothing
-
-newtype FixmeThin = FixmeThin (HashMap FixmeAttrName FixmeAttrVal)
-                    deriving newtype (Semigroup,Monoid,Eq,Ord,Show,ToJSON,FromJSON)
-                    deriving stock (Data,Generic)
-
-
-
-type FixmePerks m = ( MonadUnliftIO m
-                    , MonadIO m
-                    )
-
-
-data UpdateAction = forall c . IsContext c => UpdateAction { runUpdateAction :: Syntax c -> IO () }
-
-data ReadLogAction = forall c . IsContext c => ReadLogAction { runReadLog :: Syntax c -> IO () }
-
-- FIXME: fucking-context-hardcode-wtf-1
-data CatAction = CatAction { catAction :: [(Id, Syntax C)] -> LBS.ByteString -> IO () }
-
-data SimpleTemplate = forall c . (IsContext c, Data (Context c), Data c) => SimpleTemplate [Syntax c]
-
-class HasSequence w where
-  getSequence :: w -> Word64
-
-newtype FromFixmeKey a = FromFixmeKey a
-
-data CompactAction =
-    Deleted  Word64 HashRef
-  | Modified Word64 HashRef FixmeAttrName FixmeAttrVal
-  | Added    Word64 Fixme
-  deriving stock (Eq,Ord,Show,Generic)
-
-class MkKey a where
-  mkKey :: a -> ByteString
-
-instance MkKey CompactAction where
-  mkKey (Deleted _ h) = "D" <> LBS.toStrict (serialise h)
-  mkKey (Modified _ h _ _) = "M" <> LBS.toStrict (serialise h)
-  mkKey (Added _ fixme) = "A" <> coerce (hashObject @HbSync $ serialise fixme)
-
-instance MkKey (FromFixmeKey Fixme) where
-  mkKey (FromFixmeKey fx@Fixme{..}) =
-    maybe k2  (mappend "A" . LBS.toStrict . serialise) (HM.lookup "fixme-key" fixmeAttr)
-    where k2 = mappend "A" $ serialise fx & LBS.toStrict
-
-instance IsContext c => MkStr c GitHash  where
-  mkStr ha = mkStr (show $ pretty ha)
-
-instance IsContext c => MkStr c GitRef  where
-  mkStr ha = mkStr (show $ pretty ha)
-
-instance IsContext c => MkStr c HashRef  where
-  mkStr ha = mkStr (show $ pretty ha)
-
-instance IsContext c => MkStr c FixmeAttrVal  where
-  mkStr v = mkStr (coerce @_ @Text v)
-
-instance IsContext c => MkStr c (AsBase58 ByteString) where
-  mkStr v = mkStr (show $ pretty v)
-
-instance IsContext c => MkStr c FixmeAttrName  where
-  mkStr v = mkStr (coerce @_ @Text v)
-
-instance Pretty CompactAction where
-  pretty = \case
-    Deleted s r      -> pretty $ mkList @C [ mkSym "deleted", mkInt s, mkStr r  ]
-    Modified s r k v -> pretty $ mkList @C [ mkSym "modified", mkInt s, mkStr r, mkStr k, mkStr v ]
-    -- FIXME: normal-pretty-instance
-    e@(Added  w fx) -> do
-      pretty $ mkList @C [ mkSym "added", mkStr (AsBase58 $ mkKey e) ]
-
-instance Serialise CompactAction
-
-pattern CompactActionSeq :: Word64 -> CompactAction
-pattern CompactActionSeq s <- (seqOf -> Just s)
-
-{-# COMPLETE CompactActionSeq #-}
-
-seqOf :: CompactAction -> Maybe Word64
-seqOf = \case
-  Deleted   w  _ -> Just w
-  Modified  w _ _ _ -> Just w
-  Added w _ -> Just w
-
-instance HasSequence CompactAction where
-  getSequence x = fromMaybe 0 (seqOf x)
-
-data FixmeTemplate =
-  Simple SimpleTemplate
-
-data RenderError = RenderError String
-                   deriving stock (Eq,Show,Typeable)
-
-class FixmeRenderTemplate a b where
-  render :: a -> Either RenderError b
-
-data FixmeOpts =
-  FixmeOpts
-  { fixmeOptNoEvolve :: Bool
-  }
-  deriving stock (Eq,Ord,Show,Data,Generic)
-
-instance Monoid FixmeOpts where
-  mempty = FixmeOpts False
-
-instance Semigroup FixmeOpts where
-  (<>) _ b = FixmeOpts (fixmeOptNoEvolve b)
-
-data PeerNotConnected = PeerNotConnected
-     deriving (Show,Typeable)
-
-instance Exception PeerNotConnected
-
-data FixmeFlags =
-  FixmeIgnoreCached
-  deriving stock (Eq,Ord,Enum,Show,Generic)
-
-instance Hashable FixmeFlags
-  -- hashWithSalt s e = undefined
-
-
-data FixmeEnv =
-  FixmeEnv
-  { fixmeLock              :: MVar ()
-  , fixmeEnvOpts           :: TVar FixmeOpts
-  , fixmeEnvWorkDir        :: TVar FilePath
-  , fixmeEnvDb             :: TVar (Maybe DBPipeEnv)
-  , fixmeEnvGitDir         :: TVar (Maybe FilePath)
-  , fixmeEnvFileMask       :: TVar [FilePattern]
-  , fixmeEnvFileExclude    :: TVar [FilePattern]
-  , fixmeEnvTags           :: TVar (HashSet FixmeTag)
-  , fixmeEnvAttribs        :: TVar (HashSet FixmeAttrName)
-  , fixmeEnvAttribValues   :: TVar (HashMap FixmeAttrName (HashSet FixmeAttrVal))
-  , fixmeEnvDefComments    :: TVar (HashSet Text)
-  , fixmeEnvFileComments   :: TVar (HashMap FilePath (HashSet Text))
-  , fixmeEnvGitScanDays    :: TVar (Maybe Integer)
-  , fixmeEnvScanMagic      :: TVar (Maybe HashRef)
-  , fixmeEnvUpdateActions  :: TVar [UpdateAction]
-  , fixmeEnvReadLogActions :: TVar [ReadLogAction]
-  , fixmeEnvCatAction      :: TVar CatAction
-  , fixmeEnvTemplates      :: TVar (HashMap Id FixmeTemplate)
-  , fixmeEnvMacro          :: TVar (HashMap Id (Syntax C))
-  , fixmeEnvCatContext     :: TVar (Int,Int)
-  , fixmeEnvMyEndpoints    :: TVar (Maybe MyPeerClientEndpoints)
-  , fixmeEnvRefChan        :: TVar (Maybe (PubKey 'Sign 'HBS2Basic))
-  , fixmeEnvAuthor         :: TVar (Maybe (PubKey 'Sign 'HBS2Basic))
-  , fixmeEnvReader         :: TVar (Maybe (PubKey 'Encrypt 'HBS2Basic))
-  , fixmeEnvFlags          :: TVar (HashSet FixmeFlags)
-  }
-  deriving stock (Generic)
-
-fixmeGetCommentsFor :: FixmePerks m => Maybe FilePath -> FixmeM m [Text]
-
-fixmeGetCommentsFor Nothing = do
-  asks fixmeEnvDefComments >>= readTVarIO
-    <&> HS.toList
-
-fixmeGetCommentsFor (Just fp) = do
-  cof <- asks fixmeEnvFileComments >>= readTVarIO
-  def <- asks fixmeEnvDefComments >>= readTVarIO
-
-  let r = maybe mempty HS.toList (HM.lookup (commentKey fp) cof)
-           <> HS.toList def
-
-  pure r
-
-{- HLINT ignore "Functor law" -}
-
-fixmeGetGitDirCLIOpt :: (FixmePerks m, MonadReader FixmeEnv m) => m String
-fixmeGetGitDirCLIOpt = do
-  asks fixmeEnvGitDir
-          >>= readTVarIO
-          <&> fmap (\d -> [qc|--git-dir {d}|])
-          <&> fromMaybe ""
-
-builtinAttribs :: HashSet FixmeAttrName
-builtinAttribs = HS.singleton "deleted"
-
-builtinAttribVals :: HashMap FixmeAttrName (HashSet FixmeAttrVal)
-builtinAttribVals = HM.fromList [("deleted", HS.fromList ["true","false"])]
-
-newtype FixmeM m a = FixmeM { fromFixmeM :: ReaderT FixmeEnv m a }
-                     deriving newtype ( Applicative
-                                      , Functor
-                                      , Monad
-                                      , MonadIO
-                                      , MonadUnliftIO
-                                      , MonadReader FixmeEnv
-                                      )
-
-
-fixmeEnvBare :: forall m .  FixmePerks m => m FixmeEnv
-fixmeEnvBare = do
-  FixmeEnv
-    <$>  newMVar ()
-    <*>  newTVarIO mempty
-    <*>  (pwd >>= newTVarIO)
-    <*>  newTVarIO Nothing
-    <*>  newTVarIO Nothing
-    <*>  newTVarIO mempty
-    <*>  newTVarIO mempty
-    <*>  newTVarIO mempty
-    <*>  newTVarIO builtinAttribs
-    <*>  newTVarIO builtinAttribVals
-    <*>  newTVarIO mempty
-    <*>  newTVarIO defCommentMap
-    <*>  newTVarIO Nothing
-    <*>  newTVarIO mzero
-    <*>  newTVarIO mempty
-    <*>  newTVarIO mempty
-    <*>  newTVarIO (CatAction $ \_ _ -> pure ())
-    <*>  newTVarIO mempty
-    <*>  newTVarIO mempty
-    <*>  newTVarIO (1,3)
-    <*>  newTVarIO mzero
-    <*>  newTVarIO mzero
-    <*>  newTVarIO mzero
-    <*>  newTVarIO mzero
-    <*>  newTVarIO mempty
-
-withFixmeEnv :: FixmePerks m => FixmeEnv -> FixmeM m a -> m a
-withFixmeEnv env what = runReaderT ( fromFixmeM what) env
-
-instance Serialise FixmeTag
-instance Serialise FixmeTitle
-instance Serialise FixmePlainLine
-instance Serialise FixmeAttrName
-instance Serialise FixmeAttrVal
-instance Serialise FixmeTimestamp
-instance Serialise FixmeOffset
-instance Serialise FixmeKey
-instance Serialise Fixme
-
-
-instance (FixmePerks m, MonadReader FixmeEnv m) => HasClientAPI PeerAPI UNIX m where
-  getClientAPI = getApiOrThrow peerPeerAPI
-
-instance (FixmePerks m, MonadReader FixmeEnv m) => HasClientAPI RefChanAPI UNIX m where
-  getClientAPI = getApiOrThrow peerRefChanAPI
-
-instance (FixmePerks m, MonadReader FixmeEnv m) => HasClientAPI StorageAPI UNIX m where
-  getClientAPI = getApiOrThrow peerStorageAPI
-
-
-instance (FixmePerks m) => HasStorage (FixmeM m) where
-  getStorage = do
-    api <- getClientAPI @StorageAPI @UNIX
-    pure $ AnyStorage (StorageClient api)
-
-getApiOrThrow :: (MonadReader FixmeEnv m, MonadIO m)
-              => Getting b MyPeerClientEndpoints b -> m b
-getApiOrThrow getter =
-    asks fixmeEnvMyEndpoints
-      >>= readTVarIO
-      >>= orThrow PeerNotConnected
-      <&> view getter
-
-instance ToField GitHash where
-  toField h = toField (show $ pretty h)
-
-instance ToField GitRef where
-  toField h = toField (show $ pretty h)
-
-instance FromField GitRef where
-  fromField = fmap fromString . fromField @String
-
-instance FromField GitHash where
-  fromField = fmap fromString . fromField @String
-
-instance Pretty FixmeTimestamp where
-  pretty = pretty . coerce @_ @Word64
-
-instance Pretty FixmeOffset where
-  pretty = pretty . coerce @_ @Word32
-
-instance Pretty FixmeAttrName where
-  pretty = pretty . coerce @_ @Text
-
-instance Pretty FixmeAttrVal where
-  pretty = pretty . coerce @_ @Text
-
-instance Pretty FixmeTitle where
-  pretty = pretty . coerce @_ @Text
-
-instance Pretty FixmeTag where
-  pretty = pretty . coerce @_ @Text
-
-instance Pretty FixmePlainLine where
-  pretty = pretty . coerce @_ @Text
-
-instance Pretty Fixme where
-  pretty Fixme{..} =
-    pretty fixmeTag <+> pretty fixmeTitle
-    <> fstart
-    <> fend
-    <> la
-    <> lls
-    <> line
-    where
-
-      fstart = case fixmeStart of
-        Just s  -> line <> pretty ([qc| $fixme-start: {show $ pretty s}|] :: String)
-        Nothing -> mempty
-
-      fend = case fixmeEnd of
-        Just s  -> line <> pretty ([qc| $fixme-end: {show $ pretty s}|] :: String)
-        Nothing -> mempty
-
-      la | not (HM.null fixmeAttr) = do
-            let a = HM.toList fixmeAttr
-            let ss = [ [qc| ${show $ pretty n}: {show $ pretty v}|]  | (n,v) <- a ]  :: [String]
-            line <> vcat ( fmap pretty ss ) <> line
-
-         | otherwise = mempty
-
-      lls | not (null fixmePlain) =  line <> vcat (fmap pretty fixmePlain)
-          | otherwise = mempty
-
-
-defCommentMap :: HashMap FilePath (HashSet Text)
-defCommentMap = HM.fromList
-  [ comment ".cabal"   ["--"]
-  , comment ".hs"      ["--"]
-  , comment ".c"       ["//"]
-  , comment ".h"       ["//"]
-  , comment ".cc"      ["//"]
-  , comment ".cpp"     ["//"]
-  , comment ".cxx"     ["//"]
-  , comment "Makefile" ["#"]
-  ]
-  where
-    comment a b = (a, HS.fromList b)
-
-commentKey :: FilePath -> FilePath
-commentKey fp =
-  case takeExtension fp of
-    "" -> takeFileName fp
-    xs -> xs
-
-type ContextShit c = (Data c, Data (Context c), IsContext c, Data (Syntax c))
-
-
-cc0 :: forall c . ContextShit c => Context c
-cc0 = noContext :: Context c
-
-inject :: forall c  a . (ContextShit c, Data a) => [(Id,Syntax c)] -> a -> a
-inject repl target =
-  flip transformBi target $ \case
-   (SymbolVal x) | issubst x -> fromMaybe mt (Map.lookup x rmap)
-   other -> other
-   where
-    mt = Literal (noContext @c) (LitStr "")
-    rmap = Map.fromList repl
-    issubst (Id x) = Text.isPrefixOf "$" x
-
-pattern NL :: forall {c}. Syntax c
-pattern NL <- ListVal [SymbolVal "nl"]
-
-
-instance FixmeRenderTemplate SimpleTemplate (Doc AnsiStyle) where
-
-  render (SimpleTemplate syn) = Right $ mconcat $
-      flip fix (mempty,syn) $ \next -> \case
-        (acc, NL : rest)    -> next (acc <> nl, rest)
-        (acc, ListVal [StringLike w] : rest) -> next (acc <> txt w, rest)
-        (acc, StringLike w : rest) -> next (acc <> txt w, rest)
-        (acc, ListVal [SymbolVal "trim", LitIntVal n, e] : rest) -> next (acc <> trim n (deep' [e]), rest)
-        (acc, ListVal [SymbolVal "align", LitIntVal n, e] : rest) -> next (acc <> align n (deep' [e]), rest)
-        (acc, ListVal [SymbolVal "fg", SymbolVal co, e] : rest) -> next (acc <> fmap (fg_ (color_ co)) (deep [e]), rest)
-        (acc, ListVal [SymbolVal "bg", SymbolVal co, e] : rest) -> next (acc <> fmap (bg_ (color_ co)) (deep [e]), rest)
-        (acc, ListVal [SymbolVal "fgd", SymbolVal co, e] : rest) -> next (acc <> fmap (fgd_ (color_ co)) (deep [e]), rest)
-        (acc, ListVal [SymbolVal "bgd", SymbolVal co, e] : rest) -> next (acc <> fmap (bgd_ (color_ co)) (deep [e]), rest)
-
-        (acc, ListVal [ SymbolVal "if", cond
-                      , ListVal (SymbolVal "then" : then_)
-                      , ListVal (SymbolVal "else" : else_)
-                      ] : rest) -> do
-
-          let r = case cond of
-                    ListVal [SymbolVal "~", StringLike p, evaluated -> Just x] ->
-                      Text.isPrefixOf (Text.pack p) x
-                    _ -> False
-
-          next (acc <> if r then deep then_ else deep else_, rest)
-
-
-        (acc, ListVal es : rest) ->  next (acc <> deep es, rest)
-        (acc, e : rest) -> next (acc <> p e, rest)
-        (acc, []) -> acc
-
-    where
-
-      evaluated :: (ContextShit c) => Syntax c -> Maybe  Text
-      evaluated what = Just (deep' [what] & Text.concat)
-
-      color_ = \case
-        "black"   -> Just Black
-        "red"     -> Just Red
-        "green"   -> Just Green
-        "yellow"  -> Just Yellow
-        "blue"    -> Just Blue
-        "magenta" -> Just Magenta
-        "cyan"    -> Just Cyan
-        "white"   -> Just White
-        _         -> Nothing
-
-
-      fg_ = maybe id (annotate . color)
-      bg_ = maybe id (annotate . bgColor)
-
-      fgd_ = maybe id (annotate . colorDull)
-      bgd_ = maybe id (annotate . bgColorDull)
-
-      untxt = fmap pretty
-
-      align n0 s0 | n > 0     = untxt [Text.justifyLeft n ' ' s]
-                  | otherwise = untxt [Text.justifyRight (abs n) ' ' s]
-
-        where
-          n = fromIntegral n0
-          s = mconcat s0
-
-      trim n0 s0 | n >= 0     = untxt [ Text.take n s ]
-                 | otherwise  = untxt [ Text.takeEnd (abs n) s ]
-        where
-          n = fromIntegral n0
-          s = mconcat s0
-
-      deep :: forall c . (ContextShit c) => [Syntax c] -> [Doc AnsiStyle]
-      deep sy = either mempty List.singleton (render (SimpleTemplate sy))
-
-      deep' :: forall c . (ContextShit c) => [Syntax c] -> [Text]
-      deep' sy = do
-        let what = deep sy
-        [ Text.pack (show x) | x <- what]
-
-      nl = [ line ]
-      txt s = [fromString s]
-      p e = untxt [Text.pack (show $ pretty e)]
-
-
-instance FixmeRenderTemplate SimpleTemplate Text where
-  render (SimpleTemplate syn) = Right $ Text.concat $
-      flip fix (mempty,syn) $ \next -> \case
-        (acc, NL : rest)    -> next (acc <> nl, rest)
-        (acc, ListVal [StringLike w] : rest) -> next (acc <> txt w, rest)
-        (acc, StringLike w : rest) -> next (acc <> txt w, rest)
-        (acc, ListVal [SymbolVal "trim", LitIntVal n, e] : rest) -> next (acc <> trim n (deep [e]), rest)
-        (acc, ListVal [SymbolVal "align", LitIntVal n, e] : rest) -> next (acc <> align n (deep [e]), rest)
-        (acc, ListVal es : rest) ->  next (acc <> deep es, rest)
-        (acc, e : rest) -> next (acc <> p e, rest)
-        (acc, []) -> acc
-
-    where
-
-      align n0 s0 | n > 0     = [Text.justifyLeft n ' ' s]
-                  | otherwise = [Text.justifyRight (abs n) ' ' s]
-
-        where
-          n = fromIntegral n0
-          s = mconcat s0
-
-      trim n0 s0 | n >= 0     = [ Text.take n s ]
-                 | otherwise  = [ Text.takeEnd (abs n) s ]
-        where
-          n = fromIntegral n0
-          s = mconcat s0
-
-      deep :: forall c . (ContextShit c) => [Syntax c] -> [Text]
-      deep sy = either mempty List.singleton (render (SimpleTemplate sy))
-
-      nl = [ "\n" ]
-      txt s = [fromString s]
-      p e = [Text.pack (show $ pretty e)]
-
-
-newtype ViaSerialise a = ViaSerialise a
-
-instance Serialise a => Hashed HbSync (ViaSerialise a) where
-  hashObject (ViaSerialise x) = hashObject (serialise x)
-
-
-fixmeTitleNonEmpty :: FixmeTitle -> FixmeTitle -> FixmeTitle
-fixmeTitleNonEmpty a b = case (coerce a :: Text, coerce b :: Text) of
-  (x,y) | Text.null x && not (Text.null y) -> FixmeTitle y
-  (x,y) | not (Text.null x) &&  Text.null y -> FixmeTitle x
-  (_,y) -> FixmeTitle y
-
-fixmeAttrNonEmpty :: Coercible a Text => a -> a -> a
-fixmeAttrNonEmpty a b = case (coerce a :: Text, coerce b :: Text) of
-  (x,y) | Text.null x && not (Text.null y) -> b
-  (x,y) | not (Text.null x) &&  Text.null y -> a
-  (_,_) -> b
-
-fixmeDerivedFields :: Fixme -> Fixme
-fixmeDerivedFields fx = do
-  -- TODO: refactor-this-out
-  --   чревато ошибками, надо как-то переписать
-  --   по-человечески.
-  fxEnd
-  <> fx
-  <> fxKey
-  <> fxCo
-  <> tag
-  <> fxLno
-  <> fxTs
-  -- always last
-  <> fxMisc
-  where
-    email = HM.lookup "commiter-email" (fixmeAttr fx)
-              & maybe mempty (\x -> " <" <> x <> ">")
-
-    comitter = HM.lookup "commiter-name" (fixmeAttr fx)
-                 <&> (<> email)
-
-    tag = mempty { fixmeAttr = HM.singleton "fixme-tag" (FixmeAttrVal (coerce $ fixmeTag fx))  }
-
-    key = HM.singleton "fixme-key" (FixmeAttrVal $ coerce $ (fixmeKey fx))
-
-    fxKey = mempty { fixmeAttr = key }
-
-    lno = succ <$> fixmeStart fx <&> FixmeAttrVal . fromString . show
-
-    fxLno = mempty { fixmeAttr = maybe mempty (HM.singleton "line") lno }
-
-    fxE = join $ for (fixmeStart fx) $ \n -> do
-            Just $ FixmeOffset $ fromIntegral $ fromIntegral n + length (fixmePlain fx)
-
-    fxEnd = mempty { fixmeEnd = fxE }
-
-    fxCo =
-      maybe mempty (\c -> mempty { fixmeAttr = HM.singleton "committer" c }) comitter
-
-    fxTs  =
-      maybe mempty (\c -> mempty { fixmeAttr = HM.singleton "fixme-timestamp" (fromString (show c)) }) (fixmeTs fx)
-
-    fxMisc =
-      fx & over (field @"fixmeAttr")
-                (HM.insert "fixme-title" (FixmeAttrVal (coerce (fixmeTitle fx))))
-
-mkFixmeFileName :: FilePath -> Fixme
-mkFixmeFileName fp =
-  mempty { fixmeAttr = HM.singleton "file" (FixmeAttrVal (fromString fp)) }
-
-
--- a/fixme-new/man/man1/fixme-new.1
+++ b/fixme-new/man/man1/fixme-new.1
@ -1 +0,0 @@
-fixme-new manual
--- a/flake.lock
+++ b/flake.lock
@ -1,15 +1,130 @@
 {
  "nodes": {
-    "flake-utils": {
+    "db-pipe": {
      "inputs": {
-        "systems": "systems"
+        "haskell-flake-utils": "haskell-flake-utils",
+        "nixpkgs": [
+          "nixpkgs"
+        ]
      },
      "locked": {
-        "lastModified": 1726560853,
-        "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=",
+        "lastModified": 1708680396,
+        "narHash": "sha256-ZPwDreNdnyCS/hNdaE0OqVhytm+SzZGRfGRTRvBuSzE=",
+        "ref": "refs/heads/master",
+        "rev": "221fde04a00a9c38d2f6c0d05b1e1c3457d5a827",
+        "revCount": 7,
+        "type": "git",
+        "url": "https://git.hbs2.net/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft"
+      },
+      "original": {
+        "type": "git",
+        "url": "https://git.hbs2.net/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft"
+      }
+    },
+    "fixme": {
+      "inputs": {
+        "haskell-flake-utils": "haskell-flake-utils_2",
+        "nixpkgs": [
+          "nixpkgs"
+        ],
+        "suckless-conf": "suckless-conf"
+      },
+      "locked": {
+        "lastModified": 1697356303,
+        "narHash": "sha256-hJbJZtx7gdcXaKL8n5J8b/eVyoYe9VxM+037ZK7q8Gw=",
+        "ref": "refs/heads/master",
+        "rev": "e9b1dcfd78dc766a2255a8125c14b24f0d728c0e",
+        "revCount": 139,
+        "type": "git",
+        "url": "https://git.hbs2.net/Fujv1Uy4W5d9Z7REEArMxbXSJ8nLLn4dYuvaAs8b86hr"
+      },
+      "original": {
+        "type": "git",
+        "url": "https://git.hbs2.net/Fujv1Uy4W5d9Z7REEArMxbXSJ8nLLn4dYuvaAs8b86hr"
+      }
+    },
+    "flake-utils": {
+      "locked": {
+        "lastModified": 1644229661,
+        "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
        "owner": "numtide",
        "repo": "flake-utils",
-        "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a",
+        "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_2": {
+      "locked": {
+        "lastModified": 1644229661,
+        "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_3": {
+      "locked": {
+        "lastModified": 1644229661,
+        "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_4": {
+      "locked": {
+        "lastModified": 1644229661,
+        "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_5": {
+      "locked": {
+        "lastModified": 1644229661,
+        "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    },
+    "flake-utils_6": {
+      "locked": {
+        "lastModified": 1644229661,
+        "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797",
        "type": "github"
      },
      "original": {
@ -20,16 +135,68 @@
    },
    "haskell-flake-utils": {
      "inputs": {
-        "flake-utils": [
-          "flake-utils"
-        ]
+        "flake-utils": "flake-utils"
      },
      "locked": {
-        "lastModified": 1707809372,
-        "narHash": "sha256-wfTL9PlCSOqSSyU4eenFFI7pHrV21gba4GEILnI4nAU=",
+        "lastModified": 1698938553,
+        "narHash": "sha256-oXpTKXioqFbl2mhhvpJIAvgNd+wYyv4ekI+YnJHEJ6s=",
        "owner": "ivanovs-4",
        "repo": "haskell-flake-utils",
-        "rev": "3cbdc5d6093e8b4464ae64097e0c8c61e4414ff2",
+        "rev": "19b273b5dc401a0a565e7f75cf50a593871b80c9",
+        "type": "github"
+      },
+      "original": {
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "type": "github"
+      }
+    },
+    "haskell-flake-utils_2": {
+      "inputs": {
+        "flake-utils": "flake-utils_2"
+      },
+      "locked": {
+        "lastModified": 1672412555,
+        "narHash": "sha256-Kaa8F7nQFR3KuS6Y9WRUxeJeZlp6CCubyrRfmiEsW4k=",
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9",
+        "type": "github"
+      },
+      "original": {
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "type": "github"
+      }
+    },
+    "haskell-flake-utils_3": {
+      "inputs": {
+        "flake-utils": "flake-utils_3"
+      },
+      "locked": {
+        "lastModified": 1672412555,
+        "narHash": "sha256-Kaa8F7nQFR3KuS6Y9WRUxeJeZlp6CCubyrRfmiEsW4k=",
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9",
+        "type": "github"
+      },
+      "original": {
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "type": "github"
+      }
+    },
+    "haskell-flake-utils_4": {
+      "inputs": {
+        "flake-utils": "flake-utils_4"
+      },
+      "locked": {
+        "lastModified": 1698938553,
+        "narHash": "sha256-oXpTKXioqFbl2mhhvpJIAvgNd+wYyv4ekI+YnJHEJ6s=",
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "rev": "19b273b5dc401a0a565e7f75cf50a593871b80c9",
        "type": "github"
      },
      "original": {
@ -39,11 +206,46 @@
        "type": "github"
      }
    },
+    "haskell-flake-utils_5": {
+      "inputs": {
+        "flake-utils": "flake-utils_5"
+      },
+      "locked": {
+        "lastModified": 1672412555,
+        "narHash": "sha256-Kaa8F7nQFR3KuS6Y9WRUxeJeZlp6CCubyrRfmiEsW4k=",
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9",
+        "type": "github"
+      },
+      "original": {
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9",
+        "type": "github"
+      }
+    },
+    "haskell-flake-utils_6": {
+      "inputs": {
+        "flake-utils": "flake-utils_6"
+      },
+      "locked": {
+        "lastModified": 1672412555,
+        "narHash": "sha256-Kaa8F7nQFR3KuS6Y9WRUxeJeZlp6CCubyrRfmiEsW4k=",
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9",
+        "type": "github"
+      },
+      "original": {
+        "owner": "ivanovs-4",
+        "repo": "haskell-flake-utils",
+        "type": "github"
+      }
+    },
    "hspup": {
      "inputs": {
-        "haskell-flake-utils": [
-          "haskell-flake-utils"
-        ],
+        "haskell-flake-utils": "haskell-flake-utils_5",
        "nixpkgs": [
          "nixpkgs"
        ]
@ -64,11 +266,11 @@
    },
    "nixpkgs": {
      "locked": {
-        "lastModified": 1727089097,
-        "narHash": "sha256-ZMHMThPsthhUREwDebXw7GX45bJnBCVbfnH1g5iuSPc=",
+        "lastModified": 1707451808,
+        "narHash": "sha256-UwDBUNHNRsYKFJzyTMVMTF5qS4xeJlWoeyJf+6vvamU=",
        "owner": "nixos",
        "repo": "nixpkgs",
-        "rev": "568bfef547c14ca438c56a0bece08b8bb2b71a9c",
+        "rev": "442d407992384ed9c0e6d352de75b69079904e4e",
        "type": "github"
      },
      "original": {
@ -80,26 +282,74 @@
    },
    "root": {
      "inputs": {
-        "flake-utils": "flake-utils",
-        "haskell-flake-utils": "haskell-flake-utils",
+        "db-pipe": "db-pipe",
+        "fixme": "fixme",
+        "haskell-flake-utils": "haskell-flake-utils_4",
        "hspup": "hspup",
-        "nixpkgs": "nixpkgs"
+        "nixpkgs": "nixpkgs",
+        "saltine": "saltine",
+        "suckless-conf": "suckless-conf_2"
      }
    },
-    "systems": {
+    "saltine": {
+      "flake": false,
      "locked": {
-        "lastModified": 1681028828,
-        "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=",
-        "owner": "nix-systems",
-        "repo": "default",
-        "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e",
+        "lastModified": 1651348885,
+        "narHash": "sha256-0guvfkdOrofElDildQWE8QDwh+T/u2WY3HVYmOu4g3w=",
+        "owner": "tel",
+        "repo": "saltine",
+        "rev": "3d3a54cf46f78b71b4b55653482fb6f4cee6b77d",
        "type": "github"
      },
      "original": {
-        "owner": "nix-systems",
-        "repo": "default",
+        "owner": "tel",
+        "repo": "saltine",
+        "rev": "3d3a54cf46f78b71b4b55653482fb6f4cee6b77d",
        "type": "github"
      }
+    },
+    "suckless-conf": {
+      "inputs": {
+        "haskell-flake-utils": "haskell-flake-utils_3",
+        "nixpkgs": [
+          "fixme",
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1697354514,
+        "narHash": "sha256-5doedGj2QU4vPuw1VZor1GGEJTxu0zFeO/PsybFIcn8=",
+        "owner": "voidlizard",
+        "repo": "suckless-conf",
+        "rev": "3f87278bc10ac4f14a6d9d2c75cbbed228509129",
+        "type": "github"
+      },
+      "original": {
+        "owner": "voidlizard",
+        "repo": "suckless-conf",
+        "type": "github"
+      }
+    },
+    "suckless-conf_2": {
+      "inputs": {
+        "haskell-flake-utils": "haskell-flake-utils_6",
+        "nixpkgs": [
+          "nixpkgs"
+        ]
+      },
+      "locked": {
+        "lastModified": 1704001322,
+        "narHash": "sha256-D7T/8wAg5J4KkRw0uB90w3+adY11aQaX7rjmQPXkkQc=",
+        "ref": "refs/heads/master",
+        "rev": "8cfc1272bb79ef6ad62ae6a625f21e239916d196",
+        "revCount": 28,
+        "type": "git",
+        "url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ"
+      },
+      "original": {
+        "type": "git",
+        "url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ"
+      }
    }
  },
  "root": "root",
--- a/flake.nix
+++ b/flake.nix
@ -5,127 +5,69 @@ inputs = {

    nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
    # haskell-flake-utils.url = "github:ivanovs-4/haskell-flake-utils";
-    flake-utils.url = "github:numtide/flake-utils";
-    haskell-flake-utils = { # we don't use haskell-flake-utils directly, but we override input evrywhere
-        url = "github:ivanovs-4/haskell-flake-utils/master";
-        inputs.flake-utils.follows = "flake-utils";
-    };
+    haskell-flake-utils.url = "github:ivanovs-4/haskell-flake-utils/master";
    hspup.url = "github:voidlizard/hspup";
    hspup.inputs.nixpkgs.follows = "nixpkgs";
-    hspup.inputs.haskell-flake-utils.follows = "haskell-flake-utils";
+
+    fixme.url = "git+https://git.hbs2.net/Fujv1Uy4W5d9Z7REEArMxbXSJ8nLLn4dYuvaAs8b86hr";
+    fixme.inputs.nixpkgs.follows = "nixpkgs";
+
+    suckless-conf.url = "git+https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ";
+    suckless-conf.inputs.nixpkgs.follows = "nixpkgs";
+
+    db-pipe.url = "git+https://git.hbs2.net/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft";
+    db-pipe.inputs.nixpkgs.follows = "nixpkgs";
+
+    saltine = {
+      url = "github:tel/saltine/3d3a54cf46f78b71b4b55653482fb6f4cee6b77d";
+      flake = false;
+    };

 };

-outputs = { self, nixpkgs, flake-utils, ... }@inputs:
+outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs:
  let
-    packageNames =
-      topLevelPackages ++ keymanPackages;
-
-    keymanPackages =
-      [
-      "hbs2-keyman"
-      "hbs2-keyman-direct-lib"
-      ];
-
-    topLevelPackages =
-      [
+    packageNames = [
     "hbs2"
     "hbs2-peer"
     "hbs2-core"
     "hbs2-storage-simple"
-      "hbs2-storage-ncq"
-      "hbs2-git3"
-      "hbs2-cli"
-      "hbs2-sync"
-      "hbs2-log-structured"
-      "fixme-new"
-      "suckless-conf"
+     "hbs2-git"
+     "hbs2-qblf"
+     "hbs2-keyman"
+     "hbs2-share"
+     "hbs2-fixer"
    ];
-
-    miscellaneous =
-      [
-      "bytestring-mmap"
-      "db-pipe"
-      "fuzzy-parse"
-      "suckless-conf"
-      ];
-
-    jailbreakUnbreak = pkgs: pkg:
-        pkgs.haskell.lib.doJailbreak (pkg.overrideAttrs (_: { meta = { }; }));
-
-    # gitHbs2Script = pkgs.stdenv.mkDerivation {
-    #   pname = "git-hbs2";
-    #   version = "1.0";
-    #   src = ./hbs2-git3/bf6;
-    #   installPhase = ''
-    #     mkdir -p $out/bin
-    #     install -m755 git-hbs2 $out/bin/git-hbs2
-    #   '';
-    # };
-
-    hpOverridesPre = pkgs: new: old: with pkgs.haskell.lib; {
-      scotty = new.callHackage "scotty" "0.21" {};
-      skylighting-lucid = new.callHackage "skylighting-lucid" "1.0.4" { };
-      wai-app-file-cgi = dontCoverage (dontCheck (jailbreakUnbreak pkgs old.wai-app-file-cgi));
-      libyaml =
-        if pkgs.hostPlatform.isStatic
-          then old.libyaml.overrideDerivation (drv: {
-            postPatch = let sed = "${pkgs.gnused}/bin/sed"; in ''
-              ${sed} -i -e 's/buffer_init/snoyberg_buffer_init/' c/helper.c include/helper.h
-              ${sed} -i -e 's/"buffer_init"/"snoyberg_buffer_init"/' src/Text/Libyaml.hs
-            '';
-          })
-          else old.libyaml;
-    };
-
-    overrideComposable = pkgs: hpkgs: overrides:
-      hpkgs.override (oldAttrs: {
-        overrides = pkgs.lib.composeExtensions (oldAttrs.overrides or (_: _: { })) overrides;
-      });
-
-    makePkgsFromDirOverride = pkgs: ov: pkgNames: mkPath:
-      pkgs.lib.genAttrs pkgNames (name:
-        ov (pkgs.haskellPackages.callCabal2nix name "${self}/${mkPath name}" {})
-      );
-
-    makePkgsFromDir = pkgs: makePkgsFromDirOverride pkgs (q: q);
-    makePkgsFromDirWithMan = pkgs: makePkgsFromDirOverride pkgs (q:
-      q.overrideDerivation (drv: {
-          postInstall = ''
-            if [ -d man ]; then
-              mkdir -p $out
-              cp -r man $out/
-            fi
-          '';
-        })
-    );
-
-    ourHaskellPackages = pkgs: ({}
-      // makePkgsFromDirWithMan pkgs topLevelPackages (n: n)
-      // makePkgsFromDirWithMan pkgs keymanPackages (name: "hbs2-keyman/${name}")
-      // makePkgsFromDir pkgs miscellaneous (name: "miscellaneous/${name}")
-    );
-
-    overlay = final: prev: {
-      haskellPackages = overrideComposable prev prev.haskellPackages
-        (new: old:
-          hpOverridesPre prev new old
-            // ourHaskellPackages final
-        );
-      };
-
  in
-  { overlays.default = overlay; }
-  //
-  (flake-utils.lib.eachSystem ["x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin"]
-  (system:
-    let
-      pkgs = import nixpkgs {
-        inherit system;
-        overlays = [overlay];
+ haskell-flake-utils.lib.simpleCabalProject2flake {
+   inherit self nixpkgs;
+   systems = [ "x86_64-linux" "aarch64-linux" "x86_64-darwin" "aarch64-darwin" ];
+   name = "hbs2";
+
+   haskellFlakes = with inputs; [
+     suckless-conf
+     db-pipe
+   ];
+
+   inherit packageNames;
+
+   packageDirs = {
+     "hbs2"        = "./hbs2";
+     "hbs2-tests"  = "./hbs2-tests";
+     "hbs2-core"   = "./hbs2-core";
+     "hbs2-storage-simple" = "./hbs2-storage-simple";
+     "hbs2-peer"   = "./hbs2-peer";
+     "hbs2-keyman" = "./hbs2-keyman";
+     "hbs2-share"  = "./hbs2-share";
+     "hbs2-git"    = "./hbs2-git";
+     "hbs2-fixer"  = "./hbs2-fixer";
   };

-      packagePostOverrides = pkg: with pkgs.haskell.lib.compose; pkgs.lib.pipe pkg [
+   hpPreOverrides = {pkgs, ...}: final: prev: with pkgs; {
+     saltine = prev.callCabal2nix "saltine" inputs.saltine { inherit (pkgs) libsodium; };
+   };
+
+   packagePostOverrides = { pkgs }: with pkgs; with haskell.lib; [
    disableExecutableProfiling
    disableLibraryProfiling
    dontBenchmark
@ -139,71 +81,35 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:

    dontCheck

-        (overrideCabal (drv: {
+    (compose.overrideCabal (drv: {
        preBuild = ''
          export GIT_HASH="${self.rev or self.dirtyRev or "dirty"}"
        '';
-             disallowGhcReference = false;
      }))
+
   ];

-    makePackages = pkgs:
-      let ps = pkgs.lib.mapAttrs
-        (_name: packagePostOverrides) # we can't apply overrides inside our overlay because it will remove linking info
-        (pkgs.lib.getAttrs packageNames (ourHaskellPackages pkgs))
-        ;
-      in ps // {
-        bf6-git-hbs2 = pkgs.callPackage ./nix/bf6-hbs2-git.nix { inherit (ps) suckless-conf; };
-      };
-
-    packagesDynamic = makePackages pkgs;
-    packagesStatic = makePackages pkgs.pkgsStatic;
-    in  {
-    legacyPackages = pkgs;
-    homeManagerModules.default = import ./nix/hm-module.nix self;
-
-    packages =
-      packagesDynamic //
-      {
-        default =
-        pkgs.symlinkJoin {
-          name = "hbs2-all";
-          paths = builtins.attrValues packagesDynamic;
-        };
-        static =
-        pkgs.symlinkJoin {
-          name = "hbs2-static";
-          paths = builtins.attrValues packagesStatic;
-        };
-      };
-
-
-    devShells.default = pkgs.haskellPackages.shellFor {
-      packages = p: builtins.attrValues (ourHaskellPackages pkgs) ++ [
-        p.skylighting-core  # needed for hbs2-tests which we did not expose
-      ];
+   shell = {pkgs, ...}:
+      pkgs.haskellPackages.shellFor {
+        packages = _: pkgs.lib.attrsets.attrVals packageNames pkgs.haskellPackages;
        # withHoogle = true;
        buildInputs = (
-        with pkgs.haskellPackages; [
-          ghc
+          with pkgs.haskellPackages; ([
            ghcid
            cabal-install
            haskell-language-server
            hoogle
-          # htags
+            htags
            text-icu
            magic
            pkgs.icu72
            pkgs.openssl
            weeder
-        ]
+          ])
          ++
          [ pkgs.pkg-config
-          pkgs.libsodium
-          pkgs.file
-          pkgs.zlib
-          pkgs.fuse
            inputs.hspup.packages.${pkgs.system}.default
+            inputs.fixme.packages.${pkgs.system}.default
          ]
        );

@ -212,8 +118,6 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
        '';

      };
-  }
- ));
+ };

 }
-
--- a/hbs2-cli/LICENSE
+++ b/hbs2-cli/LICENSE
@ -1,30 +0,0 @@
-Copyright (c) 2024, Dmitry Zuikov
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
-    * Redistributions of source code must retain the above copyright
-      notice, this list of conditions and the following disclaimer.
-
-    * Redistributions in binary form must reproduce the above
-      copyright notice, this list of conditions and the following
-      disclaimer in the documentation and/or other materials provided
-      with the distribution.
-
-    * Neither the name of Dmitry Zuikov nor the names of other
-      contributors may be used to endorse or promote products derived
-      from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
--- a/hbs2-cli/app/Main.hs
+++ b/hbs2-cli/app/Main.hs
@ -1,136 +0,0 @@
-{-# Language AllowAmbiguousTypes #-}
-{-# Language UndecidableInstances #-}
-module Main where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run
-import HBS2.CLI.Run.Help
-import HBS2.CLI.Run.KeyMan
-import HBS2.CLI.Run.Keyring
-import HBS2.CLI.Run.GroupKey
-import HBS2.CLI.Run.Sigil
-import HBS2.CLI.Run.MetaData
-import HBS2.CLI.Run.Tree
-import HBS2.CLI.Run.Peer
-import HBS2.CLI.Run.RefLog
-import HBS2.CLI.Run.RefChan
-import HBS2.CLI.Run.LWWRef
-import HBS2.CLI.Run.Mailbox
-import HBS2.CLI.NCQ3.Migrate
-
-import Data.Config.Suckless.Script.File as SF
-
-import HBS2.Peer.RPC.Client.Unix
-
-import HBS2.Net.Auth.Schema()
-
-import System.Environment
-import System.IO qualified as IO
-
-type RefLogId = PubKey 'Sign 'HBS2Basic
-
-{- HLINT ignore "Functor law" -}
-
-
-setupLogger :: MonadIO m => m ()
-setupLogger = do
-  -- setLogging @DEBUG  $ toStderr . logPrefix "[debug] "
-  setLogging @ERROR  $ toStderr . logPrefix "[error] "
-  setLogging @WARN   $ toStderr . logPrefix "[warn] "
-  setLogging @NOTICE $ toStderr . logPrefix ""
-  setLogging @INFO   $ toStderr . logPrefix ""
-  pure ()
-
-flushLoggers :: MonadIO m => m ()
-flushLoggers = do
-  silence
-
-silence :: MonadIO m => m ()
-silence = do
-  setLoggingOff @DEBUG
-  setLoggingOff @ERROR
-  setLoggingOff @WARN
-  setLoggingOff @NOTICE
-
-
-main :: IO ()
-main = do
-
-  setupLogger
-
-  cli <- getArgs <&> unlines . fmap unwords . splitForms
-           >>= either (error.show) pure . parseTop
-
-  let runScript dict argz what = liftIO do
-        script <- either (error.show) pure $ parseTop what
-        runHBS2Cli $ recover $ runM dict do
-          bindCliArgs argz
-          void $ evalTop script
-
-  let dict = makeDict do
-
-        internalEntries
-        keymanEntries
-        keyringEntries
-        groupKeyEntries
-        sigilEntries
-        treeEntries
-        metaDataEntries
-        peerEntries
-        reflogEntries
-        refchanEntries
-        lwwRefEntries
-        mailboxEntries
-        migrateEntries
-        helpEntries
-
-        SF.entries
-
-        entry $ bindMatch "--help" $ nil_ \case
-          HelpEntryBound what -> helpEntry what
-          [StringLike s]      -> helpList False (Just s)
-          _                   -> helpList False Nothing
-
-        entry $ bindMatch "debug:cli:show" $ nil_ \case
-          _ -> display cli
-
-        entry $ bindMatch "#!" $ nil_ $ const none
-
-        entry $ bindMatch "stdin" $ nil_ $ \case
-          argz  -> do
-            liftIO getContents >>= runScript dict argz
-
-        entry $ bindMatch "file" $ nil_ $ \case
-          ( StringLike fn : argz ) -> do
-            liftIO (readFile fn) >>= runScript dict argz
-
-          e -> error (show $ pretty $ mkList e)
-
-  runHBS2Cli do
-
-    -- error (show $ pretty cli)
-
-    case cli of
-
-      ( cmd@(ListVal [StringLike "file", StringLike fn]) : _ ) -> do
-        void $ run dict [cmd]
-
-      ( cmd@(ListVal [StringLike "stdin"]) : _ ) -> do
-        void $ run dict [cmd]
-
-      ( cmd@(ListVal [StringLike "--help"]) : _ ) -> do
-        void $ run dict [cmd]
-
-      [] -> do
-        eof <- liftIO IO.isEOF
-        if eof then
-          void $ run dict [mkForm  "help" []]
-        else do
-          what <- liftIO getContents
-                    >>= either (error.show) pure . parseTop
-
-          recover $ run dict what >>= eatNil display
-
-      _ -> do
-        recover $ run dict cli >>= eatNil display
-
--- a/hbs2-cli/hbs2-cli.cabal
+++ b/hbs2-cli/hbs2-cli.cabal
@ -1,146 +0,0 @@
-cabal-version:      3.0
-name:               hbs2-cli
-version:            0.25.3.0
-- synopsis:
-- description:
-license:            BSD-3-Clause
-license-file:       LICENSE
-author:             Dmitry Zuikov
-- copyright:
-category:           System
-build-type:         Simple
-- extra-doc-files:    CHANGELOG.md
-- extra-source-files:
-
-common shared-properties
-  ghc-options:
-        -Wall
-        -fno-warn-type-defaults
-        -threaded
-        -rtsopts
-        -O2
-        "-with-rtsopts=-N4 -A64m -AL256m -I0"
-
-  default-language: GHC2021
-
-  default-extensions:
-                       ApplicativeDo
-                     , BangPatterns
-                     , BlockArguments
-                     , ConstraintKinds
-                     , DataKinds
-                     , DeriveDataTypeable
-                     , DeriveGeneric
-                     , DerivingStrategies
-                     , DerivingVia
-                     , ExtendedDefaultRules
-                     , FlexibleContexts
-                     , FlexibleInstances
-                     , GADTs
-                     , GeneralizedNewtypeDeriving
-                     , ImportQualifiedPost
-                     , LambdaCase
-                     , MultiParamTypeClasses
-                     , OverloadedStrings
-                     , QuasiQuotes
-                     , RecordWildCards
-                     , ScopedTypeVariables
-                     , StandaloneDeriving
-                     , TupleSections
-                     , TypeApplications
-                     , TypeFamilies
-                     , PatternSynonyms
-                     , ViewPatterns
-
-
-  build-depends:
-        hbs2-core
-      , hbs2-peer
-      , hbs2-storage-simple
-      , hbs2-storage-ncq
-      , hbs2-keyman-direct-lib
-      , db-pipe
-      , suckless-conf
-
-      , attoparsec
-      , atomic-write
-      , bytestring
-      , binary
-      , containers
-      , directory
-      , exceptions
-      , filepath
-      , filepattern
-      , generic-lens
-      , hashable
-      , interpolatedstring-perl6
-      , memory
-      , microlens-platform
-      , mtl
-      , safe
-      , serialise
-      , streaming
-      , stm
-      , text
-      , time
-      , timeit
-      , transformers
-      , typed-process
-      , unordered-containers
-      , unliftio
-      , unliftio-core
-      , zlib
-      , prettyprinter
-      , prettyprinter-ansi-terminal
-      , random
-      , vector
-      , unix
-      , split
-
-
-library
-    import:           shared-properties
-
-    exposed-modules:
-      HBS2.CLI
-      HBS2.CLI.Prelude
-      HBS2.CLI.Bind
-      HBS2.CLI.Run
-      HBS2.CLI.Run.Internal
-      HBS2.CLI.Run.Internal.GroupKey
-      HBS2.CLI.Run.Internal.Merkle
-      HBS2.CLI.Run.Internal.KeyMan
-      HBS2.CLI.Run.Internal.RefChan
-      HBS2.CLI.Run.Internal.RefLog
-      HBS2.CLI.Run.GroupKey
-      HBS2.CLI.Run.KeyMan
-      HBS2.CLI.Run.Keyring
-      HBS2.CLI.Run.Tree
-      HBS2.CLI.Run.MetaData
-      HBS2.CLI.Run.Peer
-      HBS2.CLI.Run.RefLog
-      HBS2.CLI.Run.RefChan
-      HBS2.CLI.Run.LWWRef
-      HBS2.CLI.Run.Mailbox
-      HBS2.CLI.Run.Sigil
-
-      HBS2.CLI.Run.Help
-      HBS2.CLI.NCQ3.Migrate
-
-    build-depends:    base
-                    , magic
-
-    hs-source-dirs:   lib
-
-
-executable hbs2-cli
-    import:           shared-properties
-    main-is:          Main.hs
-    -- other-modules:
-    -- other-extensions:
-    build-depends:
-          base, hbs2-cli
-
-    hs-source-dirs:   app
-    default-language: GHC2021
-
--- a/hbs2-cli/lib/HBS2/CLI.hs
+++ b/hbs2-cli/lib/HBS2/CLI.hs
@ -1 +0,0 @@
-module HBS2.CLI where
--- a/hbs2-cli/lib/HBS2/CLI/Bind.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Bind.hs
@ -1,4 +0,0 @@
-module HBS2.CLI.Bind where
-
-import HBS2.CLI.Prelude
-
--- a/hbs2-cli/lib/HBS2/CLI/NCQ3/Migrate.hs
+++ b/hbs2-cli/lib/HBS2/CLI/NCQ3/Migrate.hs
@ -1,57 +0,0 @@
-{-# Language AllowAmbiguousTypes #-}
-module HBS2.CLI.NCQ3.Migrate where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-
-import HBS2.Peer.NCQ3.Migrate.NCQ
-
-import HBS2.Net.Auth.Schema()
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Storage
-import HBS2.Storage.NCQ3.Internal.Prelude
-import HBS2.Peer.Proto.RefLog
-import HBS2.Peer.Proto.RefChan
-import HBS2.Peer.Proto.LWWRef
-
-import Streaming.Prelude qualified as S
-
-migrateEntries :: forall c m . ( MonadUnliftIO m
-                               , IsContext c
-                               , Exception (BadFormException c)
-                               , HasClientAPI PeerAPI UNIX m
-                               , HasStorage m
-                               ) => MakeDictM c m ()
-migrateEntries = do
-  brief "migrate NCQv1 => NCQ3"
-   $ args [ arg "path" "src"
-          , arg "path" "dst"
-          ]
-
-   $ entry $ bindMatch "ncq3:migrate:ncq" $ nil_ $ \case
-       [ StringLike src, StringLike dst] -> do
-
-        api <- getClientAPI @PeerAPI  @UNIX
-
-        refs <- callRpcWaitMay @RpcPollList2 (1.0 :: Timeout 'Seconds) api (Nothing, Nothing)
-                  <&> fromMaybe mempty
-
-        rrefs <- S.toList_ <$> for refs $ \(pk, s, _) -> case s of
-                   "reflog"  -> S.yield (WrapRef $ RefLogKey @'HBS2Basic pk)
-
-                   "refchan" -> do
-                      S.yield (WrapRef $ RefChanLogKey @'HBS2Basic pk)
-                      S.yield (WrapRef $ RefChanHeadKey @'HBS2Basic pk)
-
-                   "lwwref"  -> S.yield (WrapRef $ LWWRefKey @'HBS2Basic pk)
-                   _         -> none
-
-        lift $ migrateNCQ1 nicelog rrefs src dst
-
-       e -> throwIO $ BadFormException (mkList e)
-
-nicelog :: forall m . MonadIO  m => Doc AnsiStyle -> m ()
-nicelog doc = liftIO $ hPutDoc stdout (doc <> line)
-
--- a/hbs2-cli/lib/HBS2/CLI/Prelude.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Prelude.hs
@ -1,28 +0,0 @@
-module HBS2.CLI.Prelude
-  ( module HBS2.Prelude.Plated
-  , module HBS2.OrDie
-  , module UnliftIO
-  , module Data.Config.Suckless
-  , module Data.HashMap.Strict
-  , module Control.Monad.Reader
-  , module HBS2.System.Logger.Simple.ANSI
-  , module HBS2.Misc.PrettyStuff
-  , qc,qq,q
-  , Generic
-  , pattern SignPubKeyLike
-  ) where
-
-import HBS2.Prelude.Plated
-import HBS2.OrDie
-import HBS2.System.Logger.Simple.ANSI
-import HBS2.Misc.PrettyStuff
-import HBS2.Net.Auth.Credentials
-
-import Data.HashMap.Strict
-import Data.Config.Suckless
-
-import Control.Monad.Reader
-import UnliftIO
-
-import Text.InterpolatedString.Perl6 (qc,q,qq)
-
--- a/hbs2-cli/lib/HBS2/CLI/Run.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run.hs
@ -1,9 +0,0 @@
-{-# Language UndecidableInstances #-}
-module HBS2.CLI.Run
-  ( module HBS2.CLI.Run.Internal
-  ) where
-
-import HBS2.CLI.Run.Internal
-
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/GroupKey.hs
@ -1,200 +0,0 @@
-module HBS2.CLI.Run.GroupKey
-  ( module HBS2.CLI.Run.GroupKey
-  , loadGroupKey
-  ) where
-
-import HBS2.CLI.Prelude hiding (mapMaybe)
-
-import HBS2.Data.Types.Refs
-import HBS2.Storage.Operations.Class
-import HBS2.Storage.Operations.ByteString
-import HBS2.Base58
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.GroupKey as G
-import HBS2.Net.Auth.GroupKeySymm as Symm
-import HBS2.Storage
-
-import HBS2.KeyMan.Keys.Direct
-
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.Client.Unix
-
-import Data.Text qualified as Text
-import Data.ByteString.Lazy.Char8 as LBS8
-import Data.ByteString.Lazy as LBS
-import Data.ByteString.Char8 as BS8
-import Data.HashMap.Strict qualified as HM
-import Control.Monad.Except
-import Codec.Serialise
-
-{- HLINT ignore "Functor law" -}
-
-
-groupKeyEntries :: forall c m . ( MonadUnliftIO m
-                                , IsContext c
-                                , Exception (BadFormException c)
-                                , HasClientAPI StorageAPI UNIX m
-                                , HasStorage m
-                                ) => MakeDictM c m ()
-groupKeyEntries = do
-
-  entry $ bindMatch "hbs2:groupkey:load" $ \case
-      [HashLike h] -> do
-        sto <- getStorage
-
-        gk <- loadGroupKey h
-                >>= orThrowUser "can not load groupkey"
-
-        pure $ mkStr (show $ pretty $ AsGroupKeyFile gk)
-
-      _ -> throwIO $ BadFormException @C nil
-
-
-  brief "stores groupkey to the peer's storage" $
-   args [arg "string" "groupkey"] $
-   returns "string" "hash" $
-    entry $ bindMatch "hbs2:groupkey:store" $ \case
-        [LitStrVal s] -> do
-          let lbs = LBS8.pack (Text.unpack s)
-          gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
-                  `orDie` "invalid group key"
-
-          sto <- getStorage
-          ha <- writeAsMerkle sto (serialise gk)
-          pure $ mkStr (show $ pretty ha)
-
-        _ -> throwIO $ BadFormException @c nil
-
-
-  brief "publish groupkey to the given refchan" $
-    args [arg "string" "refchan", arg "string" "groupkey-blob|groupkey-hash"] $
-    desc "groupkey may be also hash of te stored groupkey" $
-      entry $ bindMatch "hbs2:groupkey:publish" $ nil_ $ \case
-
-      [SignPubKeyLike rchan, LitStrVal gk] -> do
-        -- get
-        -- check
-        -- store
-        -- find refchan
-        -- post tx as metadata
-        notice $ red "not implemented yet"
-
-      [SignPubKeyLike rchan, HashLike gkh] -> do
-        notice $ red "not implemented yet"
-
-      _ -> throwIO $ BadFormException @c nil
-
-
-- $ hbs2-cli print [hbs2:groupkey:update [hbs2:groupkey:load 6XJGpJszP6f68fmhF17AtJ9PTgE7BKk8RMBHWQ2rXu6N] \
--             [list [remove . CcRDzezX1XQdPxRMuMKzJkfHFB4yG7vGJeTYvScKkbP8] \
--                   [add . 5sJXsw7qhmq521hwhE67jYvrD6ZNVazc89rFwfWaQPyY]] ]
--
-  entry $ bindMatch "hbs2:groupkey:update" $ \case
-    [LitStrVal s, ListVal ins] -> do
-
-      sto <- getStorage
-
-      let lbs = LBS8.pack (Text.unpack s)
-      gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
-              `orDie` "invalid group key"
-
-      gk1 <- modifyGroupKey gk ins
-
-      pure $ mkStr (show $ pretty $ AsGroupKeyFile gk1)
-
-    _ -> throwIO $ BadFormException @C nil
-
-  brief "create group key" $
-    args [ arg "keys" "list" ] $
-    desc "list of encryption public keys of members" $
-    entry $ bindMatch "hbs2:groupkey:create" $ \syn -> do
-      case syn of
-        [ListVal (StringLikeList keys)] -> do
-          s <- groupKeyFromKeyList  keys
-                  <&> AsGroupKeyFile
-                  <&> show . pretty
-
-          pure $ mkStr s
-
-        StringLikeList keys -> do
-          s <- groupKeyFromKeyList  keys
-                  <&> AsGroupKeyFile
-                  <&> show . pretty
-
-          pure $ mkStr s
-
-        _ -> throwIO $ BadFormException @C nil
-
-
-  entry $ bindMatch "hbs2:groupkey:dump" $ nil_ $ \syn -> do
-    case syn of
-      -- TODO: from-file
-      -- TODO: from-stdin
-      -- TODO: base58 file
-      [HashLike gkh] -> do
-        gk <- loadGroupKey gkh
-        liftIO $ print $ pretty gk
-
-      _ -> throwIO $ BadFormException @C nil
-
-  entry $ bindMatch "hbs2:groupkey:list-public-keys" $ \syn -> do
-    case syn of
-      [LitStrVal s] -> do
-
-        let lbs = LBS8.pack (Text.unpack s)
-        gk <- pure (Symm.parseGroupKey @'HBS2Basic $ AsGroupKeyFile lbs)
-                `orDie` "invalid group key"
-
-        let rcpt = recipients gk & HM.keys & fmap (mkStr . show . pretty . AsBase58)
-
-        pure $ mkList @c rcpt
-
-      _ -> throwIO $ BadFormException @C nil
-
-  brief "find groupkey secret in hbs2-keyman" $
-    args [arg "string" "group-key-hash"] $
-    returns "secret-key-id" "string" $
-    entry $ bindMatch "hbs2:groupkey:find-secret" $ \case
-      [HashLike gkh] -> do
-
-        sto <- getStorage
-
-        gk <- loadGroupKey gkh >>= orThrowUser "can't load groupkey"
-
-        what <- runKeymanClientRO $ findMatchedGroupKeySecret sto gk
-                   >>= orThrowUser "groupkey secret not found"
-
-        let gid = generateGroupKeyId GroupKeyIdBasic1 what
-
-        pure $ mkStr (show $ pretty gid)
-
-      _ -> throwIO $ BadFormException @c nil
-
-
-  entry $ bindMatch "hbs2:groupkey:decrypt-block" $ \case
-    [BlobLike bs] -> do
-
-      sto <- getStorage
-
-      let lbs = LBS.fromStrict bs
-
-      seb <- pure (deserialiseOrFail lbs)
-               `orDie` "invalid SmallEncryptedBlock"
-
-      decrypted <- G.decryptBlock sto seb
-
-      pure $ mkForm @c "blob" [mkStr (BS8.unpack decrypted)]
-
-    _ -> throwIO $ BadFormException @C nil
-
-  entry $ bindMatch "hbs2:groupkey:encrypt-block" $ \case
-    [StringLike gkh, BlobLike what] -> do
-        sto <- getStorage
-        gk <- loadGroupKey (fromString gkh)
-                `orDie` "can't load group key"
-        seb <- G.encryptBlock sto gk what
-        pure $ mkForm "blob" [mkStr (LBS8.unpack (serialise seb))]
-
-    _ -> throwIO $ BadFormException @C nil
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Help.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Help.hs
@ -1,28 +0,0 @@
-module HBS2.CLI.Run.Help where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-
-import Data.HashMap.Strict qualified as HM
-import Data.List qualified as List
-import Data.Text qualified as Text
-
-helpEntries :: (MonadUnliftIO m, IsContext c) => MakeDictM c m ()
-helpEntries = do
-
-  entry $ bindMatch "help" $ nil_ $ \syn -> do
-
-      display_ $ "hbs2-cli tool" <> line
-
-      case syn of
-
-        [StringLike "--documented"] -> do
-          helpList True Nothing
-
-        (StringLike p : _) -> do
-          helpList False (Just p)
-
-        HelpEntryBound what -> helpEntry what
-
-        _ -> helpList False Nothing
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal.hs
@ -1,242 +0,0 @@
-{-# Language TemplateHaskell #-}
-{-# Language UndecidableInstances #-}
-{-# Language AllowAmbiguousTypes #-}
-module HBS2.CLI.Run.Internal
-  ( module HBS2.CLI.Run.Internal
-  , module SC
-  ) where
-
-import HBS2.CLI.Prelude
-
-import HBS2.System.Dir
-
-import HBS2.OrDie
-import HBS2.Base58
-import HBS2.Data.Types.Refs
-import HBS2.Storage
-import HBS2.Peer.CLI.Detect
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.API.RefLog
-import HBS2.Peer.RPC.API.RefChan
-import HBS2.Peer.RPC.API.LWWRef
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Peer.RPC.API.RefChan
-import HBS2.Peer.RPC.Client.StorageClient
-
-import Data.Config.Suckless.Script qualified as SC
-import Data.Config.Suckless.Script hiding (internalEntries)
-
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Cont
-import Data.ByteString.Char8 qualified as BS8
-import Data.ByteString.Lazy qualified as LBS
-import Data.ByteString qualified as BS
-import Data.Text qualified as Text
-import Lens.Micro.Platform
-
-
-data HBS2CliEnv =
-  HBS2CliEnv
-  { _peerSocket      :: FilePath
-  , _peerRefChanAPI  :: ServiceCaller RefChanAPI UNIX
-  , _peerRefLogAPI   :: ServiceCaller RefLogAPI UNIX
-  , _peerLwwRefAPI   :: ServiceCaller LWWRefAPI UNIX
-  , _peerPeerAPI     :: ServiceCaller PeerAPI UNIX
-  , _peerStorageAPI  :: ServiceCaller StorageAPI UNIX
-  }
-
-makeLenses 'HBS2CliEnv
-
-newtype HBS2Cli m a = HBS2Cli { fromHBS2Cli :: ReaderT (TVar (Maybe HBS2CliEnv)) m a }
-                      deriving newtype ( Applicative
-                                       , Functor
-                                       , Monad
-                                       , MonadIO
-                                       , MonadUnliftIO
-                                       , MonadReader (TVar (Maybe HBS2CliEnv))
-                                       )
-
-withHBS2Cli :: TVar (Maybe HBS2CliEnv) -> HBS2Cli m a -> m a
-withHBS2Cli env action = runReaderT (fromHBS2Cli action) env
-
-recover :: HBS2Cli IO a -> HBS2Cli IO a
-recover what = do
-  catch what $ \case
-    PeerNotConnectedException -> do
-
-      soname <- detectRPC
-                  `orDie` "can't locate hbs2-peer rpc"
-
-      flip runContT pure do
-
-        client <- lift $ race (pause @'Seconds 1) (newMessagingUnix False 1.0 soname)
-                    >>= orThrowUser ("can't connect to" <+> pretty soname)
-
-        void $ ContT $ withAsync $ runMessagingUnix client
-
-        peerAPI    <- makeServiceCaller @PeerAPI (fromString soname)
-        refLogAPI  <- makeServiceCaller @RefLogAPI (fromString soname)
-        refChanAPI <- makeServiceCaller @RefChanAPI (fromString soname)
-        storageAPI <- makeServiceCaller @StorageAPI (fromString soname)
-        lwwAPI     <- makeServiceCaller @LWWRefAPI (fromString soname)
-
-        -- let sto = AnyStorage (StorageClient storageAPI)
-
-        let endpoints = [ Endpoint @UNIX  peerAPI
-                        , Endpoint @UNIX  refLogAPI
-                        , Endpoint @UNIX  refChanAPI
-                        , Endpoint @UNIX  lwwAPI
-                        , Endpoint @UNIX  storageAPI
-                        ]
-
-        void $ ContT $ withAsync $ liftIO $ runReaderT (runServiceClientMulti endpoints) client
-
-        let env = Just (HBS2CliEnv soname refChanAPI refLogAPI lwwAPI peerAPI storageAPI)
-        tv <- newTVarIO env
-
-        liftIO $ withHBS2Cli tv what
-
-
-runHBS2Cli :: MonadUnliftIO m => HBS2Cli m a -> m a
-runHBS2Cli action = do
-   noenv <- newTVarIO Nothing
-   withHBS2Cli  noenv action
-
-data PeerException =
-  PeerNotConnectedException
-  deriving stock (Show, Typeable)
-
-instance Exception PeerException
-
-
-instance (MonadUnliftIO m, HasClientAPI api proto m) => HasClientAPI api proto (RunM c m) where
-  getClientAPI = lift (getClientAPI @api @proto)
-
-instance (MonadUnliftIO m, HasStorage m) => HasStorage  (RunM c m) where
-  getStorage = lift getStorage
-
-instance (MonadUnliftIO m, HasClientAPI StorageAPI UNIX m, HasStorage m) => HasStorage (ContT a (RunM c m)) where
-  getStorage = lift getStorage
-
-instance (MonadUnliftIO m, HasClientAPI api proto m) => HasClientAPI api proto (ContT a (RunM c m)) where
-  getClientAPI = lift $ getClientAPI @api @proto
-
-instance MonadUnliftIO m => HasClientAPI RefChanAPI UNIX (HBS2Cli m) where
-  getClientAPI = do
-    what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
-    pure $ view peerRefChanAPI what
-
-instance MonadUnliftIO m => HasClientAPI RefLogAPI UNIX (HBS2Cli m) where
-  getClientAPI = do
-    what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
-    pure $ view peerRefLogAPI what
-
-instance MonadUnliftIO m => HasClientAPI PeerAPI UNIX (HBS2Cli m) where
-  getClientAPI = do
-    what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
-    pure $ view peerPeerAPI what
-
-instance MonadUnliftIO m => HasClientAPI StorageAPI UNIX (HBS2Cli m) where
-  getClientAPI = do
-    what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
-    pure $ view peerStorageAPI what
-
-instance MonadUnliftIO m => HasClientAPI LWWRefAPI UNIX (HBS2Cli m) where
-  getClientAPI = do
-    what <- ask >>= readTVarIO >>= orThrow PeerNotConnectedException
-    pure $ view peerLwwRefAPI what
-
-instance MonadUnliftIO m => HasStorage (HBS2Cli m) where
-  getStorage = getClientAPI @StorageAPI @UNIX  <&> AnyStorage . StorageClient
-
-internalEntries :: forall c m . (IsContext c, Exception (BadFormException c), MonadUnliftIO m) => MakeDictM c m ()
-internalEntries = do
-    SC.internalEntries
-
-    entry $ bindMatch "--run" $ \case
-      [] -> do
-        liftIO getContents
-           <&> parseTop
-           >>= either (error.show) (pure . fmap (fixContext @_ @c))
-           >>= evalTop
-
-      [StringLike fn] -> do
-        liftIO (readFile fn)
-           <&> parseTop
-           >>= either (error.show) (pure . fmap (fixContext @_ @c))
-           >>= evalTop
-
-      _ -> throwIO (BadFormException @c nil)
-
-    -- TODO: re-implement-all-on-top-of-opaque
-
-    entry $ bindMatch "hbs2:hash" $ \case
-      [] -> liftIO do
-        LBS.getContents
-          <&> mkSym . HashRef . hashObject @HbSync
-
-      [ StringLike fn ] -> liftIO do
-        LBS.readFile fn
-          <&> mkSym . HashRef . hashObject @HbSync
-
-      [isOpaqueOf @LBS.ByteString -> Just s ] -> do
-          pure $ mkSym $ HashRef $ hashObject @HbSync s
-
-      [isOpaqueOf @BS.ByteString -> Just s ] -> do
-          pure $ mkSym $ HashRef $ hashObject @HbSync s
-
-      e -> throwIO (BadFormException @c (mkList e))
-
-    entry $ bindMatch "blob:base58" $ \case
-      [LitStrVal t] -> do
-        bs <- pure (Text.unpack t & BS8.pack & fromBase58)
-               `orDie` "invalid base58"
-              <&> BS8.unpack
-
-        pure (mkForm "blob" [mkStr @c bs])
-
-      _ -> throwIO (BadFormException @c nil)
-
-
-    let decodeB58 t = do
-          pure (Text.unpack t & BS8.pack & fromBase58)
-            `orDie` "invalid base58"
-
-    let decodeAndOut t = do
-          liftIO $ BS8.putStr =<< decodeB58 t
-
-    entry $ bindMatch "base58:encode" $ \case
-      [LitStrVal t] -> do
-        let s = Text.unpack t & BS8.pack & toBase58 & BS8.unpack
-        pure (mkForm "blob:base58" [mkStr @c s])
-
-      [ListVal [SymbolVal "blob", LitStrVal t]] -> do
-        let s = Text.unpack t & BS8.pack & toBase58 & BS8.unpack
-        pure (mkForm "blob:base58" [mkStr @c s])
-
-      e -> throwIO (BadFormException @c nil)
-
-    entry $ bindMatch "base58:decode" $ \case
-
-      [ListVal [SymbolVal "blob:base58", LitStrVal t]] -> do
-        s <- decodeB58 t <&> BS8.unpack
-        pure $ mkForm "blob" [mkStr @c s]
-
-      e -> throwIO (BadFormException @c nil)
-
-    entry $ bindMatch "base58:put" $ nil_ $ \case
-      [ListVal [SymbolVal "blob:base58", LitStrVal t]] ->
-        decodeAndOut t
-
-      [LitStrVal t] -> decodeAndOut t
-
-      e -> throwIO (BadFormException @c nil)
-
-    entry $ bindMatch "test:opaque" $ \case
-      [ LitIntVal n ] -> mkOpaque n
-      [ StringLike s ] -> mkOpaque s
-
-      _ -> mkOpaque ()
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/GroupKey.hs
@ -1,107 +0,0 @@
-module HBS2.CLI.Run.Internal.GroupKey
-  ( module HBS2.CLI.Run.Internal.GroupKey
-  , SmallEncryptedBlock(..)
-  ) where
-
-import HBS2.CLI.Prelude hiding (mapMaybe)
-import HBS2.CLI.Run.Internal
-
-import HBS2.Base58
-import HBS2.Hash
-import HBS2.Storage
-import HBS2.Data.Types.Refs
-import HBS2.Data.Types.SmallEncryptedBlock
-import HBS2.Storage.Operations.Class
-import HBS2.Storage.Operations.ByteString
-import HBS2.KeyMan.Keys.Direct
-import HBS2.Net.Auth.GroupKeySymm as Symm
-
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.API.Storage
-
-import Data.HashMap.Strict qualified as HM
-import Data.HashSet qualified as HS
-import Data.Maybe
-import Control.Monad.Trans.Cont
-import Control.Monad.Except
-import Codec.Serialise
-import Data.ByteString (ByteString)
-
-groupKeyFromKeyList :: MonadUnliftIO m => [String] -> m (GroupKey 'Symm HBS2Basic)
-groupKeyFromKeyList ks = do
-  let members = mapMaybe (fromStringMay @(PubKey 'Encrypt 'HBS2Basic)) ks
-  Symm.generateGroupKey @'HBS2Basic Nothing members
-
-
-encryptBlock :: (MonadUnliftIO m, Serialise t)
-             => AnyStorage
-             -> GroupKey 'Symm 'HBS2Basic
-             -> t
-             -> m (SmallEncryptedBlock t)
-
-encryptBlock sto gk x = do
-
-  let HbSyncHash non = hashObject (serialise x)
-
-  gks <- runKeymanClientRO (extractGroupKeySecret gk)
-           >>= orThrowUser "can't extract group key secret"
-
-  Symm.encryptBlock sto gks (Right gk) (Just non) x
-
-decryptBlock :: (MonadUnliftIO m, Serialise t)
-             => AnyStorage
-             -> SmallEncryptedBlock t
-             -> m t
-decryptBlock sto seb = do
-  let find gk = runKeymanClientRO (findMatchedGroupKeySecret sto gk)
-
-  -- FIXME: improve-error-diagnostics
-  runExceptT (Symm.decryptBlock sto find seb)
-     >>= orThrowUser "can't decrypt block"
-
-loadGroupKey :: ( IsContext c
-                , MonadUnliftIO m
-                , HasStorage m
-                , HasClientAPI StorageAPI UNIX m
-                ) => HashRef -> RunM c m (Maybe (GroupKey 'Symm HBS2Basic))
-loadGroupKey h = do
-
-  flip runContT pure do
-    sto <- getStorage
-
-    raw <- runExceptT (readFromMerkle sto (SimpleKey (fromHashRef h)))
-            <&> either (const Nothing) Just
-
-    bs <- ContT (maybe1 raw (pure Nothing))
-
-    let gk = deserialiseOrFail bs
-              & either (const Nothing) Just
-
-    pure gk
-
-modifyGroupKey :: (IsContext c, MonadUnliftIO m)
-               => GroupKey 'Symm 'HBS2Basic
-               -> [Syntax c]
-               -> m (GroupKey 'Symm HBS2Basic)
-modifyGroupKey gk ins = do
-
-  gks <- runKeymanClient do
-          extractGroupKeySecret gk
-         `orDie` "can't extract group key secret"
-
-  let r = catMaybes [ fromStringMay @(PubKey 'Encrypt HBS2Basic) k
-                    | ListVal [SymbolVal "remove", StringLike k] <- ins
-                    ] & HS.fromList
-
-  let a = catMaybes [ fromStringMay @(PubKey 'Encrypt HBS2Basic) k
-                    | ListVal [SymbolVal "add", StringLike k] <- ins
-                    ] & HS.fromList
-
-  let x = recipients gk & HM.keysSet
-
-  let new = x `HS.difference` r `mappend` a & HS.toList
-
-  generateGroupKey @'HBS2Basic (Just gks) new
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/KeyMan.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/KeyMan.hs
@ -1,55 +0,0 @@
-module HBS2.CLI.Run.Internal.KeyMan where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-
-import HBS2.Hash
-import HBS2.System.Dir
-import HBS2.Net.Auth.Credentials
-
-import HBS2.KeyMan.Config (getDefaultKeyPath)
-import HBS2.KeyMan.Keys.Direct
-import HBS2.KeyMan.State
-import HBS2.KeyMan.App.Types
-
-import Codec.Serialise
-import Data.Either
-import Data.ByteString.Lazy qualified as LBS
-import Data.Text.Encoding qualified as TE
-import Data.Text.IO qualified as TIO
-import System.Process.Typed
-import Text.InterpolatedString.Perl6 (qc)
-
-
-keymanGetConfig :: (IsContext c, MonadUnliftIO m) => m [Syntax c]
-keymanGetConfig = do
-    (_,lbs,_) <- readProcess (shell [qc|hbs2-keyman config|] & setStderr closed)
-
-    let conf = TE.decodeUtf8 (LBS.toStrict lbs)
-                 & parseTop
-                 & fromRight mempty
-
-    pure $ fmap fixContext conf
-
-keymanUpdate :: MonadUnliftIO m => m ()
-keymanUpdate = do
-  void $ runProcess (shell [qc|hbs2-keyman update|] & setStderr closed & setStdout closed)
-
-keymanNewCredentials :: MonadUnliftIO m => Maybe String -> Int -> m (PubKey 'Sign 'HBS2Basic)
-keymanNewCredentials suff n = do
-  conf <- keymanGetConfig @C
-  path <- getDefaultKeyPath conf
-  creds <- newCredentialsEnc @'HBS2Basic n
-
-  let s = show $ pretty $ AsCredFile (AsBase58 creds)
-
-  let psk = view peerSignPk creds
-
-  let fpath = path </> show (pretty (AsBase58 psk) <> "-" <> pretty suff <> ".key")
-
-  liftIO $ writeFile fpath s
-
-  keymanUpdate
-
-  pure psk
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/Merkle.hs
@ -1,156 +0,0 @@
-module HBS2.CLI.Run.Internal.Merkle where
-
-import HBS2.CLI.Prelude
-import HBS2.Defaults
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.GroupKey as G
-
-import HBS2.Hash
-import HBS2.Net.Auth.GroupKeySymm as Symm
-import HBS2.Data.Types.Refs
-import HBS2.Data.Detect
-import HBS2.Merkle
-import HBS2.Storage
-import HBS2.Storage.Operations.ByteString
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.API.Storage
-import HBS2.KeyMan.Keys.Direct
-
-import HBS2.Net.Auth.Schema()
-
-import Codec.Serialise
-import Data.Coerce
-import Data.ByteString.Lazy qualified as LBS
-import Data.HashMap.Strict qualified as HM
-import Data.Text qualified as Text
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Cont
-import Control.Monad.Except
-import Data.Maybe
-
-
--FIXME: move-somewhere-else
-getGroupKeyHash :: ( MonadUnliftIO m
-                   , HasStorage m
-                   , HasClientAPI StorageAPI UNIX m
-                   )
-                => HashRef
-                -> m (Maybe HashRef, MTreeAnn [HashRef])
-getGroupKeyHash h = do
-  flip runContT pure do
-    sto <- lift getStorage
-
-    headBlock <- getBlock sto (fromHashRef h)
-                   >>= orThrow MissedBlockError
-                   <&> deserialiseOrFail @(MTreeAnn [HashRef])
-                   >>= orThrow UnsupportedFormat
-
-    case _mtaCrypt headBlock of
-      (EncryptGroupNaClSymm hash _) ->
-        pure $ (Just $ HashRef hash, headBlock)
-      _ -> pure (Nothing, headBlock)
-
-- TODO: client-api-candidate
-createTreeWithMetadata :: (MonadUnliftIO m)
-                       => AnyStorage
-                       -> Maybe (GroupKey 'Symm 'HBS2Basic)
-                       -> HashMap Text Text
-                       -> LBS.ByteString
-                       -> m (Either OperationError HashRef)
-createTreeWithMetadata sto mgk meta lbs = do -- flip runContT pure do
-
-    let mt = vcat [ pretty k <> ":" <+> dquotes (pretty v) | (k,v) <- HM.toList meta ]
-               & show & Text.pack
-
-    case mgk of
-      Nothing -> Right <$> createSimpleTree mt
-      Just gk -> createEncryptedTree gk mt
-
-  where
-    createSimpleTree mt = do
-        t0 <- writeAsMerkle sto lbs
-                >>= getBlock sto
-                >>= orThrowUser "can't read merkle tree just written"
-                <&> deserialiseOrFail @(MTree [HashRef])
-                >>= orThrowUser "merkle tree corrupted/invalid"
-
-        let mann = MTreeAnn (ShortMetadata mt) NullEncryption t0
-
-        putBlock sto (serialise mann)
-          >>= orThrowUser "can't write tree"
-          <&> HashRef
-
-    -- FIXME: support-encryption
-    createEncryptedTree gk mt = do
-      -- 1. find key
-      mgks <- runKeymanClientRO do
-                extractGroupKeySecret gk
-
-      gks <- orThrowUser "can't get groupkey's secret" mgks
-
-      -- FIXME: consider-other-nonce-calculation
-      --   надо считать начальный нонс (от чего / как?)
-      --   нонс: да так-то пофиг от чего, но:
-      --     если брать рандомные места в байтстроке --
-      --     она зафорсится
-      --     что вообще зависит от начального нонса:
-      --       если в файл будет допись в конец, то
-      --       "старые" блоки останутся такими же, как были
-      --       что хорошо для дедуплицирования, но
-      --       потенциально это менее безопасно.
-      --   можно еще с метаданными похэшировать, тогда
-      --   нонс будет более уникальный; но поменялись метаданные -- поменялось всё
-      let s0 = LBS.take ( 1024 * 1024 ) lbs
-
-      let (HbSyncHash nonce) = hashObject @HbSync s0
-      -- куда-то девать зашифрованные метаданные
-      --
-      let segments = readChunkedBS lbs defBlockSize
-
-      seb <- G.encryptBlock sto gk (ShortMetadata mt)
-
-      hmeta <- putBlock sto (serialise seb)
-                 >>= orThrowUser "can't put block"
-
-      let source = ToEncryptSymmBS gks (Right gk) nonce segments  (AnnHashRef hmeta) Nothing
-
-      runExceptT $ writeAsMerkle sto source <&> HashRef
-
-
-getTreeContents :: forall m . ( MonadUnliftIO m
-                              , MonadIO m
-                              , MonadError OperationError m
-                   )
-                => AnyStorage
-                -> HashRef
-                -> m LBS.ByteString
-
-getTreeContents sto href = do
-
-  blk <- getBlock sto (coerce href)
-           >>= orThrowError MissedBlockError
-
-  let q = tryDetect (coerce href) blk
-
-  case q of
-
-    Merkle _ -> do
-      readFromMerkle sto (SimpleKey (coerce href))
-
-    MerkleAnn (MTreeAnn {_mtaCrypt = NullEncryption }) -> do
-      readFromMerkle sto (SimpleKey (coerce href))
-
-    MerkleAnn ann@(MTreeAnn {_mtaCrypt = EncryptGroupNaClSymm gkh _}) -> do
-
-      rcpts  <- Symm.loadGroupKeyMaybe @'HBS2Basic sto (HashRef gkh)
-                  >>= orThrowError (GroupKeyNotFound 11)
-                  <&> HM.keys . Symm.recipients
-
-      let findStuff g = do
-            runKeymanClientRO @IO $ findMatchedGroupKeySecret sto g
-
-      readFromMerkle sto (ToDecryptBS (coerce href) (liftIO . findStuff))
-
-    _ -> throwError UnsupportedFormat
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefChan.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefChan.hs
@ -1,61 +0,0 @@
-{-# Language AllowAmbiguousTypes #-}
-module HBS2.CLI.Run.Internal.RefChan (createNewRefChan) where
-
-import HBS2.CLI.Prelude hiding (mapMaybe)
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.KeyMan
-
-import HBS2.Peer.Proto.RefChan
-import HBS2.Storage
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Auth.Schema()
-import HBS2.Data.Types.SignedBox
-import HBS2.Data.Types.Refs
-import HBS2.Storage.Operations.Class
-import HBS2.KeyMan.Keys.Direct
-
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.API.RefChan
-
-import Lens.Micro.Platform
-
-createNewRefChan :: forall c m . ( IsContext c
-                                 , MonadUnliftIO m
-                                 , Exception (BadFormException c)
-                                 , HasClientAPI RefChanAPI UNIX m
-                                 , HasClientAPI StorageAPI UNIX m
-                                 , HasClientAPI PeerAPI UNIX m
-                                 , HasStorage m
-                                 )
-                 => Maybe (PubKey Sign HBS2Basic)
-                 -> RefChanHeadBlock L4Proto
-                 -> m  (PubKey Sign HBS2Basic)
-
-createNewRefChan mbk rch = do
-
-  peerApi  <- getClientAPI @PeerAPI @UNIX
-  rchanApi <- getClientAPI @RefChanAPI @UNIX
-  sto      <- getStorage
-
-  refchan <- maybe1 mbk (keymanNewCredentials (Just "refchan") 0) pure
-
-  creds <- runKeymanClientRO $ loadCredentials refchan
-               >>= orThrowUser "can't load credentials"
-
-  let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch
-
-  href <- writeAsMerkle sto  (serialise box)
-
-  --FIXME: timeout-hardcode
-  callService @RpcPollAdd peerApi (refchan, "refchan", 17)
-      >>= orThrowUser "can't subscribe to refchan"
-
-  callService @RpcRefChanHeadPost rchanApi (HashRef href)
-      >>= orThrowUser "can't post refchan head"
-
-  pure refchan
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefLog.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Internal/RefLog.hs
@ -1,109 +0,0 @@
-{-# Language AllowAmbiguousTypes #-}
-module HBS2.CLI.Run.Internal.RefLog (copyTransactions, RefLogCLIException(..),decodeRefLogTx) where
-
-import HBS2.CLI.Prelude hiding (mapMaybe)
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.KeyMan
-
-import HBS2.Peer.Proto.RefLog
-import HBS2.Base58
-import HBS2.Storage
-import HBS2.Data.Detect
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Auth.Schema()
-import HBS2.Peer.Proto
-import HBS2.Data.Types.SignedBox
-import HBS2.Data.Types.Refs
-import HBS2.Storage.Operations.Class
-import HBS2.KeyMan.Keys.Direct
-
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.API.RefLog
-
-import Codec.Serialise
-import Control.Monad.Trans.Maybe
-import Data.ByteString.Lazy qualified as LBS
-import Data.Coerce
-import Data.Maybe
-import Lens.Micro.Platform
-
-data RefLogCLIException =
-   RefLogRpcTimeout
- | RefLogNoCredentials String
- deriving (Typeable, Show)
-
-instance Exception RefLogCLIException
-
-type ForCloneRefLog e s m = ( s ~ Encryption e
-                            , MonadUnliftIO m
-                            , HasClientAPI RefLogAPI UNIX m
-                            , HasClientAPI StorageAPI UNIX m
-                            , HasClientAPI PeerAPI UNIX m
-                            , HasStorage m
-                            , Signatures s
-                            , IsRefPubKey s
-                            , Serialise (Nonce (RefLogUpdate e))
-                            )
-
-
-- useful for forking git repositories
-- it accepts credential lookup method
-- since reflog B may be inferred from some other secret
-- normally, you dont need this method
-copyTransactions :: forall e s m . (ForCloneRefLog e s m, s ~ Encryption e, e ~ L4Proto)
-                 => m (PeerCredentials s) -- ^ obtain credentials for reflog B
-                 -> PubKey Sign s         -- ^ original reflog
-                 -> PubKey Sign s         -- ^ destination reflog
-                 -> m ()
-
-copyTransactions cre a b  = do
-
-  api <- getClientAPI @RefLogAPI @UNIX
-  sto <- getStorage
-
-  creds <- cre
-
-  let pk = view peerSignPk creds
-  let sk = view peerSignSk creds
-
-  void $ runMaybeT do
-
-    rvA <- lift (callRpcWaitMay @RpcRefLogGet (TimeoutSec 1) api a)
-             >>= orThrow RefLogRpcTimeout
-             >>= toMPlus
-
-    logA <- readLogThrow (getBlock sto) rvA
-
-    new <- for logA $ \h -> runMaybeT do
-      RefLogUpdate{..} <- getBlock sto (coerce h)
-                            >>= toMPlus
-                            <&> deserialiseOrFail @(RefLogUpdate e)
-                            >>= toMPlus
-
-      lift (makeRefLogUpdate @e pk sk _refLogUpdData)
-
-    lift $ for_ (catMaybes new) $ \n -> do
-      void $ callService @RpcRefLogPost api n
-
-
-decodeRefLogTx :: forall c. IsContext c => Maybe HashRef -> LBS.ByteString -> Syntax c
-decodeRefLogTx h lbs = do
-
-  let ha = maybe (hashObject @HbSync lbs) coerce h
-
-  case tryDetect ha lbs of
-
-    SeqRef (SequentialRef n (AnnotatedHashRef ann ha)) ->
-      mkForm "seqref" [mkInt n, mkForm "annref" [mkSym (show $ pretty ann), mkSym (show $ pretty ha)]]
-
-    AnnRef (AnnotatedHashRef ann ha) -> do
-       mkForm "annref" [mkSym (show $ pretty ann), mkSym (show $ pretty ha)]
-
-    Blob{} -> mkForm "blob" [mkSym (show $ pretty ha)]
-
-    _ -> mkForm "tree" [mkSym (show $ pretty ha)]
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/KeyMan.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/KeyMan.hs
@ -1,54 +0,0 @@
-module HBS2.CLI.Run.KeyMan
-  ( module HBS2.CLI.Run.KeyMan
-  , keymanNewCredentials
-  ) where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.KeyMan
-
-import HBS2.Hash
-import HBS2.System.Dir
-
-import HBS2.KeyMan.Config (getDefaultKeyPath)
-import HBS2.KeyMan.Keys.Direct
-import HBS2.KeyMan.State
-import HBS2.KeyMan.App.Types
-
-import Codec.Serialise
-import Data.Either
-import Data.ByteString.Lazy qualified as LBS
-import Data.Text.Encoding qualified as TE
-import Data.Text.IO qualified as TIO
-import System.Process.Typed
-import Text.InterpolatedString.Perl6 (qc)
-
-
-keymanEntries :: (MonadUnliftIO m, IsContext c) => MakeDictM c m ()
-keymanEntries = do
-  entry $ bindMatch "hbs2:keyman:list" $ nil_ \case
-    _ -> do
-      void $ runKeymanClient  $ KeyManClient $ do
-        k <- listKeys
-        display_ $ vcat (fmap pretty k)
-
-  entry $ bindMatch "hbs2:keyman:update" $ nil_ $ \_ -> do
-    keymanUpdate
-
-  entry $ bindMatch "hbs2:keyman:config" $ \_ -> do
-    mkForm  "dict" <$> keymanGetConfig
-
-  args [ arg "string" "keyring-data"] $
-    entry $ bindMatch "hbs2:keyman:keys:add" $ \case
-      [ LitStrVal ke ] -> do
-        conf <- keymanGetConfig @C
-        path <- getDefaultKeyPath conf
-        let n =  hashObject @HbSync (serialise ke) & pretty & show
-        let fname = n `addExtension` ".key"
-        let fpath = path </> fname
-        liftIO $ TIO.writeFile fpath ke
-        keymanUpdate
-        pure $ mkStr fpath
-
-      _ -> throwIO (BadFormException @C nil)
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Keyring.hs
@ -1,60 +0,0 @@
-module HBS2.CLI.Run.Keyring where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-
-import HBS2.Net.Auth.Credentials
-import HBS2.KeyMan.App.Types
-
-import Data.ByteString qualified as BS
-import Data.ByteString.Char8 qualified as BS8
-import Data.Text qualified as Text
-
-keyringEntries :: forall c m . ( MonadUnliftIO m
-                               , IsContext c
-                               , Exception (BadFormException c)
-                               ) => MakeDictM c m ()
-keyringEntries = do
-  entry $ bindMatch "hbs2:keyring:list-encryption" $ \syn -> do
-    lbs <- case syn of
-
-          [ ListVal [ SymbolVal "file", StringLike fn ] ] -> do
-            liftIO $ BS.readFile fn
-
-          [ LitStrVal s ] -> do
-            pure (BS8.pack (Text.unpack s))
-
-          _ -> throwIO (BadFormException @C nil)
-
-    cred <- pure (parseCredentials @'HBS2Basic (AsCredFile lbs))
-              `orDie` "bad keyring file"
-
-    let e = [ mkStr @c (show (pretty (AsBase58 p))) | KeyringEntry p _ _ <- view peerKeyring cred ]
-
-    pure $ mkList @c e
-
-  brief "creates a new keyring (credentials)"
-    $ args [arg "int?" "encrypt-keys-num"]
-    $ returns "keyring" "string"
-    $ entry $ bindMatch "hbs2:keyring:new" $ \syn -> do
-      n <- case syn of
-            [LitIntVal k] -> pure k
-            []            -> pure 1
-            _ -> throwIO (BadFormException @C nil)
-
-      cred0 <- newCredentials @'HBS2Basic
-      cred <- foldM (\cred _ -> addKeyPair Nothing cred) cred0 [1..n]
-      pure $ mkStr @c $ show $ pretty $ AsCredFile $ AsBase58 cred
-
-
-  entry $ bindMatch "hbs2:keyring:show" $ \case
-    [StringLike fn] -> do
-      bs <- liftIO $ BS.readFile fn
-      cred <- parseCredentials @'HBS2Basic (AsCredFile bs)
-                  & orThrowUser "bad credentials file"
-
-      pure $ mkStr $ show $ pretty (ListKeyringKeys cred)
-
-    _ -> throwIO $ BadFormException @c nil
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/LWWRef.hs
@ -1,129 +0,0 @@
-module HBS2.CLI.Run.LWWRef where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.KeyMan
-
-import HBS2.Data.Types.Refs
-import HBS2.Storage
-import HBS2.Peer.CLI.Detect
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.API.LWWRef
-
-import HBS2.Peer.Proto.LWWRef
-import HBS2.Base58
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Auth.Schema()
-import HBS2.Data.Types.SignedBox
-
-import HBS2.KeyMan.Keys.Direct
-import HBS2.KeyMan.App.Types
-
-import Control.Monad.Trans.Cont
-
-
-lwwRefEntries :: forall c m . ( IsContext c
-                              , MonadUnliftIO m
-                              , Exception (BadFormException c)
-                              , HasClientAPI PeerAPI UNIX m
-                              , HasClientAPI LWWRefAPI UNIX m
-                              ) => MakeDictM  c m ()
-lwwRefEntries = do
-
-  brief "creates a new lwwref"
-    $ desc "Creates a new keyring; adds it to keyman and subsribes hbs2-peer to listen this lwwref"
-    $ returns "string" "lwwref public key"
-    $ entry $ bindMatch "hbs2:lwwref:create" $ \case
-        [] -> do
-          key <- keymanNewCredentials (Just "lwwref") 0
-          api <- getClientAPI @PeerAPI  @UNIX
-          void $ callService @RpcPollAdd api (key, "lwwref", 31)
-          pure $ mkForm "pk" [mkStr (show $ pretty (AsBase58 key))]
-
-        _ -> throwIO (BadFormException @C nil)
-
-  brief "lists all lwwref that hbs2-peer is subscribed to"
-    $ noArgs
-    $ returns "list of string" "lwwref list"
-    $ entry $ bindMatch "hbs2:lwwref:list" $ \case
-      [] -> do
-        api <- getClientAPI  @PeerAPI @UNIX
-        r <- callService @RpcPollList2 api (Just "lwwref", Nothing)
-               >>= orThrowUser "can't get lwwref list"
-        pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
-
-      _ -> throwIO (BadFormException @C nil)
-
-
-  brief "fetches lwwref value"
-    $ desc "makes peer to request lwwref from neighbors"
-    $ args [arg "string" "lwwref"]
-    $ returns "atom" "okay"
-    $ entry $ bindMatch "hbs2:lwwref:fetch" $ \case
-      [StringLike puk] -> do
-        lww <- orThrowUser "bad lwwref key" (fromStringMay puk)
-        api <- getClientAPI @LWWRefAPI @UNIX
-        void $ callService @RpcLWWRefFetch api lww
-        pure $ mkStr "okay"
-
-      _ -> throwIO (BadFormException @C nil)
-
-
-  brief "get lwwref value"
-    $ args [arg "string" "lwwref"]
-    $ returns "string" "hashref"
-    $ examples [qc|
-
-(hbs2:lwwref:get BTThPdHKF8XnEq4m6wzbKHKA6geLFK4ydYhBXAqBdHSP)
-(lwwref
-  (seq 4)
-  (value "74vDGwBYebH3oM6xPXC7kqpgu6deqi7E549QpvHvvQKf")
-  )
-    |]
-    $ entry $ bindMatch "hbs2:lwwref:get" $ \case
-      [StringLike puk] -> do
-
-        ref <- orThrowUser "bad lwwref key" (fromStringMay puk)
-        api <- getClientAPI @LWWRefAPI  @UNIX
-        what <- callService @RpcLWWRefGet api ref
-                  >>= orThrowUser "can't get lwwref value"
-        pure $ mkStr (show $ pretty what)
-
-      _ -> throwIO (BadFormException @C nil)
-
-
-  brief "updates lwwref"
-    $ desc "updates lwwref value and increments it's counter"
-    $ args [arg "string" "lwwref", arg "string" "hash"]
-    $ returns "nil" ""
-    $ entry $ bindMatch "hbs2:lwwref:update" $ \case
-      [StringLike puks, HashLike new] -> do
-
-        puk <- orThrowUser "bad lwwref key" (fromStringMay  puks)
-        api <- getClientAPI @LWWRefAPI  @UNIX
-
-        (sk,pk) <- liftIO $ runKeymanClient do
-                     creds  <- loadCredentials puk
-                                 >>= orThrowUser "can't load credentials"
-                     pure ( view peerSignSk  creds, view peerSignPk creds )
-
-        what <- callService @RpcLWWRefGet api puk
-                  >>= orThrowUser "can't get lwwref value"
-
-        sno' <- case what of
-                 Nothing    -> pure 0
-                 Just lwwv  -> pure (lwwSeq lwwv)
-
-        let sno =  succ sno'
-
-        let box =  makeSignedBox pk sk (LWWRef sno new Nothing)
-
-        callService @RpcLWWRefUpdate api box
-          >>= orThrowUser "lww ref update error"
-
-        pure nil
-
-      _ -> throwIO (BadFormException @C nil)
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Mailbox.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Mailbox.hs
@ -1,305 +0,0 @@
-module HBS2.CLI.Run.Mailbox where
-
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.Merkle
-
-import HBS2.Net.Auth.GroupKeySymm
-import HBS2.Peer.Proto.Mailbox
-import HBS2.Peer.Proto.Mailbox.Policy.Basic
-
-import HBS2.Base58
-import HBS2.System.Dir
-import HBS2.Data.Types.Refs
-import HBS2.Hash
-import HBS2.Storage
-import HBS2.KeyMan.Keys.Direct as K
-
-import Codec.Serialise
-import Data.Text qualified as Text
-import Data.Text.Encoding (encodeUtf8)
-import Control.Monad.Except
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy qualified as LBS
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.Coerce
-import Data.Either
-
-createShortMessageFromByteString :: forall s m . ( MonadUnliftIO m
-                                                 , s ~ HBS2Basic
-                                                 , HasStorage m
-                                                 )
-                            => LBS8.ByteString
-                            -> m (Message s)
-createShortMessageFromByteString lbs = do
-  let ls0 = LBS8.lines lbs
-  let (hbs, rest1) = break LBS8.null ls0
-  let payload      = dropWhile LBS8.null rest1 & LBS8.unlines
-  let headers      = parseTop (LBS8.unpack (LBS8.unlines hbs)) & fromRight mempty
-
-  flagz <- defMessageFlags
-
-  sender <-  headMay [ Left s | ListVal [SymbolVal "sender", HashLike s] <- headers ]
-               & orThrowUser "sender not defined"
-
-  let rcpts = [ Left s | ListVal [SymbolVal "recipient", HashLike s] <- headers ]
-
-  sto <- getStorage
-
-  let cms = CreateMessageServices
-              sto
-              ( runKeymanClientRO . loadCredentials )
-              ( runKeymanClientRO . loadKeyRingEntry )
-
-  createMessage cms flagz Nothing sender rcpts mempty (LBS8.toStrict payload)
-
-
-
-mailboxEntries :: forall c m . ( IsContext c
-                               , MonadUnliftIO m
-                               , HasStorage m
-                               , Exception (BadFormException c)
-                               ) => MakeDictM  c m ()
-mailboxEntries = do
-
-  brief "creates a new object of Message from file"
-    $ args [arg "string" "filename"]
-    $ desc [qc|
-hbs2:mailbox:message:create:short:file FILENAME
-
-FILENAME is file with format:
-
-field1  VALUE
-field2  VALUE
-<blank>
-message text...
-<EOF>
-
-;;
-
-supported fields:
-
-sender     <SIGIL-HASH>
-recipient  <SIGIL-HASH>
-
-    |]
-    $ returns "blob" "message"
-    $ entry $ bindMatch "hbs2:mailbox:message:create:short:file" $ \case
-        [StringLike fn] -> lift do
-          lbs <- liftIO $ LBS8.readFile fn
-          mess <- createShortMessageFromByteString lbs
-          mkOpaque (serialise mess)
-
-        _ -> throwIO (BadFormException @c nil)
-
-
-  brief "creates a new multipart message"
-    $ desc [qc|
-;; creates multipart message
-
-hbs2:mailbox:message:create:multipart [kw k1 v1 kn kv]
-
-WHERE
-
- k ::= sender | recipient | body | part
-
- sender ::= HASH(sigil)
- body   ::= STRING
- part   ::= FILENAME
-
-    |]
-    $ examples [qc|
-
-[hbs2:peer:storage:block:put
- [hbs2:mailbox:message:create:multipart
-    [kw sender      ghna99Xtm33ncfdUBT3htBUoEyT16wTZGMdm24BQ1kh
-        recipient   4e9moTcp9AW13wRYYWg5F8HWooVH1PuQ7zsf5g2JYPWj
-        body        [str:file body.txt]
-        part        patch1.patch
-    ]]]
-
-NOTE:
-
-Each "part" will be represented as encrypted merkle tree
-with metadata, i.e. it will be created in storage.
-
-So it's a good idea to remove excessive/unrequired trees using
-hbs2 del -r command.
-
-|]
-    $ returns "bytes" "message"
-    $ entry $ bindMatch "hbs2:mailbox:message:create:multipart" $ \syn -> lift do
-
-      sto <- getStorage
-      let cms = CreateMessageServices
-                  sto
-                  ( runKeymanClientRO . loadCredentials )
-                  ( runKeymanClientRO . loadKeyRingEntry )
-
-
-      flagz   <- defMessageFlags
-      tsender <- newTVarIO Nothing
-      tbody   <- newTVarIO (mempty :: LBS.ByteString)
-      trcpt   <- newTVarIO mempty
-      tparts  <- newTVarIO mempty
-
-      case syn of
-         [ListVal (SymbolVal "dict" : parts)] -> do
-
-          for_ parts $ \case
-            ListVal [StringLike "sender", HashLike ss] ->  do
-              atomically $ writeTVar tsender (Just ss)
-
-            ListVal [StringLike "recipient", HashLike ss] ->  do
-              atomically $ modifyTVar trcpt  (ss:)
-
-            ListVal [StringLike "body", StringLike s] -> do
-              let lbs = encodeUtf8 (fromString s) & LBS.fromStrict
-              atomically $ modifyTVar tbody (LBS.append lbs)
-
-            ListVal [StringLike "part", StringLike fn] -> do
-              let what = takeFileName fn & fromString
-              let rfn = liftIO (LBS.readFile fn)
-              let meta = [("file-name:", what)]
-              atomically $ modifyTVar tparts ( [(meta,rfn)] <> )
-
-            _ -> pure ()
-
-         _ -> throwIO (BadFormException @c nil)
-
-      sender <- readTVarIO tsender >>= orThrowUser "sender not set"
-      rcpt   <- readTVarIO trcpt <&> fmap Left
-      body   <- readTVarIO tbody
-      parts  <- readTVarIO tparts
-      mess   <- createMessage cms flagz Nothing
-                    (Left sender)
-                    rcpt
-                    parts
-                    (LBS.toStrict body)
-
-      mkOpaque (serialise mess)
-
-  entry $ bindMatch "hbs2:mailbox:message:dump" $ nil_ \syn -> lift do
-    lbs <- case syn of
-            [ HashLike h ] -> do
-              sto <- getStorage
-              getBlock sto (coerce h) >>= orThrowUser "message not found"
-
-            [ StringLike fn ] -> do
-              liftIO $ LBS.readFile fn
-
-            _ -> throwIO (BadFormException @c nil)
-
-    let rms = ReadMessageServices ( liftIO . runKeymanClientRO . extractGroupKeySecret)
-
-    (s,mess,co) <- deserialiseOrFail @(Message HBS2Basic) lbs
-                    & orThrowUser "malformed message"
-                    >>= readMessage rms
-
-    -- TODO: implement-normally
-    liftIO do
-      print $ "sender" <+> pretty (AsBase58 s)
-
-      for_ (messageRecipients mess)  $ \r -> do
-        print $ "recipient" <+> pretty (AsBase58 r)
-
-      for_ (messageParts mess) $ \p -> do
-        print $ "attachment" <+> pretty p
-
-      putStrLn ""
-
-      BS.putStr co
-
-  entry $ bindMatch "hbs2:mailbox:message:read:file" $ nil_ \case
-    [StringLike s] -> lift do
-      sto <- getStorage
-      let rms = ReadMessageServices ( liftIO . runKeymanClientRO . extractGroupKeySecret)
-
-      (s,_,bs)  <- liftIO (LBS.readFile s)
-                     <&> deserialiseOrFail @(Message HBS2Basic)
-                     >>= orThrowUser "invalid message format"
-                     >>= readMessage rms
-
-      liftIO $ BS.putStr bs
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-
-  entry $ bindMatch "hbs2:mailbox:message:read:storage" $ nil_ \case
-    [HashLike h] -> lift do
-      sto <- getStorage
-      let rms = ReadMessageServices ( liftIO . runKeymanClientRO . extractGroupKeySecret)
-
-      (s,_,bs) <- getBlock sto (coerce h)
-                    >>= orThrowUser "message not found"
-                      <&> deserialiseOrFail @(Message HBS2Basic)
-                      >>= orThrowUser "invalid message format"
-                      >>= readMessage rms
-
-      liftIO $ BS.putStr bs
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:mailbox:policy:basic:read:syntax" $ \case
-    [ListVal syn] -> do
-      po <- parseBasicPolicy syn >>= orThrowUser "malformed policy"
-      mkOpaque po
-
-    _ -> throwIO (BadFormException @c nil)
-
-  entry $ bindMatch "hbs2:mailbox:policy:basic:read:file" $ \case
-    [StringLike fn] -> lift do
-
-      what <- liftIO (readFile fn)
-               <&> parseTop
-               >>= either (error.show) pure
-               >>= parseBasicPolicy
-               >>= orThrowUser "invalid policy"
-
-      mkOpaque what
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:mailbox:policy:basic:read:storage" $ \case
-    [HashLike href] -> lift do
-      sto <- getStorage
-      what <- runExceptT (getTreeContents sto href)
-                >>= orThrowPassIO
-                <&> parseTop . LBS8.unpack
-                >>= either (error.show) pure
-                >>= parseBasicPolicy
-                >>= orThrowUser "invalid policy"
-      mkOpaque what
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:mailbox:policy:basic:accept:peer" $ \case
-    [SignPubKeyLike who, OpaqueVal box] -> lift do
-      p <- fromOpaqueThrow @(BasicPolicy HBS2Basic) "expected BasicPolicy" box
-      r <- policyAcceptPeer @HBS2Basic p who
-      pure $ mkBool @c r
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:mailbox:policy:basic:accept:sender" $ \case
-    [SignPubKeyLike who, OpaqueVal box] -> lift do
-      p <- fromOpaqueThrow @(BasicPolicy HBS2Basic) "expected BasicPolicy" box
-      r <- policyAcceptSender @HBS2Basic p who
-      pure $ mkBool @c r
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:mailbox:policy:basic:dump" $ nil_ $ \case
-    [OpaqueVal box] -> lift do
-      p <- fromOpaqueThrow @(BasicPolicy HBS2Basic) "expected BasicPolicy" box
-      liftIO $ print $ vcat (fmap pretty (getAsSyntax @c p))
-
-    _ -> throwIO (BadFormException @c nil)
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/MetaData.hs
@ -1,307 +0,0 @@
-{-# Language MultiWayIf #-}
-
-module HBS2.CLI.Run.MetaData
-  ( metaDataEntries
-  , createTreeWithMetadata
-  , getTreeContents
-  , getGroupKeyHash
-  ) where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.GroupKey as G
-import HBS2.CLI.Run.Internal.Merkle
-
-import HBS2.Data.Types.Refs
-import HBS2.Merkle
-import HBS2.System.Dir
-import HBS2.Storage
-import HBS2.Storage.Operations.ByteString
-
-import HBS2.Net.Auth.Schema()
-
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.Client.Unix
-
-import Codec.Serialise
-import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Cont
-import Data.ByteString.Lazy qualified as LBS
-import Data.ByteString.Lazy (ByteString)
-import Data.ByteString.Char8 qualified as BS8
-import Data.Either
-import Data.Set qualified as Set
-import Data.HashMap.Strict qualified as HM
-import Data.Maybe
-import Data.Text.Encoding qualified as TE
-import Data.Text qualified as Text
-import Data.Text.IO qualified as TIO
-
-import Magic.Data
-import Magic.Init       (magicLoadDefault,magicOpen)
-import Magic.Operations (magicFile)
-
-{- HLINT ignore "Functor law" -}
-
-data CreateMetaDataOpt =
-    Auto
-  | Stdin
-  | Encrypted String
-  | MetaDataEntry Id String
-  | MetaDataFile FilePath
-  deriving stock (Eq,Ord,Show,Data,Generic)
-
-txt :: Pretty  a => a -> Text
-txt a = Text.pack (show $ pretty a)
-
-metaFromSyntax :: [Syntax c] -> HashMap Text Text
-metaFromSyntax syn =
-  HM.fromList [ (t k, t v) | (ListVal [ k, v ]) <- syn ]
-  where
-    t x = Text.pack (show $ pretty x)
-
-
-type ForMetadata c m = ( IsContext c
-                       , MonadUnliftIO m
-                       , Exception (BadFormException c)
-                       , HasStorage m
-                       , HasClientAPI StorageAPI UNIX m
-                       )
-
-metaDataEntries :: forall c m . ( ForMetadata c m
-                                ) => MakeDictM c m ()
-metaDataEntries = do
-
-  brief "update group key for tree"
-    $ args [arg "string" "tree", arg "list" "update-ops"]
-    $ desc ( "update-ops is a list of pairs, like" <> line
-               <> indent 4 ( parens ("list"
-                     <+> indent 2 (vcat [ parens "remove . PUBLIC-KEY-ID"
-                                        , parens "add . PUBLIC-KEY-ID"
-                        ]))))
-    $ returns "string" "new-tree-hash"
-    $ examples [qc|
-
-(define gk (hbs2:groupkey:load 6XJGpJszP6f68fmhF17AtJ9PTgE7BKk8RMBHWQ2rXu6N))
-
-(hbs2:groupkey:update gk
-      (list (remove . CcRDzezX1XQdPxRMuMKzJkfHFB4yG7vGJeTYvScKkbP8)
-            (add . EiwWxY3xwTfnLKJdzzxNMZgA2ZvYAZd9e8B8pFeCtnrn)))
-    |]
-    $ entry $ bindMatch "hbs2:tree:metadata:update-gk" $ \case
-      [StringLike tree, ListVal ins] -> do
-
-        ha <- orThrowUser "invalid hash" (fromStringMay tree)
-
-        -- 1. load-group-key
-        (gkh', headBlk) <- getGroupKeyHash ha
-
-        gkh <- orThrowUser "not encrypted" gkh'
-
-        gk <- loadGroupKey gkh
-                >>= orThrowUser "can't load gk"
-
-        gk1 <- modifyGroupKey gk ins
-
-        sto <- getStorage
-        gk1h <- writeAsMerkle sto (serialise gk1)
-
-        case headBlk of
-          w@(MTreeAnn { _mtaCrypt = EncryptGroupNaClSymm _ nonce }) -> do
-            let w1 = w { _mtaCrypt = EncryptGroupNaClSymm gk1h nonce }
-
-            h <- putBlock sto (serialise w1)
-                   >>= orThrowUser "can't put block"
-
-            pure $ mkStr (show $ pretty h)
-
-          _ -> pure nil
-
-      _ -> throwIO (BadFormException @c nil)
-
-  brief "get group key from encrypted tree"
-    $ args [arg "string" "tree-hash"]
-    $ returns "group-key-hash" "string"
-    $ examples [qc|
-
-(hbs2:tree:metadata:get-gk 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd)
-5fshZRucawt47YJLuD1rVXRez2dcvCbz17m69YyduTEm
-
-    |]
-    $ entry $ bindMatch "hbs2:tree:metadata:get-gk" $ \case
-      [ StringLike hash ] -> flip runContT pure do
-
-        (gk,_) <- lift $ getGroupKeyHash (fromString hash)
-
-        case gk of
-          Just h -> pure $ mkStr (show $ pretty h)
-          _      -> pure nil
-
-      _ -> throwIO (BadFormException @c nil)
-
-  brief "get metadata from tree"
-    $ args [arg "symbol?" "method", arg "string" "tree-hash"]
-    $ returns "group-key-hash" "string"
-    $ desc ( opt "symbol?" ":parsed" <+> "return metadata as dict" <> line
-              <> "if other value or absense then return metadata as string"
-           )
-    $ examples [qc|
-
-(hbs2:tree:metadata:get 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd)
-((mime-type: "text/plain; charset=us-ascii") (file-name: "qqq.txt"))
-
-(hbs2:tree:metadata:get :raw 7J2BZYskBjmDsWZHvVoGGorZDrFYkbbQweRauaYGSTNd
-mime-type: "text/plain; charset=us-ascii"
-file-name: "qqq.txt"
-    |]
-    $ entry $ bindMatch "hbs2:tree:metadata:get"
-    $ \case
-     [ StringLike hash ] -> do
-
-        r <- flip runContT pure do
-
-          sto <- getStorage
-
-          runMaybeT do
-
-            headBlock <- getBlock sto (fromString hash)
-                           >>= toMPlus
-                           <&> deserialiseOrFail @(MTreeAnn [HashRef])
-                           >>= toMPlus
-
-            case headBlock of
-              MTreeAnn { _mtaMeta = ShortMetadata s } -> do
-                pure $ mkStr s
-
-              MTreeAnn { _mtaMeta = AnnHashRef h, _mtaCrypt = NullEncryption } -> do
-                getBlock sto h
-                   >>= toMPlus
-                   <&> LBS.toStrict
-                   <&> TE.decodeUtf8
-                   <&> mkStr
-
-              MTreeAnn { _mtaMeta = AnnHashRef h } -> do
-                getBlock sto h
-                   >>= toMPlus
-                   <&> deserialiseOrFail @(SmallEncryptedBlock AnnMetaData)
-                   >>= toMPlus
-                   >>= lift . lift . G.decryptBlock sto
-                   <&> \case
-                    ShortMetadata s -> mkStr s
-                    _ -> nil
-
-              _ -> mzero
-
-        maybe1 r (pure nil) $ \case
-          TextLike r0 -> do
-
-            let xs = parseTop r0
-                       & either mempty (fmap fixContext)
-
-            pure $ mkList xs
-
-          _ -> pure $ fromMaybe nil r
-
-     _ -> throwIO (BadFormException @c nil)
-
-
-  let metadataCreateMan = brief "creates a tree with metadata"
-  let kw = arg "kw" "opts"
-
-  metadataCreateMan $ args [kw, arg "string" "filename"] $
-    entry $ bindMatch "hbs2:tree:metadata:file" $ \case
-      [ syn@(ListVal{}), StringLike fn ] -> do
-          meta0 <- liftIO do
-            magic <- magicOpen [MagicMimeType,MagicMime,MagicMimeEncoding]
-            magicLoadDefault magic
-            mime <- magicFile magic fn
-            pure $ HM.fromList [ ("file-name", Text.pack (takeFileName fn))
-                               , ("mime-type", Text.pack mime)
-                               ]
-          doCreateMetadataTree meta0 syn (liftIO $ LBS.readFile fn)
-
-      _ -> throwIO (BadFormException @c nil)
-
-  metadataCreateMan $ args [kw] $
-    entry $ bindMatch "hbs2:tree:metadata:stdin" $ \case
-        [syn@(ListVal{})] -> do
-          _reader <- hIsTerminalDevice stdin >>= \case
-             _ -> pure (liftIO LBS.getContents)
-
-          doCreateMetadataTree mempty syn _reader
-
-        _ -> throwIO (BadFormException @c nil)
-
-  metadataCreateMan $ args [kw, arg "string" "input"] $
-    entry $ bindMatch "hbs2:tree:metadata:string" $ \case
-        [ syn@(ListVal{}), TextLike content ] -> do
-          -- liftIO $ TIO.putStr content
-          doCreateMetadataTree mempty syn (pure $ LBS.fromStrict $ TE.encodeUtf8 content)
-
-        _ -> throwIO (BadFormException @c nil)
-
-  entry $ bindMatch "cbor:base58" $ \case
-    [ LitStrVal x ] -> do
-      pure $ mkForm "cbor:base58" [mkStr x]
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-groupKeyFromSyntax :: Syntax c -> Either (Syntax c) (Maybe HashRef)
-groupKeyFromSyntax = \case
-  ListVal es -> do
-    let mbGk = headMay [ z | z@(ListVal [ TextLike "gk", v ]) <- es ]
-
-    case mbGk of
-      Just (ListVal [ TextLike "gk", HashLike v]) -> Right (Just v)
-      Just w@(ListVal [ TextLike "gk", v]) -> Left w
-      _ -> Right Nothing
-
-  _ -> Right Nothing
-
-loadGroupKeyFromSyntax :: ( ForMetadata c m )
-                       => Syntax c
-                       -> RunM c m (Maybe (GroupKey 'Symm 'HBS2Basic))
-
-loadGroupKeyFromSyntax syn = runMaybeT do
-  hash <- case groupKeyFromSyntax syn of
-             Right w -> toMPlus w
-             Left e -> throwIO (BadFormException e)
-
-  toMPlus =<< lift (loadGroupKey hash)
-
-metadataFromSyntax :: Syntax c -> HashMap Text Text
-metadataFromSyntax = \case
-  ListVal es -> HM.fromList [ (k,v) | ListVal [ TextLike k, TextLike v] <- es, k /= "gk" ]
-  _ -> mempty
-
-
-doCreateMetadataTree :: forall c m . ForMetadata c m
-                     => HashMap Text Text
-                     -> Syntax c
-                     -> m ByteString
-                     -> RunM c m (Syntax c)
-doCreateMetadataTree meta0 syn getLbs = do
-  let meta = metadataFromSyntax syn
-  let gkh  = groupKeyFromSyntax syn
-
-  gk <- loadGroupKeyFromSyntax syn
-
-  -- notice $ "GK" <+> pretty (isRight gkh) <+> pretty gk
-
-  case (gkh, gk) of
-    (Right (Just _), Nothing) -> throwIO (GroupKeyNotFound 1)
-    _ -> none
-
-  sto <- getStorage
-
-  lbs <- lift getLbs
-
-  href <- lift (createTreeWithMetadata sto  gk (meta0 <> meta) lbs)
-             >>= orThrow StorageError
-
-  pure $ mkStr (show $ pretty href)
-
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Peer.hs
@ -1,145 +0,0 @@
-{-# Language ViewPatterns #-}
-{-# Language PatternSynonyms #-}
-module HBS2.CLI.Run.Peer where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-
-import HBS2.Hash
-import HBS2.Base58
-import HBS2.Data.Types.Refs
-import HBS2.Storage
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.CLI.Detect
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.API.RefLog
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Peer.RPC.API.LWWRef
-import HBS2.Net.Auth.Schema()
-
-import Data.List qualified as L
-import Data.Maybe
-import Control.Monad.Trans.Cont
-import Data.Text qualified as Text
-import Data.ByteString qualified as BS
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.ByteString.Lazy qualified as LBS
-import Lens.Micro.Platform
-
-import Text.InterpolatedString.Perl6 (qc)
-
-{- HLINT ignore "Functor law" -}
-
-putTextLit :: forall c m . (IsContext c, MonadUnliftIO m)
-           => AnyStorage
-           -> Text
-           -> RunM c m (Syntax c)
-
-putTextLit sto s = do
-    h <- putBlock sto (LBS8.pack (Text.unpack s))
-           `orDie` "can't store block"
-         <&> HashRef
-
-    pure (mkStr @c (show $ pretty h))
-
-peerEntries :: forall c m . ( IsContext c
-                            , MonadUnliftIO m
-                            , HasClientAPI PeerAPI UNIX m
-                            , HasClientAPI StorageAPI UNIX m
-                            , HasStorage m
-                            , Exception (BadFormException c)
-                            ) => MakeDictM c m ()
-peerEntries = do
-
-  entry $ bindMatch "hbs2:peer:detect" $ \case
-    _ -> detectRPC <&> maybe (nil @c) mkStr
-
-  entry $ bindMatch "hbs2:peer:storage:block:get" $ \case
-    [StringLike s] -> do
-      flip runContT pure do
-
-        sto <- getStorage
-        ha <- pure (fromStringMay @HashRef s)
-               `orDie` "invalid hash"
-
-        lbs <- getBlock sto (fromHashRef ha)
-                `orDie` show ("missed-block" <+> pretty ha)
-
-        mkOpaque lbs
-
-    _ -> throwIO $ BadFormException @c nil
-
-  entry $ bindMatch "hbs2:peer:storage:block:del" $ \case
-    [HashLike ha] -> do
-      flip runContT pure do
-        sto <- getStorage
-        delBlock sto (fromHashRef ha)
-        pure nil
-
-    _ -> throwIO $ BadFormException @c nil
-
-  entry $ bindMatch "hbs2:peer:storage:block:size" $ \case
-    [HashLike ha] -> do
-      flip runContT pure do
-        sto <- getStorage
-        mbsz <- hasBlock sto (fromHashRef ha)
-        pure $ maybe (mkSym "no-block") mkInt mbsz
-
-    _ -> throwIO $ BadFormException @c nil
-
-  -- stores *small* block
-  entry $ bindMatch "hbs2:peer:storage:block:put" $ \case
-
-    [isOpaqueOf @LBS.ByteString -> Just lbs] -> do
-      sto <- getStorage
-      (putBlock sto lbs <&> fmap (mkSym . show . pretty . HashRef) )
-        >>= orThrowUser "storage error"
-
-    [isOpaqueOf @BS.ByteString -> Just bs] -> do
-      sto <- getStorage
-      (putBlock sto (LBS.fromStrict bs) <&> fmap (mkSym . show . pretty . HashRef) )
-        >>= orThrowUser "storage error"
-
-    -- FIXME: deprecate-this
-    [ListVal [SymbolVal "blob", LitStrVal s]] -> do
-      flip runContT pure do
-        sto <- getStorage
-        lift $ putTextLit sto s
-
-    [LitStrVal s] -> do
-      flip runContT pure do
-        sto <- getStorage
-        lift $ putTextLit sto s
-
-    [] -> do
-        bs <- liftIO BS.getContents
-        sto <- getStorage
-        putBlock sto (LBS.fromStrict bs) >>= \case
-          Nothing -> pure nil
-          Just h  -> pure $ mkSym (show $ pretty $ HashRef h)
-
-    e -> throwIO $ BadFormException @c (mkList e)
-
-  brief "checks if peer available"
-    $ noArgs
-    $ returns "dict" "dictionary of peer attributes"
-    $ examples [qc|
-(hbs2:peer:poke)
-(
- (peer-key: "35gKUG1mwBTr3tQpjWwR2kBYEnDmHxesoJL5Lj7tMjq3")
- (udp: "0.0.0.0:7354")
- (tcp: "tcp://0.0.0.0:3001")
- (local-multicast: "239.192.152.145:10153")
- (rpc: "/tmp/hbs2-rpc.socket")
- (http-port: 5000))
-    |]
-    $ entry $ bindMatch "hbs2:peer:poke" $ \case
-      _ -> do
-        api <- getClientAPI @PeerAPI @UNIX
-        callRpcWaitMay @RpcPoke (TimeoutSec 1) api ()
-          <&> fromMaybe ""
-          <&> parseTop
-          <&> either (const nil) (mkList . fmap fixContext)
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/RefChan.hs
@ -1,405 +0,0 @@
-module HBS2.CLI.Run.RefChan
-  ( module HBS2.CLI.Run.RefChan
-  , keymanNewCredentials
-  ) where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.KeyMan
-import HBS2.CLI.Run.Internal.RefChan
-
-
-import HBS2.Data.Types.Refs
-import HBS2.Peer.CLI.Detect
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.API.RefChan
-import HBS2.Peer.RPC.Client.RefChan as Client
-
-import HBS2.Storage.Operations.ByteString
-
-- import HBS2.Net.Proto
-- import HBS2.Net.Auth.Credentials
-- import HBS2.Base58
-- import HBS2.Defaults
-- import HBS2.Events
-- import HBS2.Peer.Proto.Peer
-- import HBS2.Net.Proto.Sessions
-import HBS2.Data.Types.Refs
-import HBS2.Data.Detect
-- import HBS2.Data.Types.SignedBox
-- import HBS2.Storage
-
-
-import HBS2.Peer.Proto.RefChan
-import Data.Either
-import HBS2.Base58
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Auth.Schema()
-import HBS2.Data.Types.SignedBox
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Storage
-
-import HBS2.KeyMan.Keys.Direct
-import HBS2.KeyMan.App.Types
-
-import Data.HashMap.Strict qualified as HM
-import Data.HashSet qualified as HS
-import Data.Coerce
-import Control.Monad.Trans.Cont
-import Control.Monad.Trans.Maybe
-import Control.Monad.Except
-import Data.ByteString.Lazy qualified as LBS
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.ByteString.Char8 qualified as BS8
-import Data.Text qualified as Text
-import Codec.Serialise
-import Control.Concurrent.STM qualified as STM
-
-import Text.InterpolatedString.Perl6 (qc)
-import Streaming.Prelude qualified as S
-
-refchanEntries :: forall c m . ( IsContext c
-                               , MonadUnliftIO m
-                               , Exception (BadFormException c)
-                               , HasClientAPI RefChanAPI UNIX m
-                               , HasClientAPI StorageAPI UNIX m
-                               , HasClientAPI PeerAPI UNIX m
-                               , HasStorage m
-                               ) => MakeDictM  c m ()
-refchanEntries = do
-
-  brief "requests all rechans that peer is subcribed to"
-    $ args []
-    $ returns "list" "list of all refchans"
-    $ examples [qc|
-
-(hbs2:refchan:list)
-("Atg67E6CPMJWKvR9BvwZTTEjg3Hjz4CYCaEARGANepGP"
- "A5W6jPBjzvdpxaQ2e8xBLYaRZjPXzi4yX7xjC52gTiKk"
- "EjjK7rpgRRJ4yzAhTcwis4XawwagCbmkns8n73ogY3uS")
-    |]
-    $ entry $ bindMatch "hbs2:refchan:list" $ \case
-        [] -> do
-          flip runContT pure do
-            api <- getClientAPI @PeerAPI @UNIX
-            r <- callService @RpcPollList2 api (Just "refchan", Nothing)
-                   >>= orThrowUser "can't get refchan list"
-            pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
-
-        _ -> throwIO (BadFormException @c nil)
-
-
-  brief "reads refchan head block"
-    $ args [arg "symbol" "parsed|_", arg "string" "PUBKEY"]
-    $ returns "" "string"
-    $ examples [qc|
-
-(hbs2:refchan:head:get :parsed ExTZuEy2qVBRshWdSwfxeKcMmQLbK2f5NxRwhvXda9qd)
-(version 2)
-(quorum 1)
-(wait 10)
-(peer "5tZfGUoQ79EzFUvyyY5Wh1LzN2oaqhrn9kPnfk6ByHpf" 1)
-(peer "35gKUG1mwBTr3tQpjWwR2kBYEnDmHxesoJL5Lj7tMjq3" 1)
-(peer "5GnroAC8FXNRL8rcgJj6RTu9mt1AbuNd5MZVnDBcCKzb" 1)
-(author "Gu5FxngYYwpRfCUS9DJBGyH3tvtjXFbcZ7CbxmJPWEGH")
-(author "ExTZuEy2qVBRshWdSwfxeKcMmQLbK2f5NxRwhvXda9qd")
-(reader "5UXrEhYECJ2kEQZZPEf4TisfWsLNdh2nGYQQz8X9ioMv")
-(reader "CcRDzezX1XQdPxRMuMKzJkfHFB4yG7vGJeTYvScKkbP8")
-; (head-extensions: (count: 0) (size 0))
-
-
-(hbs2:refchan:head:get :whatever ExTZuEy2qVBRshWdSwfxeKcMmQLbK2f5NxRwhvXda9qd)
-HucjFUznHJeA2UYZCdUFHtnE3pTwhCW5Dp7LV3ArZBcr
-
-    |]
-    $ entry $ bindMatch "hbs2:refchan:head:get" $ \case
-      [StringLike what, SignPubKeyLike puk] -> do
-
-        flip runContT pure do
-
-          callCC $ \exit -> do
-
-            w <- lift (getRefChanHeadHash @UNIX puk)
-
-            hx <- ContT $ maybe1 w (pure nil)
-
-            case what of
-              "parsed"  -> do
-                  hdblk <- lift (Client.getRefChanHead @UNIX puk)
-
-                  exit $ mkStr (show $ pretty hdblk)
-
-              _ -> exit $ mkStr (show $ pretty $ AsBase58 hx)
-
-            pure nil
-
-
-      _ -> throwIO (BadFormException @c nil)
-
-  entry $ bindMatch "hbs2:refchan:head:update" $ \syn -> do
-
-      (rchan, rch) <- case syn of
-        [SignPubKeyLike rchan, StringLike headFile] -> do
-
-            rch <- liftIO (readFile headFile)
-               <&> fromStringMay @(RefChanHeadBlock L4Proto)
-               >>= orThrowUser "can't parse RefChanHeadBlock"
-
-            pure (rchan, rch)
-
-        [SignPubKeyLike rchan, ListVal syn] -> do
-            rch <- fromStringMay @(RefChanHeadBlock L4Proto) (show $ vcat (fmap pretty syn))
-                     & orThrowUser "can't parse RefChanHeadBlock"
-
-            pure (rchan, rch)
-
-        _ -> throwIO (BadFormException @c nil)
-
-      sto <- getStorage
-
-      rchanApi <- getClientAPI @RefChanAPI @UNIX
-
-      creds <- runKeymanClient $ loadCredentials rchan
-                     >>= orThrowUser "can't load credentials"
-
-      let box = makeSignedBox @'HBS2Basic (view peerSignPk creds) (view peerSignSk creds) rch
-
-      href <- writeAsMerkle sto  (serialise box)
-
-      callService @RpcRefChanHeadPost rchanApi (HashRef href)
-          >>= orThrowUser "can't post refchan head"
-
-      pure nil
-
-
-  entry $ bindMatch "hbs2:refchan:get" $ \case
-    [SignPubKeyLike rchan] -> do
-
-      api <- getClientAPI @RefChanAPI @UNIX
-
-      h <- callService @RpcRefChanGet api rchan
-             >>= orThrowUser "can't request refchan head"
-
-      pure $ maybe nil (mkStr . show . pretty . AsBase58) h
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:refchan:create" $ \syn -> do
-
-    peerApi  <- getClientAPI @PeerAPI @UNIX
-
-    rch <- case syn of
-
-      [ListVal es] -> do
-        fromStringMay @(RefChanHeadBlock L4Proto) (show $ vcat (fmap pretty es))
-             & orThrowUser "Invalid refchan head syntax"
-
-      [StringLike headFile] -> do
-        liftIO (readFile headFile)
-           <&> fromStringMay @(RefChanHeadBlock L4Proto)
-           >>= orThrowUser "can't parse RefChanHeadBlock"
-
-      [] -> do
-       poked <- callService @RpcPoke peerApi ()
-                   >>= orThrowUser "can't poke hbs2-peer"
-                   <&> parseTop
-                   >>= orThrowUser "invalid hbs2-peer attributes"
-
-       ke <- [ x
-             | ListVal [SymbolVal "peer-key:", SignPubKeyLike x] <- poked
-             ] & headMay & orThrowUser "hbs2-peer key not found"
-
-       let rch0 = refChanHeadDefault @L4Proto
-                   & set refChanHeadPeers (HM.singleton ke 1)
-                   & set refChanHeadAuthors (HS.singleton ke)
-
-       pure rch0
-
-      _ -> throwIO (BadFormException @c nil)
-
-    refchan <- createNewRefChan @c Nothing rch
-    pure $ mkSym (show $ pretty (AsBase58 refchan))
-
-  brief "prints refchan head example"
-    $ returns "nil" mempty
-    $ entry $ bindMatch "hbs2:refchan:head:example" $ nil_ $ \case
-        [] -> flip runContT pure do
-
-          let rch0 = refChanHeadDefault @L4Proto
-
-          api <- getClientAPI @PeerAPI  @UNIX
-
-          pips <- callService @RpcPeers api ()
-                    <&> either (const mempty) (HM.fromList . fmap ((,1) . fst) . take 3)
-
-
-          creds <- replicateM 3 (newCredentialsEnc @HBS2Basic 1)
-
-          let authors = fmap (view peerSignPk) creds
-                            & HS.fromList
-
-          let readers = foldMap (view peerKeyring) creds
-                            & fmap (view krPk)
-                            & take 3
-                            & HS.fromList
-
-          let rch = ( set refChanHeadPeers pips
-                    . set refChanHeadAuthors authors
-                    . set refChanHeadReaders readers
-                    . set refChanHeadNotifiers authors
-                    ) rch0
-
-          liftIO $ print $
-               ";" <+> "this is an example of refchan head block config"
-            <> line
-            <> ";" <+> "edit it before applying" <> line
-            <> ";"  <+> "set up the actual keys / credentials you need" <> line
-            <> line <> line
-            <> ";" <+> "(version INT) is the head block version" <> line
-            <> ";" <+> "the refchan head block will be set only" <>line
-            <> ";" <+> "if it's version  if greater than the already existed one" <> line
-            <> line
-
-            <> ";" <+> "(quorum INT) is a number of accept messages issued by peers" <> line
-            <> ";" <+> "to include propose message to the refchan" <> line
-            <> line
-
-            <> ";" <+> "(wait INT) is an quorum  wait time in seconds" <> line
-            <> line
-
-            <> ";" <+> "(peer PUBKEY WEIGHT) sets the peer allowed for posting propose/accept messages" <> line
-            <> ";" <+> "PUBKEY is a SIGNATURE public key as base58 string" <> line
-            <> ";" <+> "only messages from that peers will be accepted" <> line
-            <> ";" <+> "WEIGHT is not used yet but reserved for the future" <> line
-            <> ";" <+> "this parameter is optional but there is should be some peers or" <> line
-            <> ";" <+> "all messages will be sent to nowhere" <> line
-            <> line
-
-            <> ";" <+> "(author PUBKEY) adds 'author' i.e. key that is allowed to sign the propose message" <> line
-            <> ";" <+> "PUBKEY is a SIGNATURE public key as base58 string" <> line
-            <> ";" <+> "only the propose  messages signed by one of thise keys will be accepted" <> line
-            <> line
-
-            <> ";" <+> "(notifier PUBKEY) adds 'notifier' i.e. key that is allowed to sign the notify message" <> line
-            <> ";" <+> "PUBKEY is a SIGNATURE public key as base58 string" <> line
-            <> ";" <+> "only the propose  messages signed by one of thise keys will be accepted" <> line
-            <> ";" <+> "notify messages are not written to the refchan merkle tree" <> line
-            <> ";" <+> "and they useful for implementing any sort of ephemeral messaging" <> line
-            <> ";" <+> "those clauses are OPTIONAL and may be omitted" <> line
-            <> line
-
-            <> ";" <+> "(reader PUBKEY) adds 'author' i.e. key that is allowed to decrypt messages" <> line
-            <> ";" <+> "PUBKEY is a ENCRYPTION public key as base58 string" <> line
-            <> ";" <+> "NOTE: messages in a refchan are not encrypted by default" <> line
-            <> ";" <+> "    it's totally up to an application for this refchan" <> line
-            <> ";" <+> "    therefore this clause is just used for setting reader keys to" <> line
-            <> ";" <+> "    implement any ACL/encrypting mechanism" <> line
-            <> ";" <+> "    i.e. groupkey may be inherited from the RefChanHead block" <> line
-            <> ";" <+> "    to encrypt data posted to a refchan" <> line
-            <> ";" <+> "those clauses are OPTIONAL and may be omitted" <> line
-            <> line
-
-            <> pretty rch
-
-        _ -> throwIO (BadFormException @c nil)
-
-
-  brief "creates RefChanUpdate/AnnotatedHashRef transaction for refchan" $
-    args [arg "string" "sign-key", arg "string" "payload-tree-hash"] $
-    entry $ bindMatch "hbs2:refchan:tx:annref:create" $ \case
-      [SignPubKeyLike signpk, HashLike hash] -> do
-         sto <- getStorage
-         void $ hasBlock sto (fromHashRef hash) `orDie` "no block found"
-         let lbs = AnnotatedHashRef Nothing hash & serialise
-         creds  <- runKeymanClientRO $ loadCredentials signpk >>= orThrowUser "can't find credentials"
-         let box = makeSignedBox @HBS2Basic (view peerSignPk creds) (view peerSignSk creds) (LBS.toStrict lbs) & serialise
-         pure $ mkForm @c "blob" [mkStr (LBS8.unpack box)]
-
-      _ -> throwIO (BadFormException @c nil)
-
-
-  brief "creates RefChanUpdate/SeqRef transaction for refchan" $
-    args [arg "string" "sign-key", arg "string" "payload-tree-hash", arg "(-t int)?" "seqno"] $
-    entry $ bindMatch "hbs2:refchan:tx:seqref:create" $ \syn -> do
-      now <- liftIO $ getPOSIXTime <&> round
-      let (opts, argz) = splitOpts [("-s",1)] syn
-      let s = headDef now  [ x | MatchOption "-n" (LitIntVal x) <- opts]
-      case opts of
-        [SignPubKeyLike signpk, HashLike hash] -> do
-           sto <- getStorage
-           void $ hasBlock sto (fromHashRef hash) `orDie` "no block found"
-           let lbs = SequentialRef s (AnnotatedHashRef Nothing hash) & serialise
-           creds  <- runKeymanClientRO $ loadCredentials signpk >>= orThrowUser "can't find credentials"
-           let box = makeSignedBox @HBS2Basic (view peerSignPk creds) (view peerSignSk creds) (LBS.toStrict lbs) & serialise
-           pure $ mkForm @c "blob" [mkStr (LBS8.unpack box)]
-        _ -> throwIO (BadFormException @c nil)
-
-  brief "creates RefChanUpdate/Raw transaction for refchan" $
-    args [arg "string" "sign-key", arg "string" "data"] $
-    entry $ bindMatch "hbs2:refchan:tx:raw:create" $ \syn -> do
-      case syn of
-        [SignPubKeyLike signpk, StringLike x] -> do
-           let lbs = LBS8.pack x & serialise
-           creds  <- runKeymanClientRO $ loadCredentials signpk >>= orThrowUser "can't find credentials"
-           let box = makeSignedBox @HBS2Basic (view peerSignPk creds) (view peerSignSk creds) (LBS.toStrict lbs) & serialise
-           mkOpaque @c box
-
-        _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:refchan:tx:raw:list" $ \case
-    [SignPubKeyLike rchan] -> lift do
-
-      q <- newTQueueIO
-
-      walkRefChanTx @UNIX (const $ pure True) rchan $ \txh u -> do
-
-        case  u of
-
-          A (AcceptTran (Just ts) self what) -> do
-            let tx = fromIntegral ts :: Integer
-            let hs = show $ pretty self
-            let they = show $ pretty what
-            let x = mkForm @c "accept" [ mkSym hs, mkInt tx, mkSym they ]
-            atomically $ writeTQueue q x
-
-          A _  -> none
-
-          P1 ppk h (ProposeTran _ box) -> void $ runMaybeT do
-            (pk, bs) <- unboxSignedBox0 box & toMPlus
-            bss <- deserialiseOrFail @LBS.ByteString (LBS.fromStrict bs) & toMPlus
-            e <- mkOpaque bss
-            let hs = show $ pretty h
-            let ppks = show (pretty (AsBase58 ppk))
-            let pks  = show (pretty (AsBase58 pk))
-            let x = mkForm @c "propose" [ mkSym hs, mkSym ppks, mkSym pks, e ]
-            atomically $ writeTQueue q x
-
-          P0{} -> none
-
-      mkList <$>  atomically (STM.flushTQueue q)
-
-    e -> throwIO (BadFormException @c (mkList e))
-
-  brief "posts Propose transaction to the refchan" $
-    args [arg "string" "refchan", arg "blob" "signed-box"] $
-    entry $ bindMatch "hbs2:refchan:tx:propose" $ nil_ $ \syn -> do
-
-      (chan,lbs) <- case syn of
-         [SignPubKeyLike rchan, ListVal [SymbolVal "blob", LitStrVal box]] -> do
-          bbox <- Text.unpack box & LBS8.pack & deserialiseOrFail & orThrowUser "bad transaction"
-          pure (rchan, bbox)
-
-         [SignPubKeyLike rchan, MatchOpaqueVal @_ @LBS.ByteString lbs] -> do
-           pure (rchan, lbs)
-
-         _ -> throwIO (BadFormException @c (mkList syn))
-
-      api <- getClientAPI @RefChanAPI @UNIX
-      box  <- deserialiseOrFail lbs & orThrowUser "invalid box"
-      void $ callService @RpcRefChanPropose api (chan, box)
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/RefLog.hs
@ -1,234 +0,0 @@
-module HBS2.CLI.Run.RefLog
-  ( module HBS2.CLI.Run.RefLog
-  , module HBS2.CLI.Run.Internal.RefLog
-  ) where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.KeyMan
-import HBS2.CLI.Run.Internal.RefLog
-
-import HBS2.Data.Types.Refs
-import HBS2.Merkle
-import HBS2.Data.Detect
-import HBS2.Storage
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.CLI.Detect
-import HBS2.Peer.RPC.Client.Unix
-import HBS2.Peer.RPC.API.Peer
-import HBS2.Peer.RPC.API.RefLog
-import HBS2.Peer.RPC.API.Storage
-
-import HBS2.Peer.Proto hiding (request)
-import HBS2.Base58
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Auth.Schema()
-
-import HBS2.KeyMan.Keys.Direct
-import HBS2.KeyMan.App.Types
-
-import Codec.Serialise
-import Data.Coerce
-import Data.Either
-import Data.ByteString qualified as BS
-import Data.ByteString.Char8 qualified as BS8
-import Data.ByteString (ByteString)
-import Data.ByteString.Lazy.Char8 qualified as LBS8
-import Data.ByteString.Lazy qualified as LBS
-import Data.Text.Encoding qualified as TE
-import Data.Text qualified as Text
-import Control.Monad.Trans.Cont
-
-import Streaming.Prelude qualified as S
-
-getCredentialsForReflog :: MonadUnliftIO m => RefLogKey 'HBS2Basic -> m (PeerCredentials 'HBS2Basic)
-getCredentialsForReflog reflog = do
-  runKeymanClientRO (loadCredentials reflog)
-     >>= orThrowUser "credentials not found"
-
-mkRefLogUpdateFrom :: (MonadUnliftIO m) => RefLogKey 'HBS2Basic -> m ByteString ->  m (RefLogUpdate L4Proto)
-mkRefLogUpdateFrom reflog mbs = do
-  what <- getCredentialsForReflog reflog
-  let puk = view peerSignPk what
-  let privk = view peerSignSk what
-  txraw <- mbs
-  makeRefLogUpdate @L4Proto @'HBS2Basic (coerce puk) privk txraw
-
-
-reflogEntries :: forall c m . ( IsContext c
-                              , Exception (BadFormException c)
-                              , MonadUnliftIO m
-                              , HasStorage m
-                              , HasClientAPI PeerAPI UNIX m
-                              , HasClientAPI RefLogAPI UNIX m
-                              , HasClientAPI StorageAPI UNIX m
-                              ) => MakeDictM  c m ()
-reflogEntries = do
-
-  entry $ bindMatch "hbs2:reflog:create" $ \case
-    [] -> do
-      reflog <- keymanNewCredentials (Just "reflog") 0
-
-      api <- getClientAPI @PeerAPI  @UNIX
-      void $ callService @RpcPollAdd api (reflog, "reflog", 31)
-      pure $ mkStr (show $ pretty (AsBase58 reflog))
-
-    _ -> throwIO (BadFormException @C nil)
-
-  entry $ bindMatch "hbs2:reflog:add" $ \case
-    [SignPubKeyLike reflog] -> do
-      -- reflog <- keymanNewCredentials (Just "reflog") 0
-
-      api <- getClientAPI @PeerAPI @UNIX
-      void $ callService @RpcPollAdd api (reflog, "reflog", 31)
-      pure $ mkStr (show $ pretty (AsBase58 reflog))
-
-    _ -> throwIO (BadFormException @C nil)
-
-
-
-  entry $ bindMatch "hbs2:reflog:tx:annhashref:create" $ \case
-    [StringLike puk, StringLike hash] -> do
-      reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
-      sto <- getStorage
-      hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
-      void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
-      let sref = AnnotatedHashRef Nothing hashref
-      rlu <- mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
-      pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
-
-    _ -> throwIO (BadFormException @C nil)
-
-
-  entry $ bindMatch "hbs2:reflog:tx:copy:all" $ nil_ \case
-    [SignPubKeyLike a, SignPubKeyLike b] -> do
-
-      let cre = runKeymanClientRO (loadCredentials b)
-                   >>= orThrow (RefLogNoCredentials (show $ pretty (AsBase58 b)))
-
-      copyTransactions cre a b
-
-    e -> throwIO (BadFormException @c (mkList e))
-
-  entry $ bindMatch "hbs2:reflog:tx:post" $ nil_ \case
-    [BlobLike blob] -> do
-      caller <- getClientAPI @RefLogAPI @UNIX
-      wtf <- deserialiseOrFail @(RefLogUpdate L4Proto) (LBS.fromStrict blob)
-              & orThrowUser "invalid tx"
-      void $ callService @RpcRefLogPost caller wtf
-
-    _ -> throwIO (BadFormException @C nil)
-
-  entry $ bindMatch "hbs2:reflog:tx:seqref:create" $ \case
-    [StringLike puk, LitIntVal sn, StringLike hash] -> do
-      reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
-      sto <- getStorage
-      hashref <- orThrowUser "bad hash" (fromStringMay @HashRef hash)
-      void $ hasBlock sto (fromHashRef hashref) `orDie` "no block"
-      let sref = SequentialRef sn (AnnotatedHashRef Nothing hashref)
-      rlu <- mkRefLogUpdateFrom reflog (pure $ LBS.toStrict $ serialise sref) <&> serialise
-      pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
-
-    _ -> throwIO (BadFormException @C nil)
-
-  entry $ bindMatch "hbs2:reflog:tx:raw:create" $ \case
-    [SymbolVal "stdin", SignPubKeyLike reflog] -> do
-
-      rlu <- mkRefLogUpdateFrom (RefLogKey reflog) ( liftIO BS.getContents )
-                <&> serialise
-
-      pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
-
-    [LitStrVal s, StringLike rlo] -> do
-      reflog <- orThrowUser "bad reflog" (fromStringMay rlo)
-
-      rlu <- mkRefLogUpdateFrom reflog ( pure (BS8.pack (Text.unpack s)) )
-               <&> serialise
-
-      pure $ mkForm "blob" [mkStr (LBS8.unpack rlu)]
-
-    _ -> throwIO (BadFormException @C nil)
-
-
-  entry $ bindMatch "hbs2:reflog:get" $ \case
-    [StringLike puk] -> do
-
-      flip runContT pure do
-        reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
-        api <- getClientAPI @RefLogAPI  @UNIX
-        what <- callService @RpcRefLogGet api reflog
-                  >>= orThrowUser "can't get reflog"
-        pure $ mkStr (show $ pretty what)
-
-    _ -> throwIO (BadFormException @C nil)
-
-  entry $ bindMatch "hbs2:reflog:fetch" $ \case
-    [StringLike puk] -> do
-      flip runContT pure do
-        reflog <- orThrowUser "bad reflog key" (fromStringMay puk)
-        api <- getClientAPI @RefLogAPI  @UNIX
-        void $ callService @RpcRefLogFetch api reflog
-        pure $ mkStr "okay"
-
-    _ -> throwIO (BadFormException @C nil)
-
-  entry $ bindMatch "hbs2:reflog:list" $ \case
-    [] -> do
-      flip runContT pure do
-        api <- getClientAPI @PeerAPI @UNIX
-        r <- callService @RpcPollList2 api (Just "reflog", Nothing)
-               >>= orThrowUser "can't get reflog list"
-        pure $ mkList $ fmap (mkStr . show . pretty . AsBase58 . view _1) r
-
-    _ -> throwIO (BadFormException @C nil)
-
-
-  entry $ bindMatch "hbs2:reflog:tx:decode" $ \case
-    [HashLike s] -> do
-      sto <- getStorage
-      blk <- getBlock sto (coerce s)
-      pure $ maybe1 blk nil (decodeRefLogTx @c (Just s))
-
-    [MatchOpaqueVal @_ @(HashRef, ByteString) (ha,bs)] -> do
-      pure $ decodeRefLogTx @c (Just ha) (LBS.fromStrict bs)
-
-    e -> throwIO $ BadFormException @c nil
-
-  entry $ bindMatch "hbs2:reflog:tx:list" $ \case
-     [e, SignPubKeyLike puk] -> do
-
-      flip runContT pure do
-
-        callCC \exit -> do
-
-          api <- getClientAPI @RefLogAPI  @UNIX
-          sto <- getStorage
-
-          r <- callService @RpcRefLogGet api puk
-                 >>= orThrowUser "can't get reflog value"
-
-          rlh <- ContT $ maybe1 r (pure nil)
-
-          hashes <- S.toList_ do
-                      walkMerkle @[HashRef] (fromHashRef rlh) (getBlock sto) $ \case
-                        (Left _) -> lift $ exit nil
-                        (Right (hs :: [HashRef]))  -> S.each hs
-
-          rr <- forM hashes $ \ha -> do
-
-            tx <- getBlock sto (coerce ha)
-                     >>= orThrowUser "missed-block"
-                     <&> deserialiseOrFail @(RefLogUpdate L4Proto)
-                     >>= orThrowUser "invalid-tx"
-
-            let bs = view refLogUpdData tx
-
-            payload <- mkOpaque (ha,bs)
-
-            lift $ apply_ e [payload]
-
-          pure $ mkList rr
-
-     _ -> throwIO (BadFormException @C nil)
-
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Sigil.hs
@ -1,135 +0,0 @@
-{-# OPTIONS_GHC -Wno-name-shadowing #-}
-module HBS2.CLI.Run.Sigil where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-
-import HBS2.Data.Types.Refs
-import HBS2.Base58
-import HBS2.Storage
-import HBS2.Data.Types.SignedBox
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Auth.Credentials.Sigil
-
-import Data.List qualified as L
-import Data.ByteString.Char8 qualified as BS8
-import Data.ByteString.Lazy qualified as LBS
-import Lens.Micro.Platform
-
-
-sigilEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m, HasStorage m)
-             => MakeDictM c m ()
-sigilEntries = do
-
-  entry $ bindMatch "hbs2:sigil:sign-pubkey" $ \case
-    [ ListVal (SymbolVal sigil : (hasKey "sign-pubkey" -> Just s)) ] -> do
-      pure s
-
-    _ -> throwIO $ BadFormException @C nil
-
-
-  entry $ bindMatch "hbs2:sigil:encrypt-pubkey" $ \case
-    [ ListVal (SymbolVal sigil : (hasKey "encrypt-pubkey" -> Just s)) ] -> do
-      pure s
-
-    _ -> throwIO $ BadFormException @C nil
-
-  brief "parses sigil"
-    $ args [ arg "sigil" "string" ]
-    $ examples [qc|hbs2:sigil:parse [str:read-file some.sigil]|]
-    $ entry $ bindMatch "hbs2:sigil:parse" $ \case
-      [StringLike s] -> do
-
-        let bs = BS8.pack s
-        sigil <- pure (parseSerialisableFromBase58 @(Sigil 'HBS2Basic) bs)
-                    `orDie` "parse sigil failed"
-
-        (_,sd) <- pure (unboxSignedBox0 @(SigilData 'HBS2Basic) (sigilData sigil))
-                    `orDie` "signature check failed"
-
-        pure (parseTop $ show $ parens ("sigil" <> line <> indent 2 (vcat $ [pretty sigil, pretty sd])))
-                `orDie` "bad sigil"
-                <&> head
-
-      _ -> throwIO $ BadFormException @C nil
-
-
-  brief "loads sigil from hbs2 store as base58 string"
-    $ args [arg "hash" "string" ]
-    $ returns  "sigil" "string"
-    $ entry $ bindMatch "hbs2:sigil:load:base58" $ \case
-      [HashLike key] -> lift do
-        sto <- getStorage
-        r <- loadSigil @HBS2Basic sto key >>= orThrowUser "no sigil found"
-        pure $ mkStr @c ( show $ pretty $ AsBase58 r  )
-
-      _ -> throwIO $ BadFormException @c nil
-
-  brief "stores sigil to hbs2 store"
-    $ args [arg "string" "file" ]
-    $ returns "string" "hash"
-    $ entry $ bindMatch "hbs2:sigil:store:file" $ \case
-      [StringLike fn] -> lift do
-        sto <- getStorage
-        lbs <- liftIO (LBS.readFile fn)
-        sigil <- decodeSigil @HBS2Basic lbs & orThrowUser "invalid sigil file"
-        href <- storeSigil sto sigil
-        pure $ mkStr ( show $ pretty href )
-
-      _ -> throwIO $ BadFormException @c nil
-
-
-  brief "create sigil from keyring" $
-   desc [qc|
-
-;; creates from keyring, uses first encryption key if found
-
-hbs2:sigil:create:from-keyring KEYRING-FILE
-
-;; creates from keyring, uses n-th encryption key if found, N starts from 1
-
-hbs2:sigil:create:from-keyring KEYRING-FILE N
-
-;; creates from keyring, uses encryption key wit prefix S if found
-
-hbs2:sigil:create:from-keyring KEYRING-FILE S
-
-   |]
-   $ entry $ bindMatch "hbs2:sigil:create:from-keyring" $ \syn -> do
-
-      let readKeyring fn = liftIO (BS8.readFile fn)
-                             <&>  parseCredentials @'HBS2Basic . AsCredFile
-                             >>= orThrowUser "malformed keyring file"
-
-
-      (cred, KeyringEntry enc _ _) <- case syn of
-            [ StringLike fn ] -> do
-              s <- readKeyring fn
-              kr <- headMay (view peerKeyring s) & orThrowUser "encryption key missed"
-              pure (s,kr)
-
-            [ StringLike fn, LitIntVal n ] -> do
-              s <- readKeyring fn
-              kr <- headMay (drop (fromIntegral (max 0 (n-1))) (view peerKeyring s))
-                      & orThrowUser "encryption key not found"
-              pure (s,kr)
-
-            [ StringLike fn, StringLike p ] -> do
-
-              s <- readKeyring fn
-              kr <- findKey p (view peerKeyring s)  & orThrowUser "encryption key not found"
-              pure (s,kr)
-
-            _ -> throwIO $ BadFormException @c nil
-
-      sigil <- pure (makeSigilFromCredentials @'HBS2Basic cred enc Nothing Nothing)
-                `orDie` "can't create a sigil"
-
-      pure $ mkStr (show $ pretty $ AsBase58 sigil)
-
-    where
-      findKey s xs = headMay [ e
-                             | e@(KeyringEntry k _ _) <- xs
-                             , L.isPrefixOf s (show $ pretty (AsBase58 k))
-                             ]
-
--- a/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs
+++ b/hbs2-cli/lib/HBS2/CLI/Run/Tree.hs
@ -1,194 +0,0 @@
-module HBS2.CLI.Run.Tree
-  ( treeEntries
-  ) where
-
-import HBS2.CLI.Prelude
-import HBS2.CLI.Run.Internal
-import HBS2.CLI.Run.Internal.GroupKey as G
-import HBS2.CLI.Run.Internal.Merkle
-
-import HBS2.Defaults
-
-import HBS2.Base58
-import HBS2.Data.Types.Refs
-import HBS2.Merkle
-import HBS2.Data.Detect
-import HBS2.System.Dir
-import HBS2.Storage
-import HBS2.Storage.Operations.Class
-import HBS2.Storage.Operations.ByteString
-import HBS2.Storage.Operations.Missed
-import HBS2.Storage.Operations.Delete
-
-import HBS2.Net.Auth.Schema()
-
-import HBS2.Peer.RPC.API.Storage
-import HBS2.Peer.RPC.Client
-import HBS2.Peer.RPC.Client.Unix
-
-import Data.ByteString.Lazy qualified as LBS
-import Data.Coerce
-import Data.Text qualified as Text
-import Control.Monad.Except
-import Codec.Serialise
-import Streaming.Prelude qualified as S
-
-pattern GroveHashes :: forall {c}. [HashRef] -> [Syntax c]
-pattern GroveHashes hashes <- ( groveHashes -> hashes )
-
-groveHashes :: [Syntax c] -> [HashRef]
-groveHashes = \case
-  [ ListVal (HashLikeList hashes) ] -> hashes
-  HashLikeList hashes -> hashes
-  _ -> mempty
-
-treeEntries :: forall c m . ( IsContext c
-                                , MonadUnliftIO m
-                                , Exception (BadFormException c)
-                                , HasStorage m
-                                , HasClientAPI StorageAPI UNIX m
-                                ) => MakeDictM c m ()
-treeEntries = do
-
-  brief "reads merkle tree data from storage"
-    $ args [arg "string" "tree"]
-    $ desc "hbs2:tree:read HASH"
-    $ returns "bytestring" "data"
-    $ entry $ bindMatch "hbs2:tree:read" $ \case
-       [ HashLike h ] -> lift do
-        sto <- getStorage
-
-        co <- runExceptT (getTreeContents sto h)
-                >>= orThrowPassIO
-
-        mkOpaque co
-
-       _ -> throwIO (BadFormException @c nil)
-
-
-  brief "reads merkle tree data from storage to stdout"
-    $ args [arg "string" "tree"]
-    $ desc "hbs2:tree:read:stdout HASH"
-    $ returns "nil" ""
-    $ entry $ bindMatch "hbs2:tree:read:stdout" $ nil_ \case
-       [ HashLike h ] -> lift do
-        sto <- getStorage
-
-        runExceptT (getTreeContents sto h)
-                >>= orThrowPassIO
-                >>= liftIO . LBS.putStr
-
-       _ -> throwIO (BadFormException @c nil)
-
-
-  brief "creates a 'grove' -- an annotated hashref list"
-    $ args [arg "list of hashes" "trees"]
-    $ desc [qc|hbs2:grove creates a 'grove' - merkle tree of list of hashes of merkle trees
-It's just an easy way to create a such thing, you may browse it by hbs2 cat -H
-|]
-    $ returns "hash" "string"
-    $ entry $ bindMatch "hbs2:grove" $ \case
-        HashLikeList hashes@(x:_) -> lift do
-          sto <- getStorage
-          let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) hashes
-          mkSym . show . pretty <$> liftIO (makeMerkle 0 pt $ \(_,_,bss) -> do
-                  void $ putBlock sto bss)
-
-        _ -> throwIO (BadFormException @c nil)
-
-  entry $ bindMatch "hbs2:grove:annotated" $ \case
-    (ListVal ann : GroveHashes hashes) -> lift do
-      sto <- getStorage
-
-      let pt = toPTree (MaxSize defHashListChunk) (MaxNum defTreeChildNum) hashes
-
-      tree <- liftIO (makeMerkle 0 pt $ \(_,_,bss) -> do
-                void $ putBlock sto bss)
-
-      block <- getBlock sto tree
-                  >>= orThrow MissedBlockError
-                  <&> deserialiseOrFail @(MTree [HashRef])
-                  >>= orThrow UnsupportedFormat
-
-      let kwa = Text.unlines $ fmap (Text.pack . show . pretty) ann
-      let mann = MTreeAnn (ShortMetadata kwa) NullEncryption block
-
-      r <- putBlock sto (serialise mann)
-              >>= orThrowUser "can't write tree"
-              <&> HashRef
-
-      pure $ mkSym (show $ pretty r)
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:tree:missed" $ \case
-    [HashLike href] -> do
-      sto <- getStorage
-      findMissedBlocks sto href
-                <&> mkList . fmap (mkStr @c . show . pretty)
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  entry $ bindMatch "hbs2:tree:refs" $ \case
-    [HashLike href] -> do
-      sto <- getStorage
-
-      blk <- getBlock sto (coerce href)
-               >>= orThrow MissedBlockError
-
-      let refs = extractBlockRefs (coerce href) blk
-
-      pure $ mkList @c (fmap (mkStr . show . pretty) refs)
-
-    _ -> throwIO (BadFormException @c nil)
-
-
-  brief "shallow scan of a block/tree" $
-    entry $ bindMatch "hbs2:tree:scan" $ \case
-      [HashLike href] -> do
-        sto <- getStorage
-
-        r <- S.toList_ $
-                deepScan ScanShallow (const none) (coerce href) (getBlock sto) $ \ha -> S.yield ha
-
-        -- let refs = extractBlockRefs (coerce href) blk
-        pure $ mkList @c (fmap (mkSym . show . pretty . HashRef) r)
-
-      _ -> throwIO (BadFormException @c nil)
-
-  brief "delete tree" $
-    entry $ bindMatch "hbs2:tree:delete" $ nil_ \case
-      [HashLike href] -> do
-        sto <- getStorage
-        deleteMerkleTree sto href
-
-      _ -> throwIO (BadFormException @c nil)
-
-
-  brief "shallow scan of a block/tree" $
-    entry $ bindMatch "hbs2:tree:scan:deep" $ \case
-      [HashLike href] -> do
-        sto <- getStorage
-
-        r <- S.toList_ $
-                deepScan ScanDeep (const none) (coerce href) (getBlock sto) $ \ha -> S.yield ha
-
-        -- let refs = extractBlockRefs (coerce href) blk
-        pure $ mkList @c (fmap (mkSym . show . pretty . HashRef) r)
-
-      _ -> throwIO (BadFormException @c nil)
-
-
-  brief "shallow scan of a block/tree" $
-    entry $ bindMatch "hbs2:tree:scan:deep:stdout" $ nil_ \case
-      [HashLike href] -> do
-        sto <- getStorage
-
-        deepScan ScanDeep (const none) (coerce href) (getBlock sto) $ \ha -> do
-          liftIO  $ print $ pretty ha
-
-      _ -> throwIO (BadFormException @c nil)
-
-
--- a/hbs2-cli/man/man1/hbs2-cli.1
+++ b/hbs2-cli/man/man1/hbs2-cli.1
@ -1 +0,0 @@
-hbs2-cli manual
--- a/hbs2-core/hbs2-core.cabal
+++ b/hbs2-core/hbs2-core.cabal
@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               hbs2-core
-version:            0.25.3.0
+version:            0.24.1.0
 -- synopsis:
 -- description:
 license:            BSD-3-Clause
@ -41,10 +41,8 @@ common shared-properties
                     , ConstraintKinds
                     , DataKinds
                     , DeriveDataTypeable
-                     , DeriveFoldable
                     , DeriveFunctor
                     , DeriveGeneric
-                     , DeriveTraversable
                     , DerivingStrategies
                     , DerivingVia
                     , ExtendedDefaultRules
@ -96,9 +94,8 @@ library
                    , HBS2.Polling
                    , HBS2.Hash
                    , HBS2.Merkle
-                    , HBS2.Merkle.MetaData
-                    , HBS2.Merkle.Walk
                    , HBS2.Net.Auth.Schema
+                    , HBS2.Net.Auth.GroupKeyAsymm
                    , HBS2.Net.Auth.GroupKeySymm
                    , HBS2.Net.Auth.Credentials
                    , HBS2.Net.Auth.Credentials.Sigil
@ -108,7 +105,6 @@ library
                    , HBS2.Net.Messaging.UDP
                    , HBS2.Net.Messaging.TCP
                    , HBS2.Net.Messaging.Unix
-                    , HBS2.Net.Messaging.Pipe
                    , HBS2.Net.Messaging.Stream
                    , HBS2.Net.Messaging.Encrypted.RandomPrefix
                    , HBS2.Net.Messaging.Encrypted.ByPass
@ -123,15 +119,17 @@ library
                    , HBS2.Prelude
                    , HBS2.Prelude.Plated
                    , HBS2.Storage
-                    , HBS2.Storage.AdHocStorage
                    , HBS2.Storage.Operations.Class
                    , HBS2.Storage.Operations.ByteString
                    , HBS2.Storage.Operations.Missed
-                    , HBS2.Storage.Operations.Delete
                    , HBS2.System.Logger.Simple
                    , HBS2.System.Logger.Simple.ANSI
                    , HBS2.System.Logger.Simple.Class
                    , HBS2.System.Dir
+                    , HBS2.Net.Dialog.Core
+                    , HBS2.Net.Dialog.Client
+                    , HBS2.Net.Dialog.Helpers.List
+                    , HBS2.Net.Dialog.Helpers.Streaming
                    , HBS2.Misc.PrettyStuff
                    , HBS2.Version

@ -174,7 +172,6 @@ library
                    , network-multicast
                    , network-simple
                    , network-byte-order
-                    , psqueues
                    , prettyprinter
                    , prettyprinter-ansi-terminal
                    , mwc-random
@ -183,7 +180,7 @@ library
                    , resourcet
                    , safe
                    , safe-exceptions
-                    , saltine >=0.2.0.1
+                    , saltine ^>=0.2.0.1
                    , serialise
                    , sockaddr
                    , split
@ -191,7 +188,6 @@ library
                    , stm-chans
                    , string-conversions
                    , streaming
-                    , streaming-bytestring
                    , string-conversions
                    , suckless-conf
                    , template-haskell
@ -200,7 +196,6 @@ library
                    , time
                    , transformers
                    , uniplate
-                    , unix
                    , unordered-containers
                    , unliftio
                    , unliftio-core
@ -221,6 +216,7 @@ test-suite test
                  -- , TestUniqProtoId
                  , FakeMessaging
                  , HasProtocol
+                  , DialogSpec
                  , TestScheduled
                  , TestDerivedKey

--- a/hbs2-core/lib/HBS2/Actors.hs
+++ b/hbs2-core/lib/HBS2/Actors.hs
@ -7,21 +7,18 @@ module HBS2.Actors
  ) where

 import HBS2.Prelude
+import HBS2.Clock

 import Control.Concurrent.STM
 import Control.Concurrent.STM.TBMQueue qualified as TBMQ
 import Control.Concurrent.STM.TBMQueue (TBMQueue)
 import Control.Concurrent.STM.TVar qualified as TVar
+import Control.Monad
+import Control.Concurrent.Async
+import Data.Function
+import Data.Functor
 import Data.Kind
 import Control.Concurrent
-import Control.Concurrent.Async
-import Control.Exception
-
-data PipelineExcepion =
-  PipelineAddJobTimeout
-  deriving stock (Show,Typeable)
-
-instance Exception PipelineExcepion

 data Pipeline m a =
  Pipeline
@ -54,15 +51,9 @@ stopPipeline pip = liftIO $ do
      pause ( 0.01 :: Timeout 'Seconds) >> next

 addJob :: forall a m m1 . (MonadIO m, MonadIO m1) => Pipeline m a -> m a -> m1 ()
-addJob pip' act' = liftIO $ do
-  doWrite <- atomically $ TVar.readTVar ( stopAdding pip' )
-  -- FIXME: exception-timeout-hardcode
-  race (pause @'Seconds 3) (doAddJob doWrite pip' act') >>= \case
-    Left{} -> throwIO PipelineAddJobTimeout
-    _ -> pure ()
-
-  where
-    doAddJob w pip act =
-      unless w $ do
+addJob pip act = liftIO $ do
+  doWrite <- atomically $ TVar.readTVar ( stopAdding pip )
+  unless doWrite $ do
    atomically $ TBMQ.writeTBMQueue (toQueue pip) act

+
--- a/hbs2-core/lib/HBS2/Actors/Peer.hs
+++ b/hbs2-core/lib/HBS2/Actors/Peer.hs
@ -17,6 +17,8 @@ import HBS2.Events
 import HBS2.Net.Auth.Credentials
 import HBS2.Net.Messaging
 import HBS2.Net.PeerLocator
+import HBS2.Net.PeerLocator.Static
+import HBS2.Net.Proto
 import HBS2.Net.Proto.Sessions
 import HBS2.Prelude.Plated
 import HBS2.Storage
@ -24,26 +26,23 @@ import HBS2.System.Logger.Simple

 import Data.Config.Suckless.KeyValue (HasConf(..))

-import Control.Monad
 import Control.Monad.Trans.Maybe
-import Control.Monad.Trans.Cont
+import Control.Concurrent.Async
 import Control.Monad.Reader
-import Control.Monad.Trans.Writer.CPS qualified as CPS
 import Data.ByteString.Lazy (ByteString)
 import Data.Cache (Cache)
 import Data.Cache qualified as Cache
 import Data.Dynamic
+import Data.Foldable hiding (find)
 import Data.Map qualified as Map
 import Data.Maybe
 import GHC.TypeLits
 import Lens.Micro.Platform as Lens
 import Data.HashMap.Strict (HashMap)
 import Data.HashMap.Strict qualified as HashMap
+import Control.Concurrent.STM.TVar
+import Control.Concurrent.STM
 import Control.Monad.IO.Unlift
-import Data.List qualified as L
-import Data.Monoid qualified as Monoid
-import UnliftIO
-import UnliftIO.Concurrent (getNumCapabilities)

 import Codec.Serialise (serialise, deserialiseOrFail)

@ -130,9 +129,6 @@ data PeerEnv e =
  , _envSweepers      :: TVar (HashMap SKey [PeerM e IO ()])
  , _envReqMsgLimit   :: Cache (Peer e, Integer, Encoded e) ()
  , _envReqProtoLimit :: Cache (Peer e, Integer) ()
-  , _envSentCounter   :: TVar Int
-  , _envRecvCounter   :: TVar Int
-  , _envProbe         :: TVar AnyProbe
  }

 newtype PeerM e m a = PeerM { fromPeerM :: ReaderT (PeerEnv e) m a }
@ -267,9 +263,8 @@ instance ( MonadIO m
         , Show (Peer e)
         ) => Request e msg m where
  request peer_e msg = do
-
    let proto = protoId @e @msg (Proxy @msg)
-    pip <- getFabriq @e
+    pipe <- getFabriq @e
    me <- ownPeer @e

    -- TODO: check if a request were sent to peer and timeout is here
@ -286,7 +281,7 @@ instance ( MonadIO m
      trace $ "REQUEST: not allowed to send for proto" <+> viaShow proto

    when allowed do
-      sendTo pip (To peer_e) (From me) (AnyMessage @(Encoded e) @e proto (encode msg))
+      sendTo pipe (To peer_e) (From me) (AnyMessage @(Encoded e) @e proto (encode msg))
      -- trace $ "REQUEST: after sendTo" <+> viaShow peer_e


@ -335,11 +330,6 @@ sweep = do

  liftIO $ atomically $ modifyTVar' sw (<> HashMap.fromList (mconcat alive))

-addJobIO :: IO () -> PeerM e IO ()
-addJobIO m = do
-  PeerEnv{..} <- ask
-  addJob _envDeferred m
-
 instance ( Typeable (EventKey e p)
         , Typeable (Event e p)
         , Hashable (EventKey e p)
@ -400,81 +390,32 @@ newPeerEnv pl s bus p = do
  _envSweepers      <- liftIO (newTVarIO mempty)
  _envReqMsgLimit   <- liftIO (Cache.newCache (Just defRequestLimit))
  _envReqProtoLimit <- liftIO (Cache.newCache (Just defRequestLimit))
-  _envSentCounter   <- liftIO (newTVarIO 0)
-  _envRecvCounter   <- liftIO (newTVarIO 0)
-  _envProbe         <- liftIO (newTVarIO (AnyProbe ()))
  pure PeerEnv {..}

-peerEnvSetProbe :: (MonadIO m) => PeerEnv e -> AnyProbe -> m ()
-peerEnvSetProbe PeerEnv {..} p = liftIO $ atomically $ writeTVar _envProbe p
-
-- peerEnvAddProbe :: (MonadIO m) => PeerEnv e -> AnyProbe -> m ()
-- peerEnvAddProbe PeerEnv {..} p = liftIO $ atomically $ modifyTVar _envProbe p
-
-
-peerEnvCollectProbes :: (MonadIO m) => PeerEnv e -> m ()
-peerEnvCollectProbes PeerEnv {..} = do
-  probe <- liftIO $ readTVarIO _envProbe
-  acceptReport probe =<< CPS.execWriterT do
-    -- _envDeferred :: Pipeline IO ()
-
-    item "sessions" =<< (liftIO . Cache.size) _envSessions
-
-    events <- liftReadTVar _envEvents
-    item "events-keys" $ HashMap.size events
-    item "events-values-all" $ calcValuesLengthTotal events
-
-    item "expire-times" =<< (liftIO . Cache.size) _envExpireTimes
-
-    sweepers <- liftReadTVar _envSweepers
-    item "sweepers-keys" $ HashMap.size sweepers
-    item "sweepers-values-all" $ calcValuesLengthTotal sweepers
-
-    item "req-msg-limit" =<< (liftIO . Cache.size) _envReqMsgLimit
-    item "req-proto-limit" =<< (liftIO . Cache.size) _envReqProtoLimit
-
-    item "data-sent" =<< (liftIO . readTVarIO) _envSentCounter
-    item "data-recv" =<< (liftIO . readTVarIO) _envRecvCounter
-
-  where
-    calcValuesLengthTotal = Monoid.getSum . foldMap (Monoid.Sum . L.length)
-    liftReadTVar = liftIO . readTVarIO
-    item k v = CPS.tell [(k, fromIntegral v)]
-
-runPeerM :: forall e m . ( MonadUnliftIO m
+runPeerM :: forall e m . ( MonadIO m
                         , HasPeer e
                         , Ord (Peer e)
                         , Pretty (Peer e)
-                         , Hashable (Encoded e)
                         , HasNonces () m
                         )
         => PeerEnv e
         -> PeerM e m ()
         -> m ()

-runPeerM env@PeerEnv{..} f  = flip runContT pure do
+runPeerM env f  = do

-  n <- liftIO getNumCapabilities <&> max 2 . div 2
-
-  as <- liftIO $ replicateM n $ asyncLinked $ runPipeline _envDeferred
+  let de = view envDeferred env
+  as <- liftIO $ replicateM 16 $ async $ runPipeline de

  sw <- liftIO $ async $ forever $ withPeerM env $ do
          pause defSweepTimeout
-
-      liftIO do
-        Cache.purgeExpired _envSessions
-        Cache.purgeExpired _envReqMsgLimit
-        Cache.purgeExpired _envReqProtoLimit
-
+          se <- asks (view envSessions)
+          liftIO $ Cache.purgeExpired se
          sweep

-  void $ ContT $ bracket none $ const $ do
-    void $ liftIO $ stopPipeline _envDeferred
+  void $ runReaderT (fromPeerM f) env
+  void $ liftIO $ stopPipeline de
  liftIO $ mapM_ cancel (as <> [sw])
-    pure ()
-
-  lift $ void $ runReaderT (fromPeerM f) env
-

 withPeerM :: MonadIO m => PeerEnv e -> PeerM e m a -> m a
 withPeerM env action = runReaderT (fromPeerM action) env
@ -490,7 +431,7 @@ runProto :: forall e m  . ( MonadIO m

 runProto hh = do
  me       <- ownPeer @e @m
-  pipf     <- getFabriq @e
+  pipe     <- getFabriq @e

  let resp = [ (pid, a) | a@AnyProtocol { myProtoId = pid } <- hh ]

@ -498,7 +439,7 @@ runProto hh = do

  forever $ do

-    messages <- receive @_ @e pipf (To me)
+    messages <- receive @_ @e pipe (To me)

    for_ messages $ \(From pip, AnyMessage n msg :: AnyMessage (Encoded e) e) -> do

@ -512,7 +453,6 @@ runProto hh = do
                          }) -> maybe (pure ()) (runResponseM pip . h) (decoder msg)


-
 instance (Monad m, HasProtocol e p) => HasThatPeer p e (ResponseM e m) where
  thatPeer = asks (view answTo)

@ -540,9 +480,7 @@ instance ( HasProtocol e p
    who <-  thatPeer @p
    self <- lift $ ownPeer @e
    fab  <- lift $ getFabriq @e
-    let raw = encode msg
-    -- atomically $ modifyTVar
-    sendTo fab (To who) (From self) (AnyMessage @(Encoded e) @e proto raw)
+    sendTo fab (To who) (From self) (AnyMessage @(Encoded e) @e proto (encode msg))

 instance ( MonadIO m
         -- , HasProtocol e p
--- a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs
+++ b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs
@ -2,10 +2,15 @@
 module HBS2.Actors.Peer.Types where

 import HBS2.Prelude
+import HBS2.Storage
 import HBS2.Net.Proto.Types
 import HBS2.Net.Messaging
+import HBS2.Hash

 import Control.Monad.Trans.Class
+import Data.ByteString.Lazy (ByteString)
+import Control.Monad
+import Codec.Serialise

 class HasProtocol e p => HasTimeLimits e p m where
  tryLockForPeriod :: Peer e -> p -> m Bool
@ -19,16 +24,7 @@ instance {-# OVERLAPPABLE #-}

 -- instance HasConf m => HasConf (ResponseM e m)

-data PeerCounters =
-  PeerStats
-  { peerDataSent :: Int
-  , peerDataRecv :: Int
-  }

-class HasPeerCounters m where
-  getPeerCounters   :: m PeerCounters
-  setPeerCounters   :: PeerCounters -> m ()
-  updatePeerCountes :: (PeerCounters -> PeerCounters) -> m ()

 class (Monad m, HasProtocol e p) => HasGossip e p m where
  gossip :: p -> m ()
--- a/hbs2-core/lib/HBS2/Base58.hs
+++ b/hbs2-core/lib/HBS2/Base58.hs
@ -4,8 +4,10 @@ import Data.ByteString.Base58 (encodeBase58, bitcoinAlphabet, decodeBase58,Alpha
 import Data.ByteString  qualified as BS
 import Data.ByteString.Char8 qualified as BS8
 import Data.ByteString.Char8 (ByteString)
+import Data.ByteString.Lazy.Char8 qualified as LBS8
 import Data.ByteString.Lazy qualified as LBS
 import Data.Word
+import Data.Char (ord)
 import Numeric

 import Prettyprinter
@ -39,9 +41,6 @@ instance Pretty (AsBase58 LBS.ByteString) where
 instance Show (AsBase58 ByteString) where
  show (AsBase58 bs) = BS8.unpack $ toBase58 bs

-instance Show (AsBase58 LBS.ByteString) where
-  show (AsBase58 bs) = BS8.unpack . toBase58 . LBS.toStrict $ bs
-

 byteToHex :: Word8 -> String
 byteToHex byte = pad $ showHex byte ""
--- a/hbs2-core/lib/HBS2/Clock.hs
+++ b/hbs2-core/lib/HBS2/Clock.hs
@ -1,9 +1,8 @@
 {-# LANGUAGE CPP #-}
-{-# OPTIONS_GHC -fno-warn-orphans #-}
 module HBS2.Clock
  ( module HBS2.Clock
  , module System.Clock
-  , POSIXTime, getPOSIXTime, NominalDiffTime
+  , POSIXTime, getPOSIXTime, getEpoch
  )where

 import Data.Functor
@ -15,6 +14,7 @@ import Data.Proxy
 import Data.Time
 import Prettyprinter
 import System.Clock
+import Data.Time.Clock
 import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
 import Data.Word

@ -50,7 +50,7 @@ instance IsTimeout t => Expired (Timeout t) TimeSpec where
 -- expired timeout ts = False

 toNominalDiffTime :: IsTimeout t => Timeout t -> NominalDiffTime
-toNominalDiffTime = fromRational . (/ (10^(6 :: Integer))) . fromIntegral . toMicroSeconds
+toNominalDiffTime = fromRational . (/ (10^6)) . fromIntegral . toMicroSeconds

 class IsTimeout a => MonadPause a m where
  pause :: Timeout a -> m ()
@ -97,7 +97,7 @@ instance IsTimeout 'Minutes where
  toNanoSeconds (TimeoutMin x) = round (x * 60 * 1e9)

 instance IsTimeout 'NomDiffTime where
-  toNanoSeconds (TimeoutNDT t) = round (realToFrac (nominalDiffTimeToSeconds t) * (1e9 :: Double))
+  toNanoSeconds (TimeoutNDT t) = round (realToFrac (nominalDiffTimeToSeconds t) * 1e9)

 instance IsTimeout 'TS where
  toNanoSeconds (TimeoutTS s) = fromIntegral $ toNanoSecs s
@ -108,9 +108,6 @@ class Expires a where
  -- FIXME: dangerous!
  expiresIn _ = Nothing

-timeSpecDeltaSeconds :: RealFrac a => TimeSpec -> TimeSpec -> a
-timeSpecDeltaSeconds a b = realToFrac . (*1e-9) . realToFrac $ toNanoSecs (max a b - min a b)
-
 getEpoch :: MonadIO m => m Word64
 getEpoch = liftIO getPOSIXTime <&> floor

--- a/hbs2-core/lib/HBS2/Data/Bundle.hs
+++ b/hbs2-core/lib/HBS2/Data/Bundle.hs
@ -26,8 +26,8 @@ import Streaming()

 {- HLINT ignore "Use newtype instead of data" -}

-data BundleRefValue s =
-  BundleRefValue (SignedBox BundleRef s)
+data BundleRefValue e =
+  BundleRefValue (SignedBox BundleRef e)
  deriving stock (Generic)

 instance ForSignedBox e => Serialise (BundleRefValue e)
@ -39,13 +39,13 @@ data BundleRef =
 instance Serialise BundleRef


-makeBundleRefValue :: forall s . (ForSignedBox s, Signatures s)
-                   => PubKey 'Sign s
-                   -> PrivKey 'Sign s
+makeBundleRefValue :: forall e . (ForSignedBox e, Signatures (Encryption e))
+                   => PubKey 'Sign (Encryption e)
+                   -> PrivKey 'Sign (Encryption e)
                   -> BundleRef
-                   -> BundleRefValue s
+                   -> BundleRefValue e

-makeBundleRefValue pk sk ref = BundleRefValue $ makeSignedBox @s pk sk ref
+makeBundleRefValue pk sk ref = BundleRefValue $ makeSignedBox @e pk sk ref

 -- у нас может быть много способов хранить данные:
 --   сжимать целиком (эффективно, но медленно)
@ -178,7 +178,7 @@ instance MonadIO m => ImportBundle HashRef m where
      go hd bs
        | LBS.null bs = pure $ Right ()
        | otherwise = do
-            let _ss = bundleHeadSectionSize hd
+            let ss = bundleHeadSectionSize hd
            let (bsh, allBsRest) = LBS.splitAt sectionHeadSize bs
            case deserialiseOrFail @BundleSection bsh of
              Left{} -> do
--- a/hbs2-core/lib/HBS2/Data/Detect.hs
+++ b/hbs2-core/lib/HBS2/Data/Detect.hs
@ -1,38 +1,30 @@
-module HBS2.Data.Detect
-  ( module HBS2.Data.Detect
-  , module HBS2.Merkle.Walk
-  , module HBS2.Merkle
-  )
-  where
+module HBS2.Data.Detect where

 import HBS2.Prelude.Plated
 import HBS2.Hash
 import HBS2.Data.Types
 import HBS2.Merkle
-import HBS2.Merkle.Walk
 import HBS2.Storage

-- import HBS2.System.Logger.Simple
+import HBS2.System.Logger.Simple

-- import Data.Foldable (for_)
+import Data.Foldable (for_)
 import Control.Monad.Trans.Maybe
 import Codec.Serialise (deserialiseOrFail)
 import Data.ByteString.Lazy (ByteString)
 import Data.ByteString.Lazy qualified as LBS
 import Data.Either
-- import Data.Function
-- import Data.Functor
+import Data.Function
+import Data.Functor

-import Data.Coerce
 import Data.Maybe
 import Control.Concurrent.STM
 import Data.HashMap.Strict qualified as HashMap
-- import Data.HashMap.Strict (HashMap)
+import Data.HashMap.Strict (HashMap)
 import Data.List qualified as List
-import UnliftIO qualified

 import Streaming.Prelude qualified as S
-- import Streaming qualified as S
+import Streaming qualified as S

 data BlobType =  Merkle (MTree [HashRef])
               | MerkleAnn (MTreeAnn [HashRef])
@ -54,38 +46,6 @@ tryDetect hash obj = rights [mbAnn, mbLink, mbMerkle, mbSeq] & headDef orBlob

 data ScanLevel = ScanShallow | ScanDeep

-extractBlockRefs :: Hash HbSync -> ByteString -> [HashRef]
-extractBlockRefs hx bs =
-  case tryDetect hx bs of
-   (SeqRef (SequentialRef _ (AnnotatedHashRef a' b))) ->
-    coerce <$> catMaybes [a', Just b]
-
-   AnnRef (AnnotatedHashRef ann h) -> do
-    coerce <$> catMaybes [ann, Just h]
-
-   Merkle (MNode _ hs) -> fmap HashRef hs
-
-   MerkleAnn (MTreeAnn{..}) -> do
-
-     let meta = case _mtaMeta of
-                  AnnHashRef ha -> [ha]
-                  _ -> mempty
-
-     let c = case _mtaCrypt of
-               CryptAccessKeyNaClAsymm hs -> [hs]
-               EncryptGroupNaClSymm1 hs _ -> [hs]
-               EncryptGroupNaClSymm2 _ hs _ -> [hs]
-               _ -> mempty
-
-     let t = case _mtaTree of
-               MNode _ hs -> hs
-               _ -> mempty
-
-     fmap HashRef (meta <> c <> t)
-
-   _ -> mempty
-
-

 -- TODO: control-nesting-level-to-avoid-abuse

@ -199,15 +159,6 @@ readLog getBlk (HashRef h)  =
        Left{} -> pure ()
        Right (hrr :: [HashRef]) -> S.each hrr

-readLogThrow :: forall m . ( MonadIO m )
-        => ( Hash HbSync -> IO (Maybe ByteString) )
-        -> HashRef
-        -> m [HashRef]
-readLogThrow getBlk (HashRef h)  =
-  S.toList_ do
-      either UnliftIO.throwIO pure =<<
-          streamMerkle (liftIO . getBlk) h
-

 -- FIXME: make-it-stop-after-first-missed-block
 checkComplete :: forall sto m . (MonadIO m, Storage sto HbSync ByteString IO)
--- a/hbs2-core/lib/HBS2/Data/KeyRing.hs
+++ b/hbs2-core/lib/HBS2/Data/KeyRing.hs
@ -9,6 +9,7 @@ import System.FilePath
 import System.Directory
 import Data.List as L
 import Data.Maybe
+import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString qualified as BS
 import Lens.Micro.Platform
 import UnliftIO
@ -22,7 +23,7 @@ splitPattern fp = (pref, flt)
    pref = joinPath pref'
    flt = case flt' of
      [] -> "*"
-      _xs -> joinPath flt'
+      xs -> joinPath flt'
    (pref', flt') = L.span isNotP (splitDirectories fp)
    isNotP s = isNothing (find isP s)
    isP c = c `elem` ("?*" :: [Char])
--- a/hbs2-core/lib/HBS2/Data/Types.hs
+++ b/hbs2-core/lib/HBS2/Data/Types.hs
@ -2,6 +2,7 @@ module HBS2.Data.Types
  ( module X
  -- , module HBS2.Data.Types.Crypto
  , AsSyntax(..)
+  , LoadedRef(..)
  )
  where

--- a/hbs2-core/lib/HBS2/Data/Types/EncryptedBox.hs
+++ b/hbs2-core/lib/HBS2/Data/Types/EncryptedBox.hs
@ -8,7 +8,7 @@ import Data.ByteString (ByteString)
 -- TODO: encryption-type-into-tags
 -- FIXME: show-scrambled?
 newtype EncryptedBox t = EncryptedBox { unEncryptedBox :: ByteString }
-  deriving stock (Eq,Generic,Show,Data)
+  deriving stock (Generic,Show,Data)

 instance Serialise (EncryptedBox t)

--- a/hbs2-core/lib/HBS2/Data/Types/Peer.hs
+++ b/hbs2-core/lib/HBS2/Data/Types/Peer.hs
@ -1,12 +1,14 @@
 {-# Language UndecidableInstances #-}
 module HBS2.Data.Types.Peer where

+import Codec.Serialise
 import Data.ByteString qualified as BS
 import Data.Hashable
 import Lens.Micro.Platform

 import HBS2.Prelude
 import HBS2.Net.Auth.Credentials
+import HBS2.Net.Proto.Types


 type PingSign e = Signature (Encryption e)
--- a/hbs2-core/lib/HBS2/Data/Types/Refs.hs
+++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs
@ -1,10 +1,8 @@
 {-# Language DuplicateRecordFields #-}
 {-# Language UndecidableInstances #-}
-{-# Language PatternSynonyms #-}
 module HBS2.Data.Types.Refs
  ( module HBS2.Data.Types.Refs
  , serialise
-  -- , pattern HashLike
  ) where

 import HBS2.Base58
@ -12,27 +10,16 @@ import HBS2.Hash
 import HBS2.Net.Proto.Types
 import HBS2.Prelude

-import Data.Config.Suckless.Syntax
-
 import Codec.Serialise(serialise)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Data
-import Data.Maybe
-import Data.Text qualified as Text

 class RefMetaData a where
  refMetaData :: a -> [(String, String)]
  refMetaData = const mempty

 newtype HashRef = HashRef { fromHashRef :: Hash HbSync }
-                  deriving newtype (Eq,Ord,IsString,Pretty,Hashable,Hashed HbSync)
-                  deriving stock (Data,Generic)
-
-instance Show HashRef where
-  show (HashRef h) = show . pretty $  h
-
-newtype TaggedHashRef t = TaggedHashRef { fromTaggedHashRef :: HashRef }
                  deriving newtype (Eq,Ord,IsString,Pretty,Hashable,Hashed HbSync)
                  deriving stock (Data,Generic,Show)

@ -51,9 +38,6 @@ newtype TheHashRef t = TheHashRef { fromTheHashRef :: Hash HbSync }
 instance Pretty (AsBase58 (TheHashRef t)) where
  pretty (AsBase58 x) = pretty x

-instance Pretty (AsBase58 (TaggedHashRef t)) where
-  pretty (AsBase58 x) = pretty x
-
 instance FromStringMaybe (TheHashRef t) where
  fromStringMay = fmap TheHashRef . fromStringMay

@ -81,13 +65,11 @@ data SequentialRef =
 instance Serialise AnnotatedHashRef
 instance Serialise SequentialRef
 instance Serialise HashRef
-instance Serialise (TaggedHashRef e)


 type IsRefPubKey s =  ( Eq (PubKey 'Sign s)
                      , Serialise (PubKey 'Sign s)
                      , FromStringMaybe (PubKey 'Sign s)
-                      , Serialise (PubKey 'Sign s)
                      , Hashable (PubKey 'Sign s)
                      , Pretty (AsBase58 (PubKey 'Sign s))
                      )
@ -95,7 +77,6 @@ type IsRefPubKey s =  ( Eq (PubKey 'Sign s)
 type ForSomeRefKey a = ( Hashed HbSync a )

 newtype SomeRefKey a = SomeRefKey a
-                       deriving newtype (Eq,Hashable)

 instance RefMetaData (SomeRefKey a)

@ -137,25 +118,3 @@ instance RefMetaData RefAlias2 where

 type LoadedRef a = Either HashRef a

-
-- TODO: move-outta-here
-pattern HashLike:: forall {c} . HashRef -> Syntax c
-pattern HashLike x <- (
-  \case
-    LitStrVal s      -> fromStringMay @HashRef (Text.unpack s)
-    SymbolVal (Id s) -> fromStringMay @HashRef (Text.unpack s)
-    _                -> Nothing
-      -> Just x )
-
-pattern HashLikeList :: forall {c} . [HashRef] -> [Syntax c]
-pattern HashLikeList e <- (hashLikeList -> e)
-
-hashLikeList :: [Syntax c] -> [HashRef]
-hashLikeList syn = [ hashLike s | s <- syn ] & takeWhile isJust & catMaybes
-
-hashLike :: Syntax c -> Maybe HashRef
-hashLike = \case
-  HashLike x -> Just x
-  _          -> Nothing
-
-
--- a/Show More
+++ b/Show More