From d30207f8383869be2ea62f74990800b9ad8831e7 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Sat, 13 Apr 2024 08:03:09 +0300 Subject: [PATCH] wip --- hbs2-core/lib/HBS2/Data/KeyRing.hs | 4 ++-- hbs2-core/lib/HBS2/Data/Types/Refs.hs | 4 ++++ hbs2-core/lib/HBS2/Net/Auth/Credentials.hs | 6 +++--- hbs2-git/git-hbs2/Main.hs | 2 +- hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs | 14 +++++++++++++- hbs2/Main.hs | 2 +- 6 files changed, 24 insertions(+), 8 deletions(-) diff --git a/hbs2-core/lib/HBS2/Data/KeyRing.hs b/hbs2-core/lib/HBS2/Data/KeyRing.hs index 0b83f51f..5a797bef 100644 --- a/hbs2-core/lib/HBS2/Data/KeyRing.hs +++ b/hbs2-core/lib/HBS2/Data/KeyRing.hs @@ -43,7 +43,7 @@ findFilesBy fp = liftIO do findKeyRing :: forall s m . ( MonadUnliftIO m , SerialisedCredentials s - , For'HBS2Basic s + , ForHBS2Basic s ) => [FilePattern] -> PubKey 'Sign s @@ -68,7 +68,7 @@ findKeyRing fp kr = do findKeyRingEntries :: forall s m . ( MonadUnliftIO m , SerialisedCredentials s , Hashable (PubKey 'Encrypt s) - -- , For'HBS2Basic s + -- , ForHBS2Basic s ) => [FilePattern] -> [PubKey 'Encrypt s] diff --git a/hbs2-core/lib/HBS2/Data/Types/Refs.hs b/hbs2-core/lib/HBS2/Data/Types/Refs.hs index 1b4b564f..77b3bd25 100644 --- a/hbs2-core/lib/HBS2/Data/Types/Refs.hs +++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs @@ -23,6 +23,9 @@ newtype HashRef = HashRef { fromHashRef :: Hash HbSync } deriving newtype (Eq,Ord,IsString,Pretty,Hashable,Hashed HbSync) deriving stock (Data,Generic,Show) +newtype TaggedHashRef t = TaggedHashRef { fromTaggedHashRef :: HashRef } + deriving newtype (Eq,Ord,IsString,Pretty,Hashable,Hashed HbSync) + deriving stock (Data,Generic,Show) instance Pretty (AsBase58 HashRef) where pretty (AsBase58 x) = pretty x @@ -65,6 +68,7 @@ data SequentialRef = instance Serialise AnnotatedHashRef instance Serialise SequentialRef instance Serialise HashRef +instance Serialise (TaggedHashRef e) type IsRefPubKey s = ( Eq (PubKey 'Sign s) diff --git a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs index 449f5347..abd4d7be 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs @@ -90,7 +90,7 @@ data PeerCredentials s = makeLenses 'KeyringEntry makeLenses 'PeerCredentials -type For'HBS2Basic s = ( Signatures s +type ForHBS2Basic s = ( Signatures s , PrivKey 'Sign s ~ Sign.SecretKey , PubKey 'Sign s ~ Sign.PublicKey , Eq (PubKey 'Encrypt 'HBS2Basic) @@ -147,7 +147,7 @@ addKeyPair txt cred = do pure $ cred & over peerKeyring (List.nub . (<> [kp])) delKeyPair :: forall e m . ( MonadIO m - , For'HBS2Basic e + , ForHBS2Basic e ) => AsBase58 String -> PeerCredentials e -> m (PeerCredentials e) delKeyPair (AsBase58 pks) cred = do @@ -157,7 +157,7 @@ delKeyPair (AsBase58 pks) cred = do pure $ cred & set peerKeyring rest -parseCredentials :: forall s . ( -- For'HBS2Basic s +parseCredentials :: forall s . ( -- ForHBS2Basic s SerialisedCredentials s ) => AsCredFile ByteString -> Maybe (PeerCredentials s) diff --git a/hbs2-git/git-hbs2/Main.hs b/hbs2-git/git-hbs2/Main.hs index 9b8752ff..a48a2470 100644 --- a/hbs2-git/git-hbs2/Main.hs +++ b/hbs2-git/git-hbs2/Main.hs @@ -217,7 +217,7 @@ pSendRepoNotify :: GitPerks m => Parser (GitCLI m ()) pSendRepoNotify = do notifyChan <- argument pRefChanId (metavar "CHANNEL-KEY") pure do - notice "JOPA" + notice "wip" pure () main :: IO () diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs index 27292d31..bf18761e 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/Types.hs @@ -87,6 +87,14 @@ data RefChanActionRequest = instance Serialise RefChanActionRequest +type DisclosedCredentials e = PeerCredentials (Encryption e) + +data RefChanHeadExt e = + RefChanDisclosedCredentials (TaggedHashRef (DisclosedCredentials e)) + deriving stock (Generic) + +instance SerialisedCredentials (Encryption e) => Serialise (RefChanHeadExt e) + data RefChanNotify e = Notify (RefChanId e) (SignedBox ByteString (Encryption e)) -- подписано ключом автора -- довольно уместно будет добавить эти команды сюда - @@ -97,6 +105,7 @@ data RefChanNotify e = instance ForRefChans e => Serialise (RefChanNotify e) + newtype instance EventKey e (RefChanNotify e) = RefChanNotifyEventKey (RefChanId e) @@ -116,7 +125,8 @@ instance Expires (EventKey e (RefChanNotify e)) where -type ForRefChans e = ( Serialise ( PubKey 'Sign (Encryption e)) +type ForRefChans e = ( Serialise (PubKey 'Sign (Encryption e)) + , Serialise (PrivKey 'Sign (Encryption e)) , Pretty (AsBase58 (PubKey 'Sign (Encryption e))) , FromStringMaybe (PubKey 'Sign (Encryption e)) , FromStringMaybe (PubKey 'Encrypt (Encryption e)) @@ -261,6 +271,7 @@ instance ForRefChans e => FromStringMaybe (RefChanHeadBlock e) where | (ListVal [SymbolVal "notifier", LitStrVal s] ) <- parsed ] + instance (ForRefChans e , Pretty (AsBase58 (PubKey 'Sign (Encryption e))) , Pretty (AsBase58 (PubKey 'Encrypt (Encryption e))) @@ -284,6 +295,7 @@ instance (ForRefChans e author p = parens ("author" <+> dquotes (pretty (AsBase58 p))) reader p = parens ("reader" <+> dquotes (pretty (AsBase58 p))) notifier p = parens ("notifier" <+> dquotes (pretty (AsBase58 p))) + -- disclosed p = lstOf f e | null e = mempty | otherwise = vcat (fmap f e) <> line diff --git a/hbs2/Main.hs b/hbs2/Main.hs index 5fce8969..4f291fb6 100644 --- a/hbs2/Main.hs +++ b/hbs2/Main.hs @@ -183,7 +183,7 @@ runHash opts _ = do withBinaryFile (hashFp opts) ReadMode $ \h -> do LBS.hGetContents h >>= print . pretty . hashObject @HbSync -runCat :: forall s . For'HBS2Basic s => CatOpts -> SimpleStorage HbSync -> IO () +runCat :: forall s . ForHBS2Basic s => CatOpts -> SimpleStorage HbSync -> IO () runCat opts ss | catRaw opts == Just True = do