This commit is contained in:
voidlizard 2025-02-19 15:38:21 +03:00
parent 0786150ef4
commit da131c0110
9 changed files with 102 additions and 49 deletions

View File

@ -67,6 +67,7 @@ symlinks: $(BIN_DIR)
> echo "Binary $$bin for GHC $(GHC_VERSION) not found"; \
> fi; \
> done
> ln -sfn ../hbs2-git3/bf6/git-hbs2 bin/git-hbs2
.PHONY: build

View File

@ -38,6 +38,7 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
"hbs2-cli"
"hbs2-sync"
"fixme-new"
"suckless-conf"
];
miscellaneous =
@ -51,6 +52,16 @@ outputs = { self, nixpkgs, flake-utils, ... }@inputs:
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" { };

7
hbs2-git3/bf6/git-hbs2 Executable file
View File

@ -0,0 +1,7 @@
#! /usr/bin/env -S bf6 file
(run:proc:attached hbs2-git3 (cdr *args))

View File

@ -130,6 +130,7 @@ library
HBS2.Git3.Repo.Types
HBS2.Git3.Repo
HBS2.Git3.Run
HBS2.Git3.Man
HBS2.Git3.Logger
HBS2.Git3.State
HBS2.Git3.State.Internal.Types

View File

@ -0,0 +1,49 @@
module HBS2.Git3.Man where
import HBS2.Git3.Prelude
import Data.Config.Suckless.Script
import Text.InterpolatedString.Perl6 (qc)
manInit :: MakeDictM c m () -> MakeDictM c m ()
manInit = brief "initializes a new repository"
. args [ arg "new repository flag" "--new"
, arg "group key hash for encrypted repository" "<--encrypted group-key>"
]
. examples initExamples
where
initExamples = [qc|
; just init a new repository
hbs2-git init --new
; init encrypted repository
; create new group key:
; your real keys will be different
; all hashes/keys appear in exampels/logs a PUBLIC information,
; so no secrets disclosures.
hbs2-cli hbs2:groupkey:store [hbs2:groupkey:create 67CRxnoQWasQsY9iidjJDYXSTKEZkpSVgDQYweWuhfd3]
39baH7SqqsAGgCSr3k9RJgY4nTwiMRXrgZUmKPFndzn8
hbs2-git init --new --encrypted 39baH7SqqsAGgCSr3k9RJgY4nTwiMRXrgZUmKPFndzn8
added git remote laundry-worry hbs23://7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx<censored>
updateRepoKey 7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx<censored>
git remote
laundry-worry
^^^^^^^^^^^^^
This is the git remote for the new repo. Rename it if you want.
hbs2-git3 repo:remotes
7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx<censored> laundry-worry
|]

View File

@ -14,6 +14,7 @@ import HBS2.Git3.State
import HBS2.Git3.Repo qualified as Repo
import HBS2.Git3.Repo
import HBS2.Git3.Logger
import HBS2.Git3.Man
import HBS2.Net.Auth.GroupKeySymm
import Data.Config.Suckless.Script
@ -72,6 +73,8 @@ theDict = do
_ -> helpList True Nothing >> quit
entry $ bindAlias "help" "--help"
hidden do
entry $ bindMatch "--help-all" $ nil_ $ \case
[ StringLike x ] -> helpList False (Just x) >> quit
@ -135,8 +138,9 @@ compression ; prints compression level
co <- LBS.hGetContents stdin
print $ pretty $ gitHashBlobPure co
entry $ bindMatch "zlib:deflate" $ nil_ $ const $ liftIO do
LBS.hGetContents stdin <&> Zlib.decompress >>= LBS.hPutStr stdout
hidden do
entry $ bindMatch "zlib:deflate" $ nil_ $ const $ liftIO do
LBS.hGetContents stdin <&> Zlib.decompress >>= LBS.hPutStr stdout
entry $ bindMatch "test:git:read-commit-chain" $ nil_ $ \syn -> lift do
(mpath, hss) <- case syn of
@ -560,51 +564,11 @@ compression ; prints compression level
liftIO $ for_ keys $ \k -> do
liftIO $ print $ pretty k
let initExamples = [qc|
; just init a new repository
hbs2-git init --new
; init encrypted repository
; create new group key:
; your real keys will be different
; all hashes/keys appear in exampels/logs a PUBLIC information,
; so no secrets disclosures.
hbs2-cli hbs2:groupkey:store [hbs2:groupkey:create 67CRxnoQWasQsY9iidjJDYXSTKEZkpSVgDQYweWuhfd3]
39baH7SqqsAGgCSr3k9RJgY4nTwiMRXrgZUmKPFndzn8
hbs2-git init --new --encrypted 39baH7SqqsAGgCSr3k9RJgY4nTwiMRXrgZUmKPFndzn8
added git remote laundry-worry hbs23://7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx<censored>
updateRepoKey 7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx<censored>
git remote
laundry-worry
^^^^^^^^^^^^^
This is the git remote for the new repo. Rename it if you want.
hbs2-git3 repo:remotes
7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx<censored> laundry-worry
|]
let initMan = brief "initializes a new repository"
. args [ arg "new repository flag" "--new"
, arg "group key hash for encrypted repository" "<--encrypted group-key>"
]
. examples initExamples
initMan $
manInit $
entry $ bindMatch "repo:init" $ nil_ $ \syn -> lift $ connectedDo do
Repo.initRepo syn
initMan $ entry $
manInit $ entry $
bindAlias "init" "repo:init"
entry $ bindMatch "repo:relay-only" $ nil_ $ \case

View File

@ -5,6 +5,7 @@ module Main where
import Data.Config.Suckless.Script
import Data.Config.Suckless.Script.File as SF
import Safe
import System.Environment
import System.IO qualified as IO
import UnliftIO
@ -29,9 +30,15 @@ main = do
entry $ bindMatch "debug:cli:show" $ nil_ \case
_ -> display cli
hidden do
entry $ bindMatch "#!" $ nil_ $ const do
pure ()
case cli of
[ListVal (SymbolVal "#!" :_)] -> do
pure ()
[ListVal [SymbolVal "--run", StringLike fn]] -> do
what <- liftIO $ readFile fn
>>= either (error.show) pure . parseTop
@ -44,6 +51,14 @@ main = do
run dict what >>= eatNil display
[ListVal (SymbolVal "file" : s@(StringLike fn : args))] -> do
what <- liftIO (IO.readFile fn)
>>= either (error.show) pure . parseTop
runM dict do
bindCliArgs s
void $ evalTop what
[] -> do
eof <- liftIO IO.isEOF
if eof then

View File

@ -955,6 +955,14 @@ instance IsContext c => MkSyntax c IniConfig where
mkList (globals <> sections)
bindCliArgs :: forall c m . (IsContext c, MonadUnliftIO m, Exception (BadFormException c))
=> [Syntax c] -> RunM c m ()
bindCliArgs a = do
bind "$*" (mkList a)
bind "*args" (mkList a)
forM_ (zip [0..] a) $ \(i,e) -> do
bind (fromString ("$"<>show i)) e
internalEntries :: forall c m . ( IsContext c
, Exception (BadFormException c)
, MonadUnliftIO m) => MakeDictM c m ()
@ -1527,10 +1535,7 @@ internalEntries = do
-- skips shebang
entry $ bindMatch "top:file:run" $ nil_ $ \case
a@(StringLike fn : args) -> do
bind "$*" (mkList a)
bind "*args" (mkList a)
forM_ (zip [0..] a) $ \(i,e) -> do
bind (fromString ("$"<>show i)) e
bindCliArgs a
liftIO (TIO.readFile fn)
<&> either (error.show) (fmap (fixContext @C @c) . dropShebang ) . parseTop

View File

@ -119,7 +119,7 @@ executable bf6
-- other-modules:
-- other-extensions:
build-depends:
base, unliftio, suckless-conf
base, unliftio, suckless-conf, safe
hs-source-dirs: bf6
default-language: GHC2021