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

import Data.Bits (shiftL, shiftR, (.&.))
import Data.ByteString (ByteString)
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 Network.LibP2P.Core.Binary (readWord16BE, readWord32BE, word16BE, word32BE)
import Network.LibP2P.Core.Multihash (validateMultihash)
import Network.LibP2P.Core.Varint (decodeUvarint, encodeUvarint)
import qualified Data.ByteString.Base58 as B58
import Network.LibP2P.Crypto.PeerId (parsePeerId, peerIdBytes)
import Network.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
    encodeAddress Protocol
YamuxProto = 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
460 = 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
467 = Protocol -> Maybe Protocol
forall a. a -> Maybe a
Just Protocol
YamuxProto
    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.
textToProtocols :: Text -> Either String [Protocol]
textToProtocols :: Text -> Either String [Protocol]
textToProtocols Text
input
  | Text -> Bool
T.null Text
input = [Protocol] -> Either String [Protocol]
forall a b. b -> Either a b
Right []
  | Bool
otherwise =
      let parts :: [Text]
parts = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null) ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"/" Text
input
       in [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)
      Text
"p2p" -> [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
"yamux" -> do
        more <- [Text] -> Either String [Protocol]
parseParts [Text]
rest
        Right (YamuxProto : 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)

    parseIPv4 :: Text -> Either String Word32
    parseIPv4 :: Text -> Either String Word32
parseIPv4 Text
t = case (Text -> Maybe Int) -> [Text] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe Int) -> (Text -> String) -> Text -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack) (HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"." Text
t) of
      [Just Int
a, Just Int
b, Just Int
c, Just Int
d]
        | (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Int
x -> Int
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= (Int
255 :: Int)) [Int
a, Int
b, Int
c, Int
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
$
              (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
                Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
                Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
c Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
                Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d
      [Maybe Int]
_ -> 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

    -- | 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

    parsePort :: Text -> Either String Word16
    parsePort :: Text -> Either String Word16
parsePort Text
t = case String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (Text -> String
T.unpack Text
t) of
      Just Int
n
        | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (Int
0 :: Int) Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
65535 -> Word16 -> Either String Word16
forall a b. b -> Either a b
Right (Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
      Maybe Int
_ -> 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

    -- | 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