diff --git a/docs/devlog.md b/docs/devlog.md index 2856d5ca..85214f42 100644 --- a/docs/devlog.md +++ b/docs/devlog.md @@ -1,6 +1,10 @@ ## 2023-02-06 +FIXME: При вычислении burst надо каким-то образом + находить плато и не лезть выше него. + + FIXME: Задержку в очередь пиров при рассылке GetBlockSize, что бы не спамить пиров, пока запрос не уехал в отстой. Надо diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs index 1ed45e6b..fd5382ec 100644 --- a/hbs2-core/lib/HBS2/Actors/Peer.hs +++ b/hbs2-core/lib/HBS2/Actors/Peer.hs @@ -68,9 +68,6 @@ data Fabriq e = forall bus . (Messaging bus e (Encoded e)) => Fabriq bus class HasFabriq e m where getFabriq :: m (Fabriq e) -class HasPeerNonce e m where - peerNonce :: m PeerNonce - class Messaging (Fabriq e) e (AnyMessage (Encoded e) e) => PeerMessaging e instance Messaging (Fabriq e) e (AnyMessage (Encoded e) e) => PeerMessaging e @@ -461,8 +458,10 @@ instance ( MonadIO m instance (Monad m, HasOwnPeer e m) => HasOwnPeer e (ResponseM e m) where ownPeer = lift ownPeer - instance (Monad m, HasFabriq e m) => HasFabriq e (ResponseM e m) where getFabriq = lift getFabriq +instance (Monad m, HasPeerNonce e m) => HasPeerNonce e (ResponseM e m) where + peerNonce = lift $ peerNonce @e + diff --git a/hbs2-core/lib/HBS2/Net/Proto/Peer.hs b/hbs2-core/lib/HBS2/Net/Proto/Peer.hs index a301eeb9..dbe1dcc4 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Peer.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Peer.hs @@ -17,14 +17,13 @@ import Data.Hashable import Lens.Micro.Platform import Type.Reflection (someTypeRep) -import Prettyprinter - type PingSign e = Signature e type PingNonce = BS.ByteString -newtype PeerData e = +data PeerData e = PeerData - { _peerSignKey :: PubKey 'Sign e + { _peerSignKey :: PubKey 'Sign e + , _peerOwnNonce :: PeerNonce -- TODO: to use this field to detect if it's own peer to avoid loops } deriving stock (Typeable,Generic) @@ -71,6 +70,7 @@ peerHandShakeProto :: forall e m . ( MonadIO m , Sessions e (PeerHandshake e) m , Sessions e (KnownPeer e) m , HasNonces (PeerHandshake e) m + , HasPeerNonce e m , Nonce (PeerHandshake e) ~ PingNonce , Signatures e , Pretty (Peer e) @@ -90,8 +90,10 @@ peerHandShakeProto = -- TODO: подписать нонс let sign = makeSign @e (view peerSignSk creds) nonce + own <- peerNonce @e + -- TODO: отправить обратно вместе с публичным ключом - response (PeerPong @e sign (PeerData (view peerSignPk creds))) + response (PeerPong @e sign (PeerData (view peerSignPk creds) own)) -- TODO: да и пингануть того самим @@ -113,6 +115,8 @@ peerHandShakeProto = expire (PeerHandshakeKey pip) + -- FIXME: check if peer is blacklisted + -- right here update (KnownPeer d) (KnownPeerKey pip) id emit AnyKnownPeerEventKey (KnownPeerEvent pip d) @@ -165,12 +169,15 @@ deriving instance Eq (Peer e) => Eq (SessionKey e (PeerHandshake e)) instance Hashable (Peer e) => Hashable (SessionKey e (PeerHandshake e)) instance ( Serialise (PubKey 'Sign e) - , Serialise (Signature e) ) + , Serialise (Signature e) + , Serialise PeerNonce + ) => Serialise (PeerData e) instance ( Serialise (PubKey 'Sign e) , Serialise (Signature e) + , Serialise PeerNonce ) => Serialise (PeerHandshake e) diff --git a/hbs2-core/lib/HBS2/Net/Proto/Types.hs b/hbs2-core/lib/HBS2/Net/Proto/Types.hs index 3a906027..9b624d1f 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Types.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Types.hs @@ -49,6 +49,9 @@ class HasCookie e p | p -> e where type PeerNonce = Nonce () +class HasPeerNonce e m where + peerNonce :: m PeerNonce + data PeerCredentials e = PeerCredentials { _peerSignSk :: PrivKey 'Sign e diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs index 3b1d1fb2..34106d70 100644 --- a/hbs2-peer/app/BlockDownload.hs +++ b/hbs2-peer/app/BlockDownload.hs @@ -139,11 +139,11 @@ setBlockState h s = do sh <- asks (view blockState) liftIO $ atomically $ modifyTVar' sh (HashMap.insert h s) - +-- FIXME: что-то более обоснованное calcWaitTime :: MonadIO m => BlockDownloadM e m Double calcWaitTime = do wip <- asks (view blockWip) >>= liftIO . Cache.size - let wipn = realToFrac wip * 4 + let wipn = realToFrac wip * 3 let waiting = 5 + ( (realToFrac (toNanoSeconds defBlockWaitMax) * wipn) / 1e9 ) pure waiting @@ -218,7 +218,11 @@ removeFromWip h = do liftIO $ Cache.delete po h liftIO $ atomically $ modifyTVar' st (HashMap.delete h) -withFreePeer :: (MyPeer e, MonadIO m) +withFreePeer :: forall e m . + ( MyPeer e + , MonadIO m + , Sessions e (KnownPeer e) m + ) => Peer e -> BlockDownloadM e m () -> BlockDownloadM e m () @@ -226,12 +230,19 @@ withFreePeer :: (MyPeer e, MonadIO m) withFreePeer p n m = do busy <- asks (view peerBusy) + avail <- liftIO $ atomically $ stateTVar busy $ \s -> case HashMap.lookup p s of Nothing -> (True, HashMap.insert p () s) Just{} -> (False, s) - if not avail + + auth <- lift $ find (KnownPeerKey p) id <&> isJust + + unless auth do + debug $ "peer " <+> pretty p <+> "not authorized (yet?)" + + if not (avail && auth) then n else do r <- m @@ -240,7 +251,7 @@ withFreePeer p n m = do -- NOTE: dangerous! if called in -- wrong place/wrong time, --- if may cause a drastical +-- it may cause a drastical -- download speed degradation dismissPeer :: (MyPeer e, MonadIO m) @@ -541,9 +552,8 @@ blockDownloadLoop :: forall e m . ( m ~ PeerM e IO , EventEmitter e (BlockChunks e) m , Sessions e (BlockChunks e) m , Sessions e (PeerInfo e) m + , Sessions e (KnownPeer e) m , PeerSessionKey e (PeerInfo e) - -- , Typeable (SessionKey e (BlockChunks e)) - -- , Typeable (SessionKey e (BlockInfo e)) , HasStorage m , Pretty (Peer e) , Block ByteString ~ ByteString diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index de7ce4fc..08d7dabb 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -189,7 +189,8 @@ instance (Sessions e p m ) => Sessions e p (CredentialsM e m) where update d k f = lift (update d k f) expire k = lift (expire k) --- instance (Monad m, HasProtocol e p, HasThatPeer e p m) => Response e p (CredentialsM e m) where +instance (Monad m, HasPeerNonce e m) => HasPeerNonce e (CredentialsM e m) where + peerNonce = lift $ peerNonce @e instance Monad m => HasCredentials e (CredentialsM e m) where getCredentials = ask @@ -293,14 +294,15 @@ runPeer opts = Exception.handle myException $ do unless known $ sendPing pip subscribe @UDP AnyKnownPeerEventKey $ \(KnownPeerEvent p d) -> do - addPeers pl [p] + unless (pnonce == view peerOwnNonce d) $ do + addPeers pl [p] - npi <- newPeerInfo - pfails <- fetch True npi (PeerInfoKey p) (view peerPingFailed) - liftIO $ atomically $ writeTVar pfails 0 + npi <- newPeerInfo + pfails <- fetch True npi (PeerInfoKey p) (view peerPingFailed) + liftIO $ atomically $ writeTVar pfails 0 - debug $ "Got authorized peer!" <+> pretty p - <+> pretty (AsBase58 (view peerSignKey d)) + debug $ "Got authorized peer!" <+> pretty p + <+> pretty (AsBase58 (view peerSignKey d)) void $ liftIO $ async $ withPeerM env do pause @'Seconds 1