diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,12 +1,13 @@ # hs-multiaddr +[![Hackage](http://img.shields.io/hackage/v/multiaddr.svg)](https://hackage.haskell.org/package/multiaddr) [![Build Status](https://travis-ci.org/micxjo/hs-multiaddr.svg?branch=master)](https://travis-ci.org/micxjo/hs-multiaddr) A [multiaddr](https://github.com/jbenet/multiaddr) implementation in Haskell. Multiaddr is a self-describing network address format supporting a variety of protocols, with both string and binary representations. ## Installation -Just clone and ``stack build``. Will be uploaded to Hackage soon! +We're on [Hackage](https://hackage.haskell.org/package/multiaddr), so just add ``multiaddr`` to your cabal build-depends. ## Usage diff --git a/multiaddr.cabal b/multiaddr.cabal --- a/multiaddr.cabal +++ b/multiaddr.cabal @@ -1,5 +1,5 @@ name: multiaddr -version: 0.1.0 +version: 0.2.0 cabal-version: >=1.10 build-type: Simple license: BSD3 @@ -31,7 +31,8 @@ hashable >=1.2.4.0 && <1.3, errors >=2.1.2 && <2.2, cereal >=0.5.1.0 && <0.6, - bytestring >=0.10.6.0 && <0.11 + bytestring >=0.10.6.0 && <0.11, + base58-bytestring >=0.1.0 && <0.2.0 default-language: Haskell2010 hs-source-dirs: src other-modules: @@ -43,7 +44,7 @@ main-is: test.hs build-depends: base >=4.7 && <5, - multiaddr >=0.1.0 && <0.2, + multiaddr >=0.2.0 && <0.3, tasty >=0.11.0.2 && <0.12, tasty-hunit >=0.9.2 && <0.10, tasty-quickcheck >=0.8.4 && <0.9, diff --git a/src/Network/Multiaddr.hs b/src/Network/Multiaddr.hs --- a/src/Network/Multiaddr.hs +++ b/src/Network/Multiaddr.hs @@ -2,6 +2,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE LambdaCase #-} {-| Module : Network.Multiaddr @@ -31,6 +32,8 @@ , hasIPv6 , hasUDP , hasTCP + , hasDCCP + , hasSCTP , hasIPFS -- * AddrPart type @@ -47,7 +50,7 @@ , fromPieces ) where -import Control.Applicative ((<|>), many) +import Control.Applicative (many) import Control.Monad (guard) import Data.Bits import Data.List (intersperse, scanl', elemIndex) @@ -61,6 +64,8 @@ import Data.Attoparsec.Text hiding (take) import Data.ByteString (ByteString) import qualified Data.ByteString as BS +import Data.ByteString.Base58 (encodeBase58, decodeBase58, + bitcoinAlphabet) import Data.Hashable (Hashable) import Data.Serialize (Serialize(..), Get, getBytes) import qualified Data.Serialize as Cereal @@ -210,9 +215,13 @@ | IPv6Part !IPv6 | UDPPart !Word16 | TCPPart !Word16 + | DCCPPart !Word16 + | SCTPPart !Word16 | IPFSPart !ByteString | UDTPart | UTPPart + | HTTPPart + | HTTPSPart deriving (Eq, Generic, Typeable) instance Hashable AddrPart @@ -222,12 +231,19 @@ put (IPv6Part ip) = put (41 :: Varint Word32) >> put ip put (UDPPart port) = put (17 :: Varint Word32) >> put port put (TCPPart port) = put (6 :: Varint Word32) >> put port + put (DCCPPart port) = put (33 :: Varint Word32) >> put port + put (SCTPPart port) = put (132 :: Varint Word32) >> put port put (IPFSPart addr) = do put (421 :: Varint Word32) - put (fromIntegral (BS.length addr) :: Varint Word64) - mapM_ put (BS.unpack addr) + case decodeBase58 bitcoinAlphabet addr of + Nothing -> fail "invalid base58" + Just bytes -> do + put (fromIntegral (BS.length bytes) :: Varint Word64) + mapM_ put (BS.unpack bytes) put UDTPart = put (301 :: Varint Word32) put UTPPart = put (302 :: Varint Word32) + put HTTPPart = put (480 :: Varint Word32) + put HTTPSPart = put (443 :: Varint Word32) get = do code <- get :: Get (Varint Word32) @@ -235,12 +251,18 @@ 4 -> IPv4Part <$> get 6 -> TCPPart <$> get 17 -> UDPPart <$> get + 33 -> DCCPPart <$> get 41 -> IPv6Part <$> get + 132 -> SCTPPart <$> get 421 -> do len <- get :: Get (Varint Word64) - IPFSPart <$> getBytes (fromIntegral len) + bytes <- getBytes (fromIntegral len) + let base58 = encodeBase58 bitcoinAlphabet bytes + pure (IPFSPart base58) 301 -> pure UDTPart 302 -> pure UTPPart + 480 -> pure HTTPPart + 443 -> pure HTTPSPart _ -> fail "invalid multiaddr code" -- | A network address. @@ -272,20 +294,32 @@ guard (port >= 0 && port <= 65535) pure (UDPPart (fromIntegral port)) +dccpPartP :: Parser AddrPart +dccpPartP = do + _ <- string "/dccp/" + port <- decimal :: Parser Integer + guard (port >= 0 && port <= 65535) + pure (DCCPPart (fromIntegral port)) + +sctpPartP :: Parser AddrPart +sctpPartP = do + _ <- string "/sctp/" + port <- decimal :: Parser Integer + guard (port >= 0 && port <= 65535) + pure (SCTPPart (fromIntegral port)) + udtPartP :: Parser AddrPart udtPartP = string "/udt" >> pure UDTPart utpPartP :: Parser AddrPart utpPartP = string "/utp" >> pure UTPPart -udpAddrP :: Parser Multiaddr -udpAddrP = do - udp <- udpPartP - sub <- option Nothing (Just <$> (udtPartP <|> utpPartP)) - pure $ case sub of - Nothing -> Multiaddr [udp] - Just sub' -> Multiaddr [udp, sub'] +httpPartP :: Parser AddrPart +httpPartP = string "/http" >> pure HTTPPart +httpsPartP :: Parser AddrPart +httpsPartP = string "/https" >> pure HTTPSPart + tcpPartP :: Parser AddrPart tcpPartP = do _ <- string "/tcp/" @@ -299,19 +333,21 @@ addr <- takeTill (== '/') pure (IPFSPart (T.encodeUtf8 addr)) -portAddrP :: Parser Multiaddr -portAddrP = udpAddrP <|> ((\t -> Multiaddr [t]) <$> tcpPartP) - -addrP :: Parser Multiaddr -addrP = do - ipPart <- ipv4PartP <|> ipv6PartP <|> ipfsPartP - port <- option Nothing (Just <$> portAddrP) - pure $ case port of - Nothing -> Multiaddr [ipPart] - Just port' -> Multiaddr [ipPart] <> port' - multiaddrP :: Parser Multiaddr -multiaddrP = mconcat <$> many' addrP +multiaddrP = do + _parts <- many' (choice [ ipv4PartP + , ipv6PartP + , ipfsPartP + , udpPartP + , tcpPartP + , dccpPartP + , sctpPartP + , udtPartP + , utpPartP + , httpPartP + , httpsPartP + ]) + pure Multiaddr{..} -- | Try to read a multiaddr in the standard text format -- (e.g. @"\/ip4\/8.8.8.8\/tcp\/80"@) @@ -323,9 +359,13 @@ addrPartB (IPv6Part ip) = fromText "/ip6/" <> ipv6B ip addrPartB (UDPPart port) = fromText "/udp/" <> Builder.decimal port addrPartB (TCPPart port) = fromText "/tcp/" <> Builder.decimal port +addrPartB (DCCPPart port) = fromText "/dccp/" <> Builder.decimal port +addrPartB (SCTPPart port) = fromText "/sctp/" <> Builder.decimal port addrPartB (IPFSPart addr) = fromText "/ipfs/" <> fromText (T.decodeUtf8 addr) addrPartB UDTPart = fromText "/udt" addrPartB UTPPart = fromText "/utp" +addrPartB HTTPPart = fromText "/http" +addrPartB HTTPSPart = fromText "/https" instance TextAddr AddrPart where toText = toStrict . toLazyText . addrPartB @@ -366,6 +406,14 @@ hasUDP :: Multiaddr -> Bool hasUDP (Multiaddr ps) = any (\case UDPPart _ -> True; _ -> False) ps +-- | Does the multiaddr contain a DCCP part? +hasDCCP :: Multiaddr -> Bool +hasDCCP (Multiaddr ps) = any (\case DCCPPart _ -> True; _ -> False) ps + +-- | Does the multiaddr contain an SCTP part? +hasSCTP :: Multiaddr -> Bool +hasSCTP (Multiaddr ps) = any (\case SCTPPart _ -> True; _ -> False) ps + -- | Does the multiaddr contain an IPFS part? hasIPFS :: Multiaddr -> Bool hasIPFS (Multiaddr ps) = any (\case IPFSPart _ -> True; _ -> False) ps @@ -382,6 +430,10 @@ protoName (IPv6Part _) = "ip6" protoName (UDPPart _) = "udp" protoName (TCPPart _) = "tcp" + protoName (DCCPPart _) = "dccp" + protoName (SCTPPart _) = "sctp" protoName (IPFSPart _) = "ipfs" protoName UDTPart = "udt" protoName UTPPart = "utp" + protoName HTTPPart = "http" + protoName HTTPSPart = "https" diff --git a/test/test.hs b/test/test.hs --- a/test/test.hs +++ b/test/test.hs @@ -92,6 +92,9 @@ [ "" , "/ip4/127.0.0.1" , "/ip4/127.0.0.1/tcp/80" + , "/ip4/127.0.0.1/http" + , "/ip4/127.0.0.1/dccp/49" + , "/ip4/127.0.0.1/sctp/49" , "/ip4/127.0.0.1/tcp/80/ip6/::1" , "/ip4/127.0.0.1/tcp/80/ip6/::1/udp/1234" , "/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC" @@ -105,6 +108,9 @@ in fromJust (decode (encode ma)) @?= ma) [ "" , "/ip4/127.0.0.1" + , "/ip4/127.0.0.1/http" + , "/ip4/127.0.0.1/dccp/49" + , "/ip4/127.0.0.1/sctp/49" , "/ip4/127.0.0.1/tcp/80" , "/ip4/127.0.0.1/tcp/80/ip6/::1" , "/ip4/127.0.0.1/tcp/80/ip6/::1/udp/1234" @@ -118,7 +124,10 @@ mapM_ (\(ma, ps) -> protocolNames (fromJust (readMultiaddr ma)) @?= ps) [ ("", []) , ("/ip4/127.0.0.1", ["ip4"]) + , ("/ip4/127.0.0.1/dccp/49", ["ip4", "dccp"]) + , ("/ip4/127.0.0.1/sctp/49", ["ip4", "sctp"]) , ("/ip4/127.0.0.1/tcp/80", ["ip4", "tcp"]) + , ("/ip4/127.0.0.1/http", ["ip4", "http"]) , ("/ip4/127.0.0.1/tcp/80/ip6/::1", ["ip4", "tcp", "ip6"]) , ("/ip4/127.0.0.1/tcp/80/ip6/::1/udp/1234", ["ip4", "tcp", "ip6", "udp"]) , ("/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC", ["ipfs"])