From da131c01107593253906c09c3be07ebe053ac8f5 Mon Sep 17 00:00:00 2001 From: voidlizard Date: Wed, 19 Feb 2025 15:38:21 +0300 Subject: [PATCH] wip --- Makefile | 1 + flake.nix | 11 ++++ hbs2-git3/bf6/git-hbs2 | 7 +++ hbs2-git3/hbs2-git3.cabal | 1 + hbs2-git3/lib/HBS2/Git3/Man.hs | 49 +++++++++++++++++ hbs2-git3/lib/HBS2/Git3/Run.hs | 52 +++---------------- miscellaneous/suckless-conf/bf6/Main.hs | 15 ++++++ .../Data/Config/Suckless/Script/Internal.hs | 13 +++-- .../suckless-conf/suckless-conf.cabal | 2 +- 9 files changed, 102 insertions(+), 49 deletions(-) create mode 100755 hbs2-git3/bf6/git-hbs2 create mode 100644 hbs2-git3/lib/HBS2/Git3/Man.hs diff --git a/Makefile b/Makefile index 63d08110..776e8499 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/flake.nix b/flake.nix index f54d482e..81ee54ea 100644 --- a/flake.nix +++ b/flake.nix @@ -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" { }; diff --git a/hbs2-git3/bf6/git-hbs2 b/hbs2-git3/bf6/git-hbs2 new file mode 100755 index 00000000..0821268d --- /dev/null +++ b/hbs2-git3/bf6/git-hbs2 @@ -0,0 +1,7 @@ +#! /usr/bin/env -S bf6 file + +(run:proc:attached hbs2-git3 (cdr *args)) + + + + diff --git a/hbs2-git3/hbs2-git3.cabal b/hbs2-git3/hbs2-git3.cabal index 49ae5848..48f7cfbb 100644 --- a/hbs2-git3/hbs2-git3.cabal +++ b/hbs2-git3/hbs2-git3.cabal @@ -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 diff --git a/hbs2-git3/lib/HBS2/Git3/Man.hs b/hbs2-git3/lib/HBS2/Git3/Man.hs new file mode 100644 index 00000000..63a5d698 --- /dev/null +++ b/hbs2-git3/lib/HBS2/Git3/Man.hs @@ -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 +updateRepoKey 7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx + +git remote + +laundry-worry +^^^^^^^^^^^^^ + +This is the git remote for the new repo. Rename it if you want. + +hbs2-git3 repo:remotes +7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx laundry-worry + + + |] + diff --git a/hbs2-git3/lib/HBS2/Git3/Run.hs b/hbs2-git3/lib/HBS2/Git3/Run.hs index 1225ff87..374fed22 100644 --- a/hbs2-git3/lib/HBS2/Git3/Run.hs +++ b/hbs2-git3/lib/HBS2/Git3/Run.hs @@ -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 -updateRepoKey 7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx - -git remote - -laundry-worry -^^^^^^^^^^^^^ - -This is the git remote for the new repo. Rename it if you want. - -hbs2-git3 repo:remotes -7F1D7QGVVwJFJ649dsSHgrDUuqHYti3nkFx 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 diff --git a/miscellaneous/suckless-conf/bf6/Main.hs b/miscellaneous/suckless-conf/bf6/Main.hs index 27aef5fb..bf108a3c 100644 --- a/miscellaneous/suckless-conf/bf6/Main.hs +++ b/miscellaneous/suckless-conf/bf6/Main.hs @@ -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 diff --git a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs index 004d3991..d30fb76c 100644 --- a/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs +++ b/miscellaneous/suckless-conf/lib/Data/Config/Suckless/Script/Internal.hs @@ -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 diff --git a/miscellaneous/suckless-conf/suckless-conf.cabal b/miscellaneous/suckless-conf/suckless-conf.cabal index 8bce4b98..0b9e998a 100644 --- a/miscellaneous/suckless-conf/suckless-conf.cabal +++ b/miscellaneous/suckless-conf/suckless-conf.cabal @@ -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