wip

docs/devlog.md

@@ -1,3 +1,45 @@
+
+## 2023-02-09
+
+TODO: encryption-keys-into-credentials-file
+
+  дизайн данных:
+   ```
+   data Credentials = Credentials SignKey [(KeyId, KeyMetadata, KeyPair)]
+   ```
+
+  он же "keyring", это буквально связка ключей.
+
+  операции:
+
+  ```
+    hbs2 keyring list  <keyring-file>
+  ```
+
+  показывает публичные ключи в связке и их типы и прочее
+
+  ```
+  hbs2 keyring add-new [-n key-id] <keyring-file>
+  ```
+
+  добавляет ключ
+
+  ```
+  hbs2 keyring del -n key-id <keyring-file>
+  ```
+
+  удаляет ключ
+
+Этот же формат ключ можно использовать и самому пиру,
+т.к. ему тоже нужны будут потом ключи шифрования.
+
+Единственное, пир должен знать какой ключ из связки
+использовать, но это может быть либо по умолчанию
+первый ключ, либо передавать как-то в конфиге
+или же аргументах.
+
+
+
 ## 2023-02-07
 
 FIXME: suckless-conf

hbs2-core/lib/HBS2/Net/Auth/Credentials.hs

@@ -1,10 +1,10 @@
+{-# Language TemplateHaskell #-}
 {-# Language UndecidableInstances #-}
 module HBS2.Net.Auth.Credentials where
 
 import HBS2.Prelude.Plated
 import HBS2.Net.Proto.Types
 import HBS2.Base58
-import HBS2.Net.Messaging.UDP (UDP)
 
 import Codec.Serialise
 import Crypto.Saltine.Core.Sign (Keypair(..))
@@ -16,8 +16,30 @@ import Data.ByteString.Char8 qualified as B8
 import Data.ByteString.Char8 (ByteString)
 import Data.Function
 import Data.List.Split (chunksOf)
+import Data.Text (Text)
+import Lens.Micro.Platform
 import Prettyprinter
 
+class HasCredentials e m where
+  getCredentials :: m (PeerCredentials e)
+
+data KeyringEntry e =
+  KeyringEntry
+  { _krPk   :: PubKey  'Encrypt e
+  , _krSk   :: PrivKey 'Encrypt e
+  , _krDesc :: Text
+  }
+
+data PeerCredentials e =
+  PeerCredentials
+  { _peerSignSk   :: PrivKey 'Sign e
+  , _peerSignPk   :: PubKey 'Sign e
+  , _peerKeyring  :: [KeyringEntry e]
+  }
+
+makeLenses 'KeyringEntry
+makeLenses 'PeerCredentials
+
 
 newtype AsCredFile a = AsCredFile a
 
@@ -28,7 +50,7 @@ newCredentials :: forall e m . ( MonadIO m
                                ) => m (PeerCredentials e)
 newCredentials = do
   pair <- liftIO Sign.newKeypair
-  pure $ PeerCredentials @e (secretKey pair) (publicKey pair)
+  pure $ PeerCredentials @e (secretKey pair) (publicKey pair) mempty
 
 
 parseCredentials :: forall e . ( Signatures e
@@ -45,6 +67,7 @@ parseCredentials (AsCredFile bs) = maybe1 b58_1 Nothing fromCbor
 
     fromPair (s1,s2) = PeerCredentials <$> Crypto.decode s1
                                        <*> Crypto.decode s2
+                                       <*> pure mempty
 
     b58_1 = B8.lines bs & dropWhile hdr
                         & filter ( not . B8.null )
@@ -59,7 +82,7 @@ instance ( IsEncoding (PrivKey 'Sign e)
          )
 
   =>  Pretty (AsBase58 (PeerCredentials e)) where
-  pretty (AsBase58 (PeerCredentials s p)) = pretty $ B8.unpack (toBase58 bs)
+  pretty (AsBase58 (PeerCredentials s p _)) = pretty $ B8.unpack (toBase58 bs)
     where
      sk = Crypto.encode s
      pk = Crypto.encode p

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

@@ -2,15 +2,16 @@
 {-# Language UndecidableInstances #-}
 module HBS2.Net.Proto.Peer where
 
-import HBS2.Base58
+-- import HBS2.Base58
 import HBS2.Data.Types
 import HBS2.Events
 import HBS2.Net.Proto
 import HBS2.Clock
 import HBS2.Net.Proto.Sessions
 import HBS2.Prelude.Plated
+import HBS2.Net.Auth.Credentials
 
-import HBS2.System.Logger.Simple
+-- import HBS2.System.Logger.Simple
 
 import Data.Maybe
 import Codec.Serialise()

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

@@ -18,6 +18,7 @@ import System.Random qualified as Random
 import Data.Digest.Murmur32
 import Data.ByteString (ByteString)
 import Lens.Micro.Platform
+import Data.Text (Text)
 
 -- e -> Transport (like, UDP or TChan)
 -- p -> L4 Protocol (like Ping/Pong)
@@ -41,8 +42,6 @@ class Signatures e where
   makeSign   :: PrivKey 'Sign e -> ByteString  -> Signature e
   verifySign :: PubKey 'Sign e  -> Signature e -> ByteString -> Bool
 
-class HasCredentials e m where
-  getCredentials :: m (PeerCredentials e)
 
 class HasCookie e p | p -> e where
   type family Cookie e :: Type
@@ -54,13 +53,6 @@ type PeerNonce = Nonce ()
 class HasPeerNonce e m where
   peerNonce :: m PeerNonce
 
-data PeerCredentials e =
-  PeerCredentials
-  { _peerSignSk :: PrivKey 'Sign e
-  , _peerSignPk :: PubKey 'Sign e
-  }
-
-makeLenses 'PeerCredentials
 
 
 data WithCookie e p = WithCookie (Cookie e) p

hbs2-peer/app/PeerTypes.hs

@@ -204,3 +204,4 @@ removeFromWip h = do
   liftIO $ Cache.delete wip h
   liftIO $ Cache.delete po h
   liftIO $ atomically $ modifyTVar' st (HashMap.delete h)
+