-- | Peer ID derivation from public keys.
--
-- A Peer ID is a multihash of the serialized PublicKey protobuf message.
-- Ed25519 keys (36 bytes serialized) use identity multihash.
-- Larger keys (RSA) use SHA-256 multihash.
module Network.LibP2P.Crypto.PeerId
  ( PeerId (..)
  , fromPublicKey
  , toBase58
  , fromBase58
  , peerIdBytes
  , parsePeerId
  , toCIDv1
  ) where

import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Base58 as B58
import Data.ByteArray.Encoding (Base (Base32), convertFromBase, convertToBase)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Char (toLower, toUpper)
import Data.Word (Word64)
import Network.LibP2P.Core.Multihash (HashFunction (..), encodeMultihash, validateMultihash)
import Network.LibP2P.Core.Varint (encodeUvarint, decodeUvarint)
import Network.LibP2P.Crypto.Key (PublicKey)
import Network.LibP2P.Crypto.Protobuf (encodePublicKey)

-- | A Peer ID is a multihash of the serialized public key.
newtype PeerId = PeerId ByteString
  deriving (Int -> PeerId -> ShowS
[PeerId] -> ShowS
PeerId -> String
(Int -> PeerId -> ShowS)
-> (PeerId -> String) -> ([PeerId] -> ShowS) -> Show PeerId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerId -> ShowS
showsPrec :: Int -> PeerId -> ShowS
$cshow :: PeerId -> String
show :: PeerId -> String
$cshowList :: [PeerId] -> ShowS
showList :: [PeerId] -> ShowS
Show, PeerId -> PeerId -> Bool
(PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool) -> Eq PeerId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PeerId -> PeerId -> Bool
== :: PeerId -> PeerId -> Bool
$c/= :: PeerId -> PeerId -> Bool
/= :: PeerId -> PeerId -> Bool
Eq, Eq PeerId
Eq PeerId =>
(PeerId -> PeerId -> Ordering)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> Bool)
-> (PeerId -> PeerId -> PeerId)
-> (PeerId -> PeerId -> PeerId)
-> Ord PeerId
PeerId -> PeerId -> Bool
PeerId -> PeerId -> Ordering
PeerId -> PeerId -> PeerId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PeerId -> PeerId -> Ordering
compare :: PeerId -> PeerId -> Ordering
$c< :: PeerId -> PeerId -> Bool
< :: PeerId -> PeerId -> Bool
$c<= :: PeerId -> PeerId -> Bool
<= :: PeerId -> PeerId -> Bool
$c> :: PeerId -> PeerId -> Bool
> :: PeerId -> PeerId -> Bool
$c>= :: PeerId -> PeerId -> Bool
>= :: PeerId -> PeerId -> Bool
$cmax :: PeerId -> PeerId -> PeerId
max :: PeerId -> PeerId -> PeerId
$cmin :: PeerId -> PeerId -> PeerId
min :: PeerId -> PeerId -> PeerId
Ord)

-- | Maximum serialized size for identity multihash.
maxInlineKeyLength :: Int
maxInlineKeyLength :: Int
maxInlineKeyLength = Int
42

-- | Derive a Peer ID from a public key.
fromPublicKey :: PublicKey -> PeerId
fromPublicKey :: PublicKey -> PeerId
fromPublicKey PublicKey
pk =
  let serialized :: ByteString
serialized = PublicKey -> ByteString
encodePublicKey PublicKey
pk
      mh :: ByteString
mh =
        if ByteString -> Int
BS.length ByteString
serialized Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxInlineKeyLength
          then HashFunction -> ByteString -> ByteString
encodeMultihash HashFunction
Identity ByteString
serialized
          else HashFunction -> ByteString -> ByteString
encodeMultihash HashFunction
SHA256 ByteString
serialized
   in ByteString -> PeerId
PeerId ByteString
mh

-- | Encode a Peer ID as base58btc text.
toBase58 :: PeerId -> Text
toBase58 :: PeerId -> Text
toBase58 (PeerId ByteString
bs) = ByteString -> Text
TE.decodeUtf8 (ByteString -> ByteString
B58.encode ByteString
bs)

-- | Decode a Peer ID from base58btc text.
-- Validates that decoded bytes are a well-formed multihash.
fromBase58 :: Text -> Either String PeerId
fromBase58 :: Text -> Either String PeerId
fromBase58 Text
t = case ByteString -> Maybe ByteString
B58.decode (Text -> ByteString
TE.encodeUtf8 Text
t) of
  Maybe ByteString
Nothing -> String -> Either String PeerId
forall a b. a -> Either a b
Left String
"fromBase58: invalid base58 encoding"
  Just ByteString
bs -> do
    _ <- ByteString -> Either String (HashFunction, ByteString)
validateMultihash ByteString
bs
    Right (PeerId bs)

-- | Get the raw multihash bytes of a Peer ID.
peerIdBytes :: PeerId -> ByteString
peerIdBytes :: PeerId -> ByteString
peerIdBytes (PeerId ByteString
bs) = ByteString
bs

-- | Parse a Peer ID from text, accepting both base58btc and CIDv1 (base32lower) formats.
-- CIDv1 format: 'b' prefix + base32lower(0x01 || 0x72 || multihash)
parsePeerId :: Text -> Either String PeerId
parsePeerId :: Text -> Either String PeerId
parsePeerId Text
t
  | Text -> Bool
T.null Text
t = String -> Either String PeerId
forall a b. a -> Either a b
Left String
"parsePeerId: empty input"
  | HasCallStack => Text -> Char
Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'b' = Text -> Either String PeerId
fromCIDv1 Text
t
  | Bool
otherwise = Text -> Either String PeerId
fromBase58 Text
t

-- | Encode a Peer ID as CIDv1 text (base32lower, no padding).
-- Format: 'b' + base32lower(varint(1) + varint(0x72) + multihash_bytes)
toCIDv1 :: PeerId -> Text
toCIDv1 :: PeerId -> Text
toCIDv1 (PeerId ByteString
mhBytes) =
  let cidVersion :: ByteString
cidVersion = Word64 -> ByteString
encodeUvarint (Word64
1 :: Word64)
      codec :: ByteString
codec = Word64 -> ByteString
encodeUvarint (Word64
0x72 :: Word64)  -- libp2p-key
      cidBytes :: ByteString
cidBytes = ByteString
cidVersion ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
codec ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
mhBytes
      base32Upper :: ByteString
base32Upper = Base -> ByteString -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> bout
convertToBase Base
Base32 ByteString
cidBytes :: ByteString
      -- Strip padding '=' and convert to lowercase
      base32NoPad :: ByteString
base32NoPad = (Word8 -> Bool) -> ByteString -> ByteString
BS.filter (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0x3D) ByteString
base32Upper  -- 0x3D = '='
      base32Lower :: ByteString
base32Lower = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (\Word8
w -> if Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word8
0x41 Bool -> Bool -> Bool
&& Word8
w Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x5A then Word8
w Word8 -> Word8 -> Word8
forall a. Num a => a -> a -> a
+ Word8
32 else Word8
w) ByteString
base32NoPad
  in Text
"b" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
TE.decodeUtf8 ByteString
base32Lower

-- | Decode a Peer ID from CIDv1 text.
fromCIDv1 :: Text -> Either String PeerId
fromCIDv1 :: Text -> Either String PeerId
fromCIDv1 Text
t
  | Text -> Bool
T.null Text
t = String -> Either String PeerId
forall a b. a -> Either a b
Left String
"fromCIDv1: empty input"
  | HasCallStack => Text -> Char
Text -> Char
T.head Text
t Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'b' = String -> Either String PeerId
forall a b. a -> Either a b
Left String
"fromCIDv1: expected 'b' multibase prefix"
  | Bool
otherwise = do
      let base32Text :: Text
base32Text = Int -> Text -> Text
T.drop Int
1 Text
t  -- strip 'b' prefix
          -- Convert to uppercase for standard Base32 decoding, add padding
          upperText :: Text
upperText = (Char -> Char) -> Text -> Text
T.map Char -> Char
toUpper Text
base32Text
          padLen :: Int
padLen = case Text -> Int
T.length Text
upperText Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
8 of
                     Int
0 -> Int
0
                     Int
n -> Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n
          paddedText :: Text
paddedText = Text
upperText Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
T.replicate Int
padLen Text
"="
      cidBytes <- case Base -> ByteString -> Either String ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base32 (Text -> ByteString
TE.encodeUtf8 Text
paddedText) :: Either String ByteString of
        Left String
err -> String -> Either String ByteString
forall a b. a -> Either a b
Left (String -> Either String ByteString)
-> String -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ String
"fromCIDv1: base32 decode error: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
err
        Right ByteString
bs -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right ByteString
bs
      -- Parse CID: version + codec + multihash
      (version, rest1) <- decodeUvarint cidBytes
      if version /= (1 :: Word64)
        then Left $ "fromCIDv1: expected CID version 1, got " <> show version
        else do
          (codec, rest2) <- decodeUvarint rest1
          if codec /= (0x72 :: Word64)
            then Left $ "fromCIDv1: expected libp2p-key codec 0x72, got 0x" <> showHexW64 codec
            else do
              _ <- validateMultihash rest2
              Right (PeerId rest2)

-- | Show a Word64 as hex.
showHexW64 :: Word64 -> String
showHexW64 :: Word64 -> String
showHexW64 = String -> Word64 -> String
forall {t}. Integral t => String -> t -> String
go []
  where
    go :: String -> t -> String
go String
acc t
0 | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
acc = String
"0"
             | Bool
otherwise = String
acc
    go String
acc t
n = String -> t -> String
go (Int -> Char
hexDigit (t -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`mod` t
16)) Char -> ShowS
forall a. a -> [a] -> [a]
: String
acc) (t
n t -> t -> t
forall a. Integral a => a -> a -> a
`div` t
16)
    hexDigit :: Int -> Char
    hexDigit :: Int -> Char
hexDigit Int
d
      | Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
10 = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'0')
      | Bool
otherwise = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
'a')