mirror of https://github.com/voidlizard/hbs2
wip
This commit is contained in:
parent
0786150ef4
commit
da131c0110
1
Makefile
1
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
|
||||
|
|
11
flake.nix
11
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" { };
|
||||
|
|
|
@ -0,0 +1,7 @@
|
|||
#! /usr/bin/env -S bf6 file
|
||||
|
||||
(run:proc:attached hbs2-git3 (cdr *args))
|
||||
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
||||
|]
|
||||
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue