{-# LANGUAGE ScopedTypeVariables #-}

-- | Certified peer records: the signed routing records a node has
-- accepted, and the freshness rule that governs replacing them
-- (specs/RFC/0003-routing-records.md).
--
-- RFC 0003, Peer Store APIs:
--
-- > a receiving peer MUST keep track of the latest @seq@ value received
-- > for each peer and reject incoming records unless they contain a
-- > greater @seq@ value than the last received.
--
-- Verifying an envelope's signature says only that the peer signed it at
-- some point, not that it is current. Without the sequence check a
-- correctly signed but older record replayed at a peer rolls its
-- certified addresses back to stale state, which is exactly what signing
-- them was supposed to prevent.
--
-- The state lives here rather than in 'LibP2P.Protocol.Identify.IdentifyInfo'
-- because a record does not only arrive over Identify: Identify Push and
-- GossipSub peer exchange carry the same envelopes and must be held to
-- the same rule, and none of them is an Identify message.
module LibP2P.Switch.CertifiedRecords
  ( -- * Types
    CertifiedRecord (..)
    -- * Verification
  , verifyPeerRecord
    -- * Freshness
  , consumeCertifiedRecord
  , lookupCertifiedRecord
  ) where

import Control.Concurrent.STM (STM, TVar, modifyTVar', readTVar)
import Data.ByteString (ByteString)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Word (Word64)
import LibP2P.Crypto.PeerId (PeerId, fromPublicKey)
import LibP2P.Crypto.PeerRecord (PeerRecord (..), openPeerRecordEnvelope)
import LibP2P.Crypto.SignedEnvelope (SignedEnvelope (..))

-- | A signed peer record this node has verified and accepted, kept
-- alongside the envelope it came in so it can be forwarded verbatim
-- (a record is only self-certifying while its signature travels with it).
data CertifiedRecord = CertifiedRecord
  { CertifiedRecord -> Word64
crSeq       :: !Word64       -- ^ Sequence number of the accepted record
  , CertifiedRecord -> ByteString
crEnvelope  :: !ByteString   -- ^ The encoded envelope, exactly as received
  , CertifiedRecord -> [ByteString]
crAddresses :: ![ByteString] -- ^ Certified binary multiaddrs
  } deriving (Int -> CertifiedRecord -> ShowS
[CertifiedRecord] -> ShowS
CertifiedRecord -> String
(Int -> CertifiedRecord -> ShowS)
-> (CertifiedRecord -> String)
-> ([CertifiedRecord] -> ShowS)
-> Show CertifiedRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertifiedRecord -> ShowS
showsPrec :: Int -> CertifiedRecord -> ShowS
$cshow :: CertifiedRecord -> String
show :: CertifiedRecord -> String
$cshowList :: [CertifiedRecord] -> ShowS
showList :: [CertifiedRecord] -> ShowS
Show, CertifiedRecord -> CertifiedRecord -> Bool
(CertifiedRecord -> CertifiedRecord -> Bool)
-> (CertifiedRecord -> CertifiedRecord -> Bool)
-> Eq CertifiedRecord
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertifiedRecord -> CertifiedRecord -> Bool
== :: CertifiedRecord -> CertifiedRecord -> Bool
$c/= :: CertifiedRecord -> CertifiedRecord -> Bool
/= :: CertifiedRecord -> CertifiedRecord -> Bool
Eq)

-- | Verify an envelope against an authenticated peer id.
--
-- The envelope must open (valid signature, expected domain and payload
-- type) and its signing key must derive the peer id the security
-- handshake authenticated — otherwise the sender is making a claim about
-- an identity it does not hold.
--
-- This says nothing about whether the record is current; that is
-- 'consumeCertifiedRecord'.
verifyPeerRecord :: PeerId -> ByteString -> Either String CertifiedRecord
verifyPeerRecord :: PeerId -> ByteString -> Either String CertifiedRecord
verifyPeerRecord PeerId
peer ByteString
envBytes = do
  (env, record) <- ByteString -> Either String (SignedEnvelope, PeerRecord)
openPeerRecordEnvelope ByteString
envBytes
  if fromPublicKey (sePublicKey env) == peer
    then Right CertifiedRecord
      { crSeq       = prSeq record
      , crEnvelope  = envBytes
      , crAddresses = prAddresses record
      }
    else Left "signed peer record was not signed by the authenticated peer"

-- | Apply the RFC 0003 freshness rule and, when the record wins, retain
-- it. Returns whether the record was accepted.
--
-- A first record for a peer is always accepted. After that only a
-- strictly greater @seq@ is, so an equal or lower one leaves the retained
-- record untouched — replaying a record we already hold changes nothing.
--
-- Note that go-libp2p is more permissive here: @pstoremem@ rejects only
-- @lastState.Seq > rec.Seq@, accepting an equal sequence number as a TTL
-- refresh for its address book. This implementation has no address TTL
-- for such a refresh to renew, so it follows the RFC's wording instead.
consumeCertifiedRecord
  :: TVar (Map PeerId CertifiedRecord)
  -> PeerId
  -> CertifiedRecord
  -> STM Bool
consumeCertifiedRecord :: TVar (Map PeerId CertifiedRecord)
-> PeerId -> CertifiedRecord -> STM Bool
consumeCertifiedRecord TVar (Map PeerId CertifiedRecord)
recordsVar PeerId
peer CertifiedRecord
record = do
  known <- PeerId -> Map PeerId CertifiedRecord -> Maybe CertifiedRecord
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerId
peer (Map PeerId CertifiedRecord -> Maybe CertifiedRecord)
-> STM (Map PeerId CertifiedRecord) -> STM (Maybe CertifiedRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map PeerId CertifiedRecord)
-> STM (Map PeerId CertifiedRecord)
forall a. TVar a -> STM a
readTVar TVar (Map PeerId CertifiedRecord)
recordsVar
  let fresher = Bool -> (CertifiedRecord -> Bool) -> Maybe CertifiedRecord -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ((CertifiedRecord -> Word64
crSeq CertifiedRecord
record Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>) (Word64 -> Bool)
-> (CertifiedRecord -> Word64) -> CertifiedRecord -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CertifiedRecord -> Word64
crSeq) Maybe CertifiedRecord
known
  if fresher
    then do
      modifyTVar' recordsVar (Map.insert peer record)
      pure True
    else pure False

-- | The record currently retained for a peer, if any.
lookupCertifiedRecord
  :: TVar (Map PeerId CertifiedRecord)
  -> PeerId
  -> STM (Maybe CertifiedRecord)
lookupCertifiedRecord :: TVar (Map PeerId CertifiedRecord)
-> PeerId -> STM (Maybe CertifiedRecord)
lookupCertifiedRecord TVar (Map PeerId CertifiedRecord)
recordsVar PeerId
peer = PeerId -> Map PeerId CertifiedRecord -> Maybe CertifiedRecord
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup PeerId
peer (Map PeerId CertifiedRecord -> Maybe CertifiedRecord)
-> STM (Map PeerId CertifiedRecord) -> STM (Maybe CertifiedRecord)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar (Map PeerId CertifiedRecord)
-> STM (Map PeerId CertifiedRecord)
forall a. TVar a -> STM a
readTVar TVar (Map PeerId CertifiedRecord)
recordsVar