-- | Multiaddr: self-describing, composable network addresses.
--
-- A multiaddr is a binary-encoded, composable network address that describes
-- the entire protocol stack needed to reach a peer.
module LibP2P.Multiaddr
  ( Multiaddr (..)
  , fromText
  , toText
  , fromBytes
  , toBytes
  , encapsulate
  , decapsulate
  , protocols
  , splitP2P
  ) where

import Data.ByteString (ByteString)
import Data.List (isPrefixOf, tails)
import Data.Text (Text)
import LibP2P.Crypto.PeerId (PeerId (..))
import LibP2P.Multiaddr.Codec
  ( decodeProtocols
  , encodeProtocols
  , protocolsToText
  , textToProtocols
  )
import LibP2P.Multiaddr.Protocol (Protocol (..))

-- | A multiaddr is a list of protocol components.
newtype Multiaddr = Multiaddr [Protocol]
  deriving (Int -> Multiaddr -> ShowS
[Multiaddr] -> ShowS
Multiaddr -> String
(Int -> Multiaddr -> ShowS)
-> (Multiaddr -> String)
-> ([Multiaddr] -> ShowS)
-> Show Multiaddr
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Multiaddr -> ShowS
showsPrec :: Int -> Multiaddr -> ShowS
$cshow :: Multiaddr -> String
show :: Multiaddr -> String
$cshowList :: [Multiaddr] -> ShowS
showList :: [Multiaddr] -> ShowS
Show, Multiaddr -> Multiaddr -> Bool
(Multiaddr -> Multiaddr -> Bool)
-> (Multiaddr -> Multiaddr -> Bool) -> Eq Multiaddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Multiaddr -> Multiaddr -> Bool
== :: Multiaddr -> Multiaddr -> Bool
$c/= :: Multiaddr -> Multiaddr -> Bool
/= :: Multiaddr -> Multiaddr -> Bool
Eq)

-- | Parse a multiaddr from its text representation (e.g. "/ip4/127.0.0.1/tcp/4001").
fromText :: Text -> Either String Multiaddr
fromText :: Text -> Either String Multiaddr
fromText Text
t = [Protocol] -> Multiaddr
Multiaddr ([Protocol] -> Multiaddr)
-> Either String [Protocol] -> Either String Multiaddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Either String [Protocol]
textToProtocols Text
t

-- | Render a multiaddr as text.
toText :: Multiaddr -> Text
toText :: Multiaddr -> Text
toText (Multiaddr [Protocol]
ps) = [Protocol] -> Text
protocolsToText [Protocol]
ps

-- | Parse a multiaddr from binary format.
fromBytes :: ByteString -> Either String Multiaddr
fromBytes :: ByteString -> Either String Multiaddr
fromBytes ByteString
bs = [Protocol] -> Multiaddr
Multiaddr ([Protocol] -> Multiaddr)
-> Either String [Protocol] -> Either String Multiaddr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String [Protocol]
decodeProtocols ByteString
bs

-- | Encode a multiaddr to binary format.
toBytes :: Multiaddr -> ByteString
toBytes :: Multiaddr -> ByteString
toBytes (Multiaddr [Protocol]
ps) = [Protocol] -> ByteString
encodeProtocols [Protocol]
ps

-- | Encapsulate: append another multiaddr's protocols.
encapsulate :: Multiaddr -> Multiaddr -> Multiaddr
encapsulate :: Multiaddr -> Multiaddr -> Multiaddr
encapsulate (Multiaddr [Protocol]
a) (Multiaddr [Protocol]
b) = [Protocol] -> Multiaddr
Multiaddr ([Protocol]
a [Protocol] -> [Protocol] -> [Protocol]
forall a. Semigroup a => a -> a -> a
<> [Protocol]
b)

-- | Decapsulate: remove the last occurrence of the given suffix multiaddr
-- and everything after it (specs/addressing). Returns the original
-- multiaddr unchanged when the suffix does not occur. Decapsulating the
-- empty multiaddr is a no-op, making 'decapsulate' a left inverse of
-- 'encapsulate': @decapsulate (encapsulate a b) b == a@ for non-empty b.
decapsulate :: Multiaddr -> Multiaddr -> Multiaddr
decapsulate :: Multiaddr -> Multiaddr -> Multiaddr
decapsulate ma :: Multiaddr
ma@(Multiaddr [Protocol]
a) (Multiaddr [Protocol]
b)
  | [Protocol] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Protocol]
b = Multiaddr
ma
  | Bool
otherwise =
      case [Int
i | (Int
i, [Protocol]
suffix) <- [Int] -> [[Protocol]] -> [(Int, [Protocol])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([Protocol] -> [[Protocol]]
forall a. [a] -> [[a]]
tails [Protocol]
a), [Protocol]
b [Protocol] -> [Protocol] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Protocol]
suffix] of
        [] -> Multiaddr
ma
        [Int]
matches -> [Protocol] -> Multiaddr
Multiaddr (Int -> [Protocol] -> [Protocol]
forall a. Int -> [a] -> [a]
take ([Int] -> Int
forall a. HasCallStack => [a] -> a
last [Int]
matches) [Protocol]
a)

-- | Get the list of protocols in a multiaddr.
protocols :: Multiaddr -> [Protocol]
protocols :: Multiaddr -> [Protocol]
protocols (Multiaddr [Protocol]
ps) = [Protocol]
ps

-- | Split off the trailing /p2p/<peerId> component from a multiaddr.
-- Returns the transport address and the peer ID, or Nothing if the
-- multiaddr does not end with a /p2p/ component.
splitP2P :: Multiaddr -> Maybe (Multiaddr, PeerId)
splitP2P :: Multiaddr -> Maybe (Multiaddr, PeerId)
splitP2P (Multiaddr [Protocol]
ps) = case [Protocol] -> [Protocol]
forall a. [a] -> [a]
reverse [Protocol]
ps of
  (P2P ByteString
mhBytes : [Protocol]
rest) -> (Multiaddr, PeerId) -> Maybe (Multiaddr, PeerId)
forall a. a -> Maybe a
Just ([Protocol] -> Multiaddr
Multiaddr ([Protocol] -> [Protocol]
forall a. [a] -> [a]
reverse [Protocol]
rest), ByteString -> PeerId
PeerId ByteString
mhBytes)
  [Protocol]
_ -> Maybe (Multiaddr, PeerId)
forall a. Maybe a
Nothing