-- | Binary and text encoding/decoding for multiaddr.
module LibP2P.Multiaddr.Codec
  ( encodeProtocols
  , decodeProtocols
  , protocolsToText
  , textToProtocols
  ) where

import Data.Bits (shiftL, shiftR, (.&.))
import Data.ByteString (ByteString)
import Data.Char (isDigit)
import qualified Data.ByteString as BS
import Data.IP (IPv6, fromHostAddress6, toHostAddress6)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Data.Word (Word16, Word32, Word64)
import Text.Read (readMaybe)
import LibP2P.Core.Binary (readWord16BE, readWord32BE, word16BE, word32BE)
import LibP2P.Core.Multihash (validateMultihash)
import LibP2P.Core.Varint (decodeUvarint, encodeUvarint)
import qualified Data.ByteString.Base58 as B58
import LibP2P.Crypto.PeerId (parsePeerId, peerIdBytes)
import LibP2P.Multiaddr.Protocol

-- | Encode a list of protocols to binary multiaddr format.
encodeProtocols :: [Protocol] -> ByteString
encodeProtocols :: [Protocol] -> ByteString
encodeProtocols = [ByteString] -> ByteString
BS.concat ([ByteString] -> ByteString)
-> ([Protocol] -> [ByteString]) -> [Protocol] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Protocol -> ByteString) -> [Protocol] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Protocol -> ByteString
encodeOne
  where
    encodeOne :: Protocol -> ByteString
    encodeOne :: Protocol -> ByteString
encodeOne Protocol
p =
      let code :: ByteString
code = Word64 -> ByteString
encodeUvarint (Protocol -> Word64
protocolCode Protocol
p)
          addr :: ByteString
addr = Protocol -> ByteString
encodeAddress Protocol
p
       in ByteString
code ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
addr

    encodeAddress :: Protocol -> ByteString
    encodeAddress :: Protocol -> ByteString
encodeAddress (IP4 Word32
w) = Word32 -> ByteString
word32BE Word32
w
    encodeAddress (IP6 ByteString
bs) = ByteString
bs
    encodeAddress (TCP Word16
port) = Word16 -> ByteString
word16BE Word16
port
    encodeAddress (UDP Word16
port) = Word16 -> ByteString
word16BE Word16
port
    encodeAddress (P2P ByteString
mh) = Word64 -> ByteString
encodeUvarint (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
mh)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
mh
    encodeAddress (DNS Text
t) = Text -> ByteString
encodeVarText Text
t
    encodeAddress (DNS4 Text
t) = Text -> ByteString
encodeVarText Text
t
    encodeAddress (DNS6 Text
t) = Text -> ByteString
encodeVarText Text
t
    encodeAddress (DNSAddr Text
t) = Text -> ByteString
encodeVarText Text
t
    encodeAddress Protocol
QuicV1 = ByteString
BS.empty
    encodeAddress Protocol
WS = ByteString
BS.empty
    encodeAddress Protocol
WSS = ByteString
BS.empty
    encodeAddress Protocol
P2PCircuit = ByteString
BS.empty
    encodeAddress Protocol
WebTransport = ByteString
BS.empty
    encodeAddress Protocol
NoiseProto = ByteString
BS.empty

    encodeVarText :: Text -> ByteString
    encodeVarText :: Text -> ByteString
encodeVarText Text
t =
      let bs :: ByteString
bs = Text -> ByteString
TE.encodeUtf8 Text
t
       in Word64 -> ByteString
encodeUvarint (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
bs)) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
bs

-- | Decode binary multiaddr format to a list of protocols.
decodeProtocols :: ByteString -> Either String [Protocol]
decodeProtocols :: ByteString -> Either String [Protocol]
decodeProtocols ByteString
bs
  | ByteString -> Bool
BS.null ByteString
bs = [Protocol] -> Either String [Protocol]
forall a b. b -> Either a b
Right []
  | Bool
otherwise = do
      (code, rest1) <- ByteString -> Either String (Word64, ByteString)
decodeUvarint ByteString
bs
      case protocolAddressSize code of
        Maybe AddressSize
Nothing -> String -> Either String [Protocol]
forall a b. a -> Either a b
Left (String -> Either String [Protocol])
-> String -> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ String
"decodeProtocols: unknown protocol code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
code
        Just AddressSize
addrSize -> do
          (proto, rest2) <- Word64
-> AddressSize
-> ByteString
-> Either String (Protocol, ByteString)
decodeAddress Word64
code AddressSize
addrSize ByteString
rest1
          rest <- decodeProtocols rest2
          Right (proto : rest)
  where
    decodeAddress :: Word64 -> AddressSize -> ByteString -> Either String (Protocol, ByteString)
    decodeAddress :: Word64
-> AddressSize
-> ByteString
-> Either String (Protocol, ByteString)
decodeAddress Word64
code (Fixed Int
n) ByteString
input
      | ByteString -> Int
BS.length ByteString
input Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n =
          String -> Either String (Protocol, ByteString)
forall a b. a -> Either a b
Left (String -> Either String (Protocol, ByteString))
-> String -> Either String (Protocol, ByteString)
forall a b. (a -> b) -> a -> b
$ String
"decodeProtocols: not enough bytes for protocol " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
code
      | Bool
otherwise =
          let (ByteString
addr, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
n ByteString
input
           in case Word64 -> ByteString -> Maybe Protocol
buildProtocol Word64
code ByteString
addr of
                Just Protocol
p -> (Protocol, ByteString) -> Either String (Protocol, ByteString)
forall a b. b -> Either a b
Right (Protocol
p, ByteString
rest)
                Maybe Protocol
Nothing -> String -> Either String (Protocol, ByteString)
forall a b. a -> Either a b
Left (String -> Either String (Protocol, ByteString))
-> String -> Either String (Protocol, ByteString)
forall a b. (a -> b) -> a -> b
$ String
"decodeProtocols: failed to parse address for code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
code
    decodeAddress Word64
code AddressSize
VarIntPrefixed ByteString
input = do
      (len, rest1) <- ByteString -> Either String (Word64, ByteString)
decodeUvarint ByteString
input
      let n = Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len :: Int
      if BS.length rest1 < n
        then Left $ "decodeProtocols: not enough bytes for varint-prefixed protocol " <> show code
        else
          let (addr, rest2) = BS.splitAt n rest1
           in case buildVarProtocol code addr of
                Just Protocol
p -> (Protocol, ByteString) -> Either String (Protocol, ByteString)
forall a b. b -> Either a b
Right (Protocol
p, ByteString
rest2)
                Maybe Protocol
Nothing -> String -> Either String (Protocol, ByteString)
forall a b. a -> Either a b
Left (String -> Either String (Protocol, ByteString))
-> String -> Either String (Protocol, ByteString)
forall a b. (a -> b) -> a -> b
$ String
"decodeProtocols: failed to parse varint-prefixed address for code " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
code
    decodeAddress Word64
code AddressSize
NoAddress ByteString
input =
      case Word64 -> Maybe Protocol
buildNoAddrProtocol Word64
code of
        Just Protocol
p -> (Protocol, ByteString) -> Either String (Protocol, ByteString)
forall a b. b -> Either a b
Right (Protocol
p, ByteString
input)
        Maybe Protocol
Nothing -> String -> Either String (Protocol, ByteString)
forall a b. a -> Either a b
Left (String -> Either String (Protocol, ByteString))
-> String -> Either String (Protocol, ByteString)
forall a b. (a -> b) -> a -> b
$ String
"decodeProtocols: unknown no-address protocol " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word64 -> String
forall a. Show a => a -> String
show Word64
code

    buildProtocol :: Word64 -> ByteString -> Maybe Protocol
    buildProtocol :: Word64 -> ByteString -> Maybe Protocol
buildProtocol Word64
4 ByteString
bs'
      | ByteString -> Int
BS.length ByteString
bs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
4 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just (Protocol -> Maybe Protocol) -> Protocol -> Maybe Protocol
forall a b. (a -> b) -> a -> b
$ Word32 -> Protocol
IP4 (ByteString -> Word32
readWord32BE ByteString
bs')
    buildProtocol Word64
41 ByteString
bs'
      | ByteString -> Int
BS.length ByteString
bs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
16 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just (Protocol -> Maybe Protocol) -> Protocol -> Maybe Protocol
forall a b. (a -> b) -> a -> b
$ ByteString -> Protocol
IP6 ByteString
bs'
    buildProtocol Word64
6 ByteString
bs'
      | ByteString -> Int
BS.length ByteString
bs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just (Protocol -> Maybe Protocol) -> Protocol -> Maybe Protocol
forall a b. (a -> b) -> a -> b
$ Word16 -> Protocol
TCP (ByteString -> Word16
readWord16BE ByteString
bs')
    buildProtocol Word64
273 ByteString
bs'
      | ByteString -> Int
BS.length ByteString
bs' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just (Protocol -> Maybe Protocol) -> Protocol -> Maybe Protocol
forall a b. (a -> b) -> a -> b
$ Word16 -> Protocol
UDP (ByteString -> Word16
readWord16BE ByteString
bs')
    buildProtocol Word64
_ ByteString
_ = Maybe Protocol
forall a. Maybe a
Nothing

    buildVarProtocol :: Word64 -> ByteString -> Maybe Protocol
    buildVarProtocol :: Word64 -> ByteString -> Maybe Protocol
buildVarProtocol Word64
421 ByteString
mh = case ByteString -> Either String (HashFunction, ByteString)
validateMultihash ByteString
mh of
      Right (HashFunction, ByteString)
_ -> Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just (Protocol -> Maybe Protocol) -> Protocol -> Maybe Protocol
forall a b. (a -> b) -> a -> b
$ ByteString -> Protocol
P2P ByteString
mh
      Left String
_  -> Maybe Protocol
forall a. Maybe a
Nothing
    buildVarProtocol Word64
53 ByteString
bs' = Text -> Protocol
DNS (Text -> Protocol) -> Maybe Text -> Maybe Protocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Text
decodeUtf8Safe ByteString
bs'
    buildVarProtocol Word64
54 ByteString
bs' = Text -> Protocol
DNS4 (Text -> Protocol) -> Maybe Text -> Maybe Protocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Text
decodeUtf8Safe ByteString
bs'
    buildVarProtocol Word64
55 ByteString
bs' = Text -> Protocol
DNS6 (Text -> Protocol) -> Maybe Text -> Maybe Protocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Text
decodeUtf8Safe ByteString
bs'
    buildVarProtocol Word64
56 ByteString
bs' = Text -> Protocol
DNSAddr (Text -> Protocol) -> Maybe Text -> Maybe Protocol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Text
decodeUtf8Safe ByteString
bs'
    buildVarProtocol Word64
_ ByteString
_ = Maybe Protocol
forall a. Maybe a
Nothing

    buildNoAddrProtocol :: Word64 -> Maybe Protocol
    buildNoAddrProtocol :: Word64 -> Maybe Protocol
buildNoAddrProtocol Word64
461 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just Protocol
QuicV1
    buildNoAddrProtocol Word64
477 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just Protocol
WS
    buildNoAddrProtocol Word64
478 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just Protocol
WSS
    buildNoAddrProtocol Word64
290 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just Protocol
P2PCircuit
    buildNoAddrProtocol Word64
465 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just Protocol
WebTransport
    buildNoAddrProtocol Word64
454 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just Protocol
NoiseProto
    buildNoAddrProtocol Word64
_ = Maybe Protocol
forall a. Maybe a
Nothing

-- | Convert a list of protocols to human-readable text form.
protocolsToText :: [Protocol] -> Text
protocolsToText :: [Protocol] -> Text
protocolsToText = [Text] -> Text
T.concat ([Text] -> Text) -> ([Protocol] -> [Text]) -> [Protocol] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Protocol -> Text) -> [Protocol] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Protocol -> Text
renderOne
  where
    renderOne :: Protocol -> Text
    renderOne :: Protocol -> Text
renderOne p :: Protocol
p@(IP4 Word32
w) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word32 -> Text
renderIPv4 Word32
w
    renderOne p :: Protocol
p@(IP6 ByteString
bs) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
renderIPv6 ByteString
bs
    renderOne p :: Protocol
p@(TCP Word16
port) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word16 -> String
forall a. Show a => a -> String
show Word16
port)
    renderOne p :: Protocol
p@(UDP Word16
port) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word16 -> String
forall a. Show a => a -> String
show Word16
port)
    renderOne p :: Protocol
p@(P2P ByteString
mh) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
renderBase58 ByteString
mh
    renderOne p :: Protocol
p@(DNS Text
t) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    renderOne p :: Protocol
p@(DNS4 Text
t) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    renderOne p :: Protocol
p@(DNS6 Text
t) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    renderOne p :: Protocol
p@(DNSAddr Text
t) = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    renderOne Protocol
p = Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Protocol -> Text
protocolName Protocol
p

    renderIPv4 :: Word32 -> Text
    renderIPv4 :: Word32 -> Text
renderIPv4 Word32
w =
      let a :: Word32
a = (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff
          b :: Word32
b = (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff
          c :: Word32
c = (Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff
          d :: Word32
d = Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xff
       in String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Word32 -> String
forall a. Show a => a -> String
show Word32
a String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
b String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"." String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Word32 -> String
forall a. Show a => a -> String
show Word32
d

    -- | Render 16-byte IPv6 address to RFC5952 text form.
    renderIPv6 :: ByteString -> Text
    renderIPv6 :: ByteString -> Text
renderIPv6 ByteString
bs = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IPv6 -> String
forall a. Show a => a -> String
show (ByteString -> IPv6
bytesToIPv6 ByteString
bs)

    -- Minimal base58btc encoding for PeerId display
    renderBase58 :: ByteString -> Text
    renderBase58 :: ByteString -> Text
renderBase58 = ByteString -> Text
TE.decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B58.encode

-- | Parse human-readable text form to a list of protocols.
--
-- Strict per the multiaddr spec and go-multiaddr behaviour: the input
-- must be non-empty, must begin with @/@, and must not contain empty
-- components (so a bare @/@, doubled slashes, and trailing slashes are
-- all rejected).
textToProtocols :: Text -> Either String [Protocol]
textToProtocols :: Text -> Either String [Protocol]
textToProtocols Text
input
  | Text -> Bool
T.null Text
input = String -> Either String [Protocol]
forall a b. a -> Either a b
Left String
"textToProtocols: empty multiaddr"
  | HasCallStack => Text -> Char
Text -> Char
T.head Text
input Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/' = String -> Either String [Protocol]
forall a b. a -> Either a b
Left String
"textToProtocols: multiaddr must begin with /"
  | Bool
otherwise =
      let parts :: [Text]
parts = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" (Int -> Text -> Text
T.drop Int
1 Text
input)
       in if (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Text -> Bool
T.null [Text]
parts
            then String -> Either String [Protocol]
forall a b. a -> Either a b
Left String
"textToProtocols: empty component in multiaddr"
            else [Text] -> Either String [Protocol]
parseParts [Text]
parts
  where
    parseParts :: [Text] -> Either String [Protocol]
    parseParts :: [Text] -> Either String [Protocol]
parseParts [] = [Protocol] -> Either String [Protocol]
forall a b. b -> Either a b
Right []
    parseParts (Text
name : [Text]
rest) = case Text
name of
      Text
"ip4" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining -> do
        w <- Text -> Either String Word32
parseIPv4 Text
addr
        Right (IP4 w, remaining)
      Text
"ip6" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining -> do
        w <- Text -> Either String ByteString
parseIPv6 Text
addr
        Right (IP6 w, remaining)
      Text
"tcp" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining -> do
        port <- Text -> Either String Word16
parsePort Text
addr
        Right (TCP port, remaining)
      Text
"udp" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining -> do
        port <- Text -> Either String Word16
parsePort Text
addr
        Right (UDP port, remaining)
      -- "ipfs" is the legacy name for "p2p"; both map to code 421 and are
      -- equivalent in binary form. Rendering always emits "p2p".
      Text
_ | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"p2p" Bool -> Bool -> Bool
|| Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"ipfs" ->
        [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining -> do
          mh <- Text -> Either String ByteString
parsePeerIdAddr Text
addr
          Right (P2P mh, remaining)
      Text
"dns" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining ->
        (Protocol, [Text]) -> Either String (Protocol, [Text])
forall a b. b -> Either a b
Right (Text -> Protocol
DNS Text
addr, [Text]
remaining)
      Text
"dns4" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining ->
        (Protocol, [Text]) -> Either String (Protocol, [Text])
forall a b. b -> Either a b
Right (Text -> Protocol
DNS4 Text
addr, [Text]
remaining)
      Text
"dns6" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining ->
        (Protocol, [Text]) -> Either String (Protocol, [Text])
forall a b. b -> Either a b
Right (Text -> Protocol
DNS6 Text
addr, [Text]
remaining)
      Text
"dnsaddr" -> [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [Text]
rest ((Text -> [Text] -> Either String (Protocol, [Text]))
 -> Either String [Protocol])
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ \Text
addr [Text]
remaining ->
        (Protocol, [Text]) -> Either String (Protocol, [Text])
forall a b. b -> Either a b
Right (Text -> Protocol
DNSAddr Text
addr, [Text]
remaining)
      Text
"quic-v1" -> do
        more <- [Text] -> Either String [Protocol]
parseParts [Text]
rest
        Right (QuicV1 : more)
      Text
"ws" -> do
        more <- [Text] -> Either String [Protocol]
parseParts [Text]
rest
        Right (WS : more)
      Text
"wss" -> do
        more <- [Text] -> Either String [Protocol]
parseParts [Text]
rest
        Right (WSS : more)
      Text
"p2p-circuit" -> do
        more <- [Text] -> Either String [Protocol]
parseParts [Text]
rest
        Right (P2PCircuit : more)
      Text
"webtransport" -> do
        more <- [Text] -> Either String [Protocol]
parseParts [Text]
rest
        Right (WebTransport : more)
      Text
"noise" -> do
        more <- [Text] -> Either String [Protocol]
parseParts [Text]
rest
        Right (NoiseProto : more)
      Text
other -> String -> Either String [Protocol]
forall a b. a -> Either a b
Left (String -> Either String [Protocol])
-> String -> Either String [Protocol]
forall a b. (a -> b) -> a -> b
$ String
"textToProtocols: unknown protocol " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
other

    withAddr :: [Text] -> (Text -> [Text] -> Either String (Protocol, [Text])) -> Either String [Protocol]
    withAddr :: [Text]
-> (Text -> [Text] -> Either String (Protocol, [Text]))
-> Either String [Protocol]
withAddr [] Text -> [Text] -> Either String (Protocol, [Text])
_ = String -> Either String [Protocol]
forall a b. a -> Either a b
Left String
"textToProtocols: expected address but got end of input"
    withAddr (Text
addr : [Text]
remaining) Text -> [Text] -> Either String (Protocol, [Text])
f = do
      (proto, rest) <- Text -> [Text] -> Either String (Protocol, [Text])
f Text
addr [Text]
remaining
      more <- parseParts rest
      Right (proto : more)

    -- Strict dotted-decimal: exactly four octets, digits only (no sign,
    -- hex, or whitespace), no leading zeros, each in 0..255. Matches
    -- go-multiaddr, which rejects e.g. "010.0.0.1" and "-1.0.0.1".
    parseIPv4 :: Text -> Either String Word32
    parseIPv4 :: Text -> Either String Word32
parseIPv4 Text
t = case (Text -> Maybe Integer) -> [Text] -> Maybe [Integer]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM Text -> Maybe Integer
parseOctet (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
t) of
      Just [Integer
a, Integer
b, Integer
c, Integer
d] ->
        Word32 -> Either String Word32
forall a b. b -> Either a b
Right (Word32 -> Either String Word32) -> Word32 -> Either String Word32
forall a b. (a -> b) -> a -> b
$
          (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
            Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
            Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
            Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
d
      Maybe [Integer]
_ -> String -> Either String Word32
forall a b. a -> Either a b
Left (String -> Either String Word32) -> String -> Either String Word32
forall a b. (a -> b) -> a -> b
$ String
"textToProtocols: invalid IPv4 address: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

    parseOctet :: Text -> Maybe Integer
    parseOctet :: Text -> Maybe Integer
parseOctet Text
o
      | Text -> Int
T.length Text
o Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 Bool -> Bool -> Bool
&& HasCallStack => Text -> Char
Text -> Char
T.head Text
o Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' = Maybe Integer
forall a. Maybe a
Nothing -- no leading zeros
      | Bool
otherwise = do
          n <- Text -> Maybe Integer
parseDecimal Text
o
          if n <= 255 then Just n else Nothing

    -- | Parse IPv6 text (e.g. "::1", "fe80::1") to 16-byte ByteString.
    parseIPv6 :: Text -> Either String ByteString
    parseIPv6 :: Text -> Either String ByteString
parseIPv6 Text
t =
      case String -> Maybe IPv6
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) :: Maybe IPv6 of
        Just IPv6
ipv6 -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (IPv6 -> ByteString
ipv6ToBytes IPv6
ipv6)
        Maybe IPv6
Nothing -> 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
"textToProtocols: invalid IPv6 address: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

    -- Strict decimal port: digits only (no sign, hex, or whitespace),
    -- in 0..65535. Leading zeros are accepted, matching go-multiaddr's
    -- strconv.ParseUint behaviour.
    parsePort :: Text -> Either String Word16
    parsePort :: Text -> Either String Word16
parsePort Text
t = case Text -> Maybe Integer
parseDecimal Text
t of
      Just Integer
n
        | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
65535 -> Word16 -> Either String Word16
forall a b. b -> Either a b
Right (Integer -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
n)
      Maybe Integer
_ -> String -> Either String Word16
forall a b. a -> Either a b
Left (String -> Either String Word16) -> String -> Either String Word16
forall a b. (a -> b) -> a -> b
$ String
"textToProtocols: invalid port: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

    -- Non-negative decimal, digits only. Parsed via Integer so absurdly
    -- long digit strings cannot wrap around a fixed-width type.
    parseDecimal :: Text -> Maybe Integer
    parseDecimal :: Text -> Maybe Integer
parseDecimal Text
t
      | Text -> Bool
T.null Text
t = Maybe Integer
forall a. Maybe a
Nothing
      | Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
T.all Char -> Bool
isDigit Text
t) = Maybe Integer
forall a. Maybe a
Nothing
      | Bool
otherwise = String -> Maybe Integer
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t)

    -- | Parse a peer ID from text, accepting both base58btc and CIDv1 formats.
    -- Validates the decoded bytes as a well-formed multihash.
    parsePeerIdAddr :: Text -> Either String ByteString
    parsePeerIdAddr :: Text -> Either String ByteString
parsePeerIdAddr Text
t = case Text -> Either String PeerId
parsePeerId Text
t of
      Right PeerId
pid -> ByteString -> Either String ByteString
forall a b. b -> Either a b
Right (PeerId -> ByteString
peerIdBytes PeerId
pid)
      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
"textToProtocols: invalid peer ID: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err

-- | Safely decode UTF-8 bytes to Text, returning Nothing on invalid input.
decodeUtf8Safe :: ByteString -> Maybe Text
decodeUtf8Safe :: ByteString -> Maybe Text
decodeUtf8Safe ByteString
bs = case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
bs of
  Right Text
t -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t
  Left UnicodeException
_ -> Maybe Text
forall a. Maybe a
Nothing

-- | Convert 16-byte ByteString to IPv6 address via HostAddress6 tuple.
bytesToIPv6 :: ByteString -> IPv6
bytesToIPv6 :: ByteString -> IPv6
bytesToIPv6 ByteString
bs =
  let w0 :: Word32
w0 = ByteString -> Word32
readWord32BE ByteString
bs
      w1 :: Word32
w1 = ByteString -> Word32
readWord32BE (Int -> ByteString -> ByteString
BS.drop Int
4 ByteString
bs)
      w2 :: Word32
w2 = ByteString -> Word32
readWord32BE (Int -> ByteString -> ByteString
BS.drop Int
8 ByteString
bs)
      w3 :: Word32
w3 = ByteString -> Word32
readWord32BE (Int -> ByteString -> ByteString
BS.drop Int
12 ByteString
bs)
   in HostAddress6 -> IPv6
fromHostAddress6 (Word32
w0, Word32
w1, Word32
w2, Word32
w3)

-- | Convert IPv6 address to 16-byte ByteString.
ipv6ToBytes :: IPv6 -> ByteString
ipv6ToBytes :: IPv6 -> ByteString
ipv6ToBytes IPv6
ipv6 =
  let (Word32
w0, Word32
w1, Word32
w2, Word32
w3) = IPv6 -> HostAddress6
toHostAddress6 IPv6
ipv6
   in Word32 -> ByteString
word32BE Word32
w0 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
word32BE Word32
w1 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
word32BE Word32
w2 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word32 -> ByteString
word32BE Word32
w3