PR CGPnKdSirc hbs2-suckless-conf-update

.fixme/log

@@ -0,0 +1,2 @@
+
+(fixme-set "workflow" "test" "CGPnKdSirc")

flake.lock

@@ -295,11 +295,11 @@
         ]
       },
       "locked": {
-        "lastModified": 1679815688,
+        "lastModified": 1689215736,
-        "narHash": "sha256-xLvIoeG5krM0CXfWRcwSgHGP7W8i8dsoKP5hUb182hE=",
+        "narHash": "sha256-cd/iK5ttyls62RI5JYYANf2O8rV6Ubu1a/4VXDrQCBc=",
         "owner": "voidlizard",
         "repo": "suckless-conf",
-        "rev": "04c432681d3627f180a402674523736f409f964d",
+        "rev": "0ee3ef62e833df65da99af3feba9feaa7ef4d12b",
         "type": "github"
       },
       "original": {

hbs2-core/hbs2-core.cabal

@@ -87,7 +87,6 @@ library
                     , HBS2.Net.PeerLocator
                     , HBS2.Net.PeerLocator.Static
                     , HBS2.Net.Proto
-                    , HBS2.Net.Proto.ACB
                     , HBS2.Net.Proto.BlockAnnounce
                     , HBS2.Net.Proto.BlockChunks
                     , HBS2.Net.Proto.BlockInfo

hbs2-core/lib/HBS2/Net/Proto/ACB.hs

@@ -1,135 +0,0 @@
-{-# Language TemplateHaskell #-}
-{-# Language PatternSynonyms #-}
-{-# Language UndecidableInstances #-}
-module HBS2.Net.Proto.ACB where
-
-import HBS2.Prelude.Plated
-import HBS2.Net.Auth.Credentials
-import HBS2.Base58
-import HBS2.Data.Types
-
-import Data.Config.Suckless
-
-import Control.Applicative
-import Lens.Micro.Platform
-import Codec.Serialise()
-import Data.List qualified as L
-import Data.Text qualified as Text
-import Data.Maybe
-import Data.Either
-
-data family ACB s
-
-data DefineACB s  = DefineACB Text (ACB s)
-
-type ACBSimple s = ACB s
-
-data instance ACB s =
-  ACB1
-  { _acbRoot     :: !(Maybe (PubKey  'Sign s)) -- it's monoid. no choice but Maybe
-  , _acbOwners   :: ![PubKey 'Sign s]
-  , _acbReaders  :: ![PubKey 'Encrypt s]
-  , _acbWriters  :: ![PubKey 'Sign s]
-  , _acbPrev     :: !(Maybe HashRef)
-  }
-  deriving stock (Generic)
-
-
-makeLenses 'ACB1
-
-type ForACB e = ( Serialise (PubKey 'Sign e)
-                , Serialise (PubKey 'Encrypt e)
-                , Eq (PubKey 'Sign e)
-                , Eq (PubKey 'Encrypt e)
-                , FromStringMaybe (PubKey 'Sign e)
-                , FromStringMaybe (PubKey 'Encrypt e)
-                )
-
-deriving instance ForACB e => Eq (ACBSimple e)
-
-instance ForACB e => Serialise (ACBSimple e)
-
-instance ForACB e => Monoid (ACBSimple e) where
-  mempty = ACB1 Nothing mempty mempty mempty Nothing
-
-instance ForACB e => Semigroup (ACBSimple e) where
-  (<>) a b = ACB1 (view acbRoot a <|> view acbRoot b)
-                  (L.nub (view acbOwners a <> view acbOwners b))
-                  (L.nub (view acbReaders a <> view acbReaders b))
-                  (L.nub (view acbWriters a <> view acbWriters b))
-                  (view acbPrev a <|> view acbPrev b)
-
-
-instance ( Pretty (AsBase58 (PubKey 'Sign s))
-         , Pretty (AsBase58 (PubKey 'Encrypt s) )
-         ) => Pretty (AsSyntax (DefineACB s)) where
-  pretty (AsSyntax (DefineACB nacb' acb)) = vcat [
-         "define-acb"  <+> nacb
-      ,  prev
-      ,  root
-      ,  owners
-      ,  readers
-      ,  writers
-      ,  line
-    ]
-
-    where
-
-      nacb = pretty nacb'
-
-      wacb = (<+> nacb)
-
-      prev = maybe mempty (dquotes . pretty . AsBase58) (view acbPrev acb)
-
-      root    = maybe mempty ( (acbR <+>) . dquotes . pretty . AsBase58 ) (view acbRoot acb)
-      owners  = vcat $ fmap owner (view acbOwners acb)
-      acbR    = "acb-root" <+> nacb
-      readers = vcat $ fmap reader (view acbReaders acb)
-      writers = vcat $ fmap writer (view acbWriters acb)
-
-      owner  = (wacb "acb-owner"  <+>)  . dquotes . pretty . AsBase58
-      reader = (wacb "acb-reader"  <+>) . dquotes . pretty . AsBase58
-      writer = (wacb "acb-writer"  <+>) . dquotes . pretty . AsBase58
-
-
-pattern Key :: forall {c}. Id -> [Syntax c] -> [Syntax c]
-pattern Key n ns <- SymbolVal  n : ns
-
-instance ForACB s => FromStringMaybe (ACB s) where
-  fromStringMay s = Just $ ACB1 root owners readers writers prev
-
-    where
-      parsed = parseTop s & fromRight mempty
-      defAcb = headMay [ acb | (ListVal (Key "define-acb" [SymbolVal acb]) ) <- parsed ]
-
-      root = lastMay $ catMaybes $
-                     [ fromStringMay (Text.unpack e)
-                     | (ListVal (Key "acb-root" [SymbolVal a, LitStrVal e]) ) <- parsed
-                     , Just a == defAcb
-                     ]
-
-      owners = L.nub $ catMaybes
-                     [ fromStringMay (Text.unpack e)
-                     | (ListVal (Key "acb-owner" [SymbolVal a, LitStrVal e]) ) <- parsed
-                     , Just a == defAcb
-                     ]
-
-      readers = L.nub $ catMaybes
-                     [ fromStringMay (Text.unpack e)
-                     | (ListVal (Key "acb-reader" [SymbolVal a, LitStrVal e]) ) <- parsed
-                     , Just a == defAcb
-                     ]
-
-      writers = L.nub $ catMaybes
-                     [ fromStringMay (Text.unpack e)
-                     | (ListVal (Key "acb-writer" [SymbolVal a, LitStrVal e]) ) <- parsed
-                     , Just a == defAcb
-                     ]
-
-      prev =lastMay $ catMaybes $
-                     [ fromStringMay (Text.unpack e)
-                     | (ListVal (Key "acb-prev" [SymbolVal a, LitStrVal e]) ) <- parsed
-                     , Just a == defAcb
-                     ]
-
-

hbs2-git/lib/HBS2Git/Types.hs

@@ -62,8 +62,6 @@ makeLenses 'DBEnv
 
 type RepoRef = RefLogKey Schema
 
-type C = MegaParsec
-
 data ConfBranch
 data HeadBranch
 data KeyRingFile
@@ -140,9 +138,6 @@ instance FromStringMaybe RepoHead where
       decodePair other  = Left other
 
 
-pattern Key :: forall {c}. Id -> [Syntax c] -> [Syntax c]
-pattern Key n ns <- SymbolVal  n : ns
-
 class HasProgress m where
   type family ProgressMonitor m :: Type
   newProgressMonitor :: String -> Int -> m (ProgressMonitor  m)
@@ -187,16 +182,6 @@ instance (HasCatAPI m, MonadIO m) => HasCatAPI (ResourceT m) where
 --   getHttpPutAPI = lift getHttpPutAPI
 --   getHttpRefLogGetAPI = lift getHttpRefLogGetAPI
 
-class Monad m => HasCfgKey a b m where
-  -- type family CfgValue a :: Type
-  key :: Id
-
-class (Monad m, HasCfgKey a b m) => HasCfgValue a b m where
-  cfgValue :: m b
-
-class Monad m => HasConf m where
-  getConf :: m [Syntax C]
-
 newtype App m a =
   App { fromApp :: ReaderT AppEnv m a }
   deriving newtype ( Applicative
@@ -214,20 +199,6 @@ newtype App m a =
 instance MonadIO m => HasConf (App m) where
   getConf = asks (view appConf)
 
-instance {-# OVERLAPPABLE #-} (HasConf m, Ord b, IsString b, HasCfgKey a (Maybe b) m) => HasCfgValue a (Maybe b) m where
-  cfgValue = lastMay . val <$> getConf
-    where
-      val syn = [ fromString (show $ pretty e)
-                | ListVal @C (Key s [LitStrVal e]) <- syn, s == key @a @(Maybe b) @m
-                ]
-
-instance {-# OVERLAPPABLE #-} (HasConf m, Ord b, IsString b, HasCfgKey a (Set b) m) => HasCfgValue a (Set b) m where
-  cfgValue  = Set.fromList . val <$> getConf
-    where
-      val syn = [ fromString (show $ pretty e)
-                | ListVal @C (Key s [LitStrVal e]) <- syn, s == key @a @(Set b) @m
-                ]
-
 hPrint :: (Show a, MonadIO m) => Handle -> a -> m ()
 hPrint h s = liftIO $ IO.hPrint h s
 

hbs2-peer/app/PeerConfig.hs

@@ -3,14 +3,16 @@
 {-# Language PatternSynonyms #-}
 module PeerConfig
   ( module PeerConfig
-  , module Data.Config.Suckless
+  , module Data.Config.Suckless.Syntax
+  , module Data.Config.Suckless.Parse
   ) where
 
 import HBS2.Prelude.Plated
 import HBS2.System.Logger.Simple
 import HBS2.Base58
 
-import Data.Config.Suckless
+import Data.Config.Suckless.Syntax
+import Data.Config.Suckless.Parse
 
 import Control.Exception
 import Data.Either

hbs2-tests/hbs2-tests.cabal

@@ -358,54 +358,6 @@ executable test-saltine
         , fast-logger
 
 
-test-suite test-acb
-    import:           shared-properties
-    import:           common-deps
-    default-language: Haskell2010
-
-    ghc-options:
-      -- -prof
-      -- -fprof-auto
-
-    other-modules:
-
-    -- other-extensions:
-
-    type:             exitcode-stdio-1.0
-    hs-source-dirs:   test
-    main-is:          TestACB.hs
-
-    build-depends:
-          base, hbs2-core
-        -- , async
-        -- , attoparsec
-        -- , bytestring
-        -- , cache
-        -- , clock
-        , containers
-        -- , data-default
-        -- , data-textual
-        -- , directory
-        -- , hashable
-        -- , microlens-platform
-        -- , mtl
-        -- , mwc-random
-        -- , network
-        -- , network-ip
-        -- , prettyprinter
-        -- , random
-        -- , safe
-        -- , serialise
-        -- , stm
-        -- , streaming
-        -- , saltine
-        , text
-        -- , transformers
-        -- , uniplate
-        -- , vector
-        -- , fast-logger
-
-
 executable test-walk-tree-meta
     import:           shared-properties
     import:           common-deps

hbs2-tests/test/TestACB.hs

@@ -1,67 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# Language PatternSynonyms #-}
-module Main where
-
-import HBS2.Prelude
-import HBS2.Net.Proto.ACB
-import HBS2.Data.Types
-import HBS2.Net.Auth.Credentials
-import HBS2.Net.Proto.Definition
-import HBS2.OrDie
--- import HBS2.Net.Messaging.UDP
-
-import Test.Tasty.HUnit
-import Data.Config.Suckless
-
-import Data.Maybe
-import Prettyprinter
-import System.IO
-import Lens.Micro.Platform
-import Data.Either
-import Data.Text qualified as Text
-import Safe
-
-data T
-
-type SK = PubKey 'Sign T
-
-
-
-main :: IO ()
-main = do
-
-  let pek1 = fromStringMay "5k9rLmFdXCP4RncG9WHEaXXEjxvnxmBvvMUqcKkoY45q"
-  let pek2 = fromStringMay "FpZbzEbdFBztGUSXy5yCoWgkYUbJYDuCmSVxFTTrHx7D"
-
-  let root   = fromStringMay @SK "sRyP45vd7wnopdLP6MLxUJAFGJu5wGVHyzF64mKwBbH"
-  let owners = catMaybes [ fromStringMay "EJgvBg9bL2yKXk3GvZaYJgqpHy5kvpXdtEnAgoi4B5DN" ]
-
-  let acb =   set acbRoot root
-            . set acbOwners  ( owners <> maybeToList root )
-            . set acbWriters ( owners <> maybeToList root )
-            . set acbReaders ( catMaybes [pek1, pek2 ] )
-            $  mempty :: ACBSimple T
-
-  let s = show $ pretty (AsSyntax (DefineACB "a1" acb))
-
-  putStrLn s
-
-  let macb2 = fromStringMay s :: Maybe (ACBSimple T)
-
-  acb2 <- pure macb2 `orDie` "can't load ACB"
-
-  print $ pretty (AsSyntax (DefineACB "a1" acb2))
-
-  assertBool "1" $ view acbRoot acb == view acbRoot acb2
-  assertBool "2" $ view acbOwners acb == view acbOwners acb2
-  assertBool "3" $ view acbReaders acb == view acbReaders acb2
-  assertBool "4" $ view acbWriters acb == view acbWriters acb2
-  assertBool "5" $ view acbPrev acb == view acbPrev acb2
-
-  assertBool "6" $ acb == acb2
-
-  -- TODO: acbPrev test
-
-  pure ()
-
-

hbs2/Main.hs

@@ -13,7 +13,6 @@ import HBS2.Prelude.Plated
 import HBS2.Storage.Simple
 import HBS2.Storage.Simple.Extra
 import HBS2.OrDie
-import HBS2.Net.Proto.ACB
 
 
 import HBS2.System.Logger.Simple hiding (info)
@@ -338,24 +337,7 @@ runShowPeerKey fp = do
   maybe1 cred' exitFailure $ \cred -> do
     print $ pretty $ AsBase58 (view peerSignPk cred)
 
--- FIXME: hardcoded-encryption-schema
-runGenACB :: Maybe FilePath -> Maybe FilePath -> IO ()
-runGenACB inFile outFile = do
-  inf <- maybe (pure stdin) (`openFile` ReadMode) inFile
-  s <- hGetContents inf
-  acb <- pure (fromStringMay s :: Maybe (ACBSimple HBS2Basic)) `orDie` "invalid ACB syntax"
-  let bin = serialise acb
-  out <- maybe (pure stdout) (`openFile` WriteMode) outFile
-  LBS.hPutStr out bin
-  hClose out
-  hClose inf
 
-runDumpACB :: Maybe FilePath -> IO ()
-runDumpACB inFile = do
-  inf <- maybe (pure stdin) (`openFile` ReadMode) inFile
-  acb <- LBS.hGetContents inf <&> deserialise @(ACBSimple HBS2Basic)
-  -- acb <- LBS.hGetContents inf <&> (either (error . show) id .  deserialiseOrFail @(ACBSimple HBS2Basic))
-  print $ pretty (AsSyntax (DefineACB "a1" acb))
 
 ---
 
@@ -560,8 +542,6 @@ main = join . customExecParser (prefs showHelpOnError) $
                         <> command "keyring-key-del" (info pKeyDel (progDesc "removes a keypair from the keyring"))
                         <> command "show-peer-key"   (info pShowPeerKey (progDesc "show peer key from credential file"))
                         <> command "groupkey-new"    (info pNewGroupkey (progDesc "generates a new groupkey"))
-                        <> command "acb-gen"         (info pACBGen  (progDesc "generates binary ACB from text config"))
-                        <> command "acb-dump"        (info pACBDump (progDesc "dumps binary ACB to text config"))
                         <> command "lref-new"        (info pNewLRef (progDesc "generates a new linear ref"))
                         <> command "lref-list"       (info pListLRef (progDesc "list node linear refs"))
                         <> command "lref-get"        (info pGetLRef (progDesc "get a linear ref"))
@@ -621,15 +601,6 @@ main = join . customExecParser (prefs showHelpOnError) $
       f <- strArgument ( metavar "KEYRING-FILE" )
       pure (runKeyDel s f)
 
-    pACBGen = do
-      f <- optional $ strArgument ( metavar "ACB-FILE-INPUT" )
-      o <- optional $ strArgument ( metavar "ACB-FILE-OUTPUT" )
-      pure (runGenACB f o)
-
-    pACBDump = do
-      f <- optional $ strArgument ( metavar "ACB-FILE-INPUT" )
-      pure (runDumpACB f)
-
     pNewLRef = do
       nodeCredFile <- strArgument ( metavar "NODE-KEYRING-FILE" )
       ownerCredFile <- strArgument ( metavar "REF-OWNER-KEYRING-FILE" )