diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright CMCDragonkai (c) 2017 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of CMCDragonkai nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,17 @@ +Matrix Multi Address +========================= + +Here is an experiment to combine the haskell implementation of Multiaddress with the Haskell implementation of Multihash. + +Along the way, we must learn how stack works. + +-- Multiaddr is a record wrapping a list of MultiaddrParts +-- a Multiaddr here is a typed Multiaddr within Haskell +-- in the outside world, there are 2 kinds of Multiaddr +-- a textual human readable version +-- a binary encoded version +-- this library exposes the typed Multiaddr +-- while allowing Multiaddr to be created from +-- human readable text or binary encoded string + +There is any number of slashes. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hs-multiaddr.cabal b/hs-multiaddr.cabal new file mode 100644 --- /dev/null +++ b/hs-multiaddr.cabal @@ -0,0 +1,59 @@ +name: hs-multiaddr +version: 0.1.0.0 +synopsis: Multiaddr Library for LibP2P +description: Multiaddr is self-describing way to represent addresses that support any standard network protocol. + Multiaddr has a binary packed format, and nice string representation. + It is possible to encapsulate addresses within each other. +homepage: https://github.com/MatrixAI/haskell-multiaddr#readme +license: BSD3 +license-file: LICENSE +author: CMCDragonkai +maintainer: roger.qiu@matrix.ai +copyright: Copyright: (c) 2017 Roger Qiu +category: Data +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + hs-source-dirs: src + exposed-modules: Data.Multiaddr, + Data.MultiaddrPart, + Data.Multiaddr.IPFS, + Data.Multiaddr.VarInt + Data.Multiaddr.IPv4, + Data.Multiaddr.IPv6 + Data.Multiaddr.Onion, + Data.Multiaddr.Port, + Data.Multiaddr.UnixPath + build-depends: base >= 4.7 && < 4.9 + , bytestring + , text + , bytes + , sandi + , cereal + , iproute + , filepath + , multihash + , optparse-applicative >= 0.11 && < 0.12 + , io-streams >= 1.2 && < 1.3 + default-language: Haskell2010 + +test-suite haskell-multiaddr-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Spec.hs + build-depends: base + , hs-multiaddr + , hspec + , iproute + , sandi + , bytestring + , multihash + , either-unwrap + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/MatrixAI/haskell-multiaddr diff --git a/src/Data/Multiaddr.hs b/src/Data/Multiaddr.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.Multiaddr + ( + -- * As Multiaddr types + Multiaddr (..), + P.MultiaddrPart (..), + -- * As a string + toString, + toMultiaddr, + -- * As binary packed format + encode, + decode, + -- * Utilities + P.partHdrS, + P.partHdrB, + encapsulate, + decapsulate, + findFirstPart, + findLastPart, + findAllParts + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.MultiaddrPart as P + +import GHC.Generics (Generic) +import Data.Typeable (Typeable) +import Data.String (IsString, fromString) +import Control.Applicative (many, some) +import Data.Bytes.Get (runGetS) +import Data.Bytes.Put (runPutS) +import Data.Serialize.Get (Get) +import Data.List (isPrefixOf, find, filter) + +newtype Multiaddr = Multiaddr { parts :: [P.MultiaddrPart] } + deriving (Show, Eq, Monoid, Generic, Typeable) + +instance IsString Multiaddr where + fromString s = either error id $ toMultiaddr s + +toString :: Multiaddr -> String +toString (Multiaddr p) = concatMap P.toString p + +toMultiaddr :: String -> Either String Multiaddr +toMultiaddr s = + case Parser.readP_to_S (parse <* Parser.eof) s of + (m, ""):_ -> Right m + otherwise -> Left $ "Data.Multiaddr.toMultiaddr: invalid multiaddr " ++ show s + +parse :: Parser.ReadP Multiaddr +parse = do + multiParts <- some P.parse + many $ Parser.char '/' + return $ Multiaddr multiParts + +encode :: Multiaddr -> BSStrict.ByteString +encode (Multiaddr p) = BSStrict.concat . map P.encode $ p + +decode :: BSStrict.ByteString -> Either String Multiaddr +decode = runGetS $ parseB + +parseB :: Get Multiaddr +parseB = Multiaddr <$> some P.parseB + +-- first address encapsulates the second address +encapsulate :: Multiaddr -> Multiaddr -> Multiaddr +encapsulate m1 m2 = Multiaddr $ parts m1 ++ parts m2 + +-- first address is prefix removed from the second address +decapsulate :: Multiaddr -> Multiaddr -> Maybe Multiaddr +decapsulate (Multiaddr p1) (Multiaddr p2) + | isPrefixOf p1 p2 = Just . Multiaddr . drop (length p1) $ p2 + | otherwise = Nothing + +findFirstPart :: P.MultiaddrPart -> Multiaddr -> Maybe P.MultiaddrPart +findFirstPart p a = find (\p' -> P.partHdrB p' == pI) (parts a) + where + pI = P.partHdrB p + +findLastPart :: P.MultiaddrPart -> Multiaddr -> Maybe P.MultiaddrPart +findLastPart p a = go (\p' -> P.partHdrB p' == pI) (parts a) Nothing + where + pI = P.partHdrB p + go _ [] lastPart = lastPart + go pred (p:ps) lastPart + | pred p = go pred ps $ Just p + | otherwise = go pred ps lastPart + +findAllParts :: P.MultiaddrPart -> Multiaddr -> [P.MultiaddrPart] +findAllParts p a = filter (\p' -> P.partHdrB p' == pI) (parts a) + where + pI = P.partHdrB p diff --git a/src/Data/Multiaddr/IPFS.hs b/src/Data/Multiaddr/IPFS.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr/IPFS.hs @@ -0,0 +1,40 @@ +module Data.Multiaddr.IPFS + ( + MHD.MultihashDigest (..), + toString, + parse, + encode, + parseB + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.ByteString.Lazy as BSLazy +import qualified Data.ByteString.Lazy.Char8 as BSLazyChar +import qualified Data.Multiaddr.VarInt as VarInt +import qualified Data.Multihash.Digest as MHD +import qualified Data.Multihash.Base as MHB + +import Data.Serialize.Get (Get) + +toString :: MHD.MultihashDigest -> String +toString h = + BSLazyChar.unpack $ + MHB.encode MHB.Base58 + (BSLazy.fromStrict $ MHD.digest h) + +parse :: Parser.ReadP MHD.MultihashDigest +parse = do + multihashText <- Parser.munch1 (/= '/') + case ((MHB.decode MHB.Base58) (BSLazyChar.pack multihashText)) of + Right bs -> + case MHD.decode (BSLazyChar.toStrict bs) of + Right digest -> return digest + otherwise -> Parser.pfail + otherwise -> Parser.pfail + +encode :: MHD.MultihashDigest -> BSStrict.ByteString +encode h = VarInt.encodeWith $ MHD.digest h + +parseB :: Get MHD.MultihashDigest +parseB = VarInt.decodeSizeVar >>= (either fail return . MHD.decode) diff --git a/src/Data/Multiaddr/IPv4.hs b/src/Data/Multiaddr/IPv4.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr/IPv4.hs @@ -0,0 +1,29 @@ +module Data.Multiaddr.IPv4 + ( + IPv4 (..), + toString, + parse, + encode, + parseB + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.Multiaddr.VarInt as VarInt + +import Data.IP (IPv4 (..), fromIPv4, toIPv4) +import Data.Serialize.Get (Get) + +toString :: IPv4 -> String +toString = show + +parse :: Parser.ReadP IPv4 +parse = Parser.readS_to_P reads + +encode :: IPv4 -> BSStrict.ByteString +encode = BSStrict.pack . map fromIntegral . fromIPv4 + +parseB :: Get IPv4 +parseB = + fmap (toIPv4 . map fromIntegral . BSStrict.unpack) $ + VarInt.decodeSize 32 diff --git a/src/Data/Multiaddr/IPv6.hs b/src/Data/Multiaddr/IPv6.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr/IPv6.hs @@ -0,0 +1,29 @@ +module Data.Multiaddr.IPv6 + ( + IPv6 (..), + toString, + parse, + encode, + parseB + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.Multiaddr.VarInt as VarInt + +import Data.IP (IPv6 (..), fromIPv6b, toIPv6b) +import Data.Serialize.Get (Get) + +toString :: IPv6 -> String +toString = show + +parse :: Parser.ReadP IPv6 +parse = Parser.readS_to_P reads + +encode :: IPv6 -> BSStrict.ByteString +encode = BSStrict.pack . map fromIntegral . fromIPv6b + +parseB :: Get IPv6 +parseB = + fmap (toIPv6b . map fromIntegral . BSStrict.unpack) $ + VarInt.decodeSize 128 diff --git a/src/Data/Multiaddr/Onion.hs b/src/Data/Multiaddr/Onion.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr/Onion.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Data.Multiaddr.Onion + ( + Onion (..), + toString, + parse, + encode, + parseB + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.ByteString.Char8 as BSStrictChar +import qualified Codec.Binary.Base32 as Base32 +import qualified Data.Multiaddr.VarInt as VarInt +import qualified Data.Multiaddr.Port as Port + +import GHC.Generics (Generic) +import Data.Serialize.Get (Get) +import Data.Char (isAlphaNum, toUpper, toLower) + +data Onion = Onion + { + onionHash :: {-# UNPACK #-} !BSStrict.ByteString, + onionPort :: {-# UNPACK #-} !Port.Port + } + deriving (Show, Eq, Generic) + +toString :: Onion -> String +toString (Onion h p) = + hashToStr ++ ":" ++ portToStr + where + hashToStr = map toLower . BSStrictChar.unpack $ Base32.encode h + portToStr = Port.toString p + +parse :: Parser.ReadP Onion +parse = do + onionHash <- fmap + (BSStrictChar.pack . map toUpper) + (Parser.count 16 $ Parser.satisfy isAlphaNum) + case Base32.decode onionHash of + Right onionHashDecoded -> do + Parser.char ':' + onionPort <- Port.parse + if Port.port onionPort > 0 + then return $ Onion onionHashDecoded onionPort + else Parser.pfail + otherwise -> Parser.pfail + +encode :: Onion -> BSStrict.ByteString +encode (Onion h p) = BSStrict.append h $ Port.encode p + +parseB :: Get Onion +parseB = do + h <- VarInt.decodeSize 80 + p <- Port.parseB + return $ Onion h p diff --git a/src/Data/Multiaddr/Port.hs b/src/Data/Multiaddr/Port.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr/Port.hs @@ -0,0 +1,59 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Data.Multiaddr.Port + ( + Port (..), + toString, + parse, + encode, + parseB, + toPort, + fromPort + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.Multiaddr.VarInt as VarInt + +import GHC.Generics (Generic) +import Data.Word (Word16) +import Data.Char (isDigit) +import Data.Bytes.Get (runGetS) +import Data.Bytes.Put (runPutS) +import Data.Bytes.Serial (serialize, deserialize) +import Data.Serialize.Get (Get) + +newtype Port = Port + { + port :: Word16 + } + deriving (Show, Eq, Ord, Generic) + +toPort :: (Integral a, Eq a) => a -> Maybe Port +toPort n | n < 0 || n > 65535 = Nothing + | otherwise = Just $ Port (fromIntegral n) + +fromPort :: Integral a => Port -> a +fromPort p = fromIntegral (port p) + +toString :: Port -> String +toString (Port p) = show p + +parse :: Parser.ReadP Port +parse = do + port <- fmap read $ rangeParse (Parser.satisfy isDigit) 1 5 :: Parser.ReadP Int + case toPort port of + Just p -> return p + Nothing -> Parser.pfail + +rangeParse :: Read a => Parser.ReadP a -> Int -> Int -> Parser.ReadP [a] +rangeParse parse min max = foldr1 (Parser.<++) $ + fmap (\n -> Parser.count n $ parse) [max, max-1..min] + +encode :: Port -> BSStrict.ByteString +encode (Port p) = (runPutS . serialize) $ p + +parseB :: Get Port +parseB = + VarInt.decodeSize 16 >>= + (either fail (return . Port) . runGetS deserialize) diff --git a/src/Data/Multiaddr/UnixPath.hs b/src/Data/Multiaddr/UnixPath.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr/UnixPath.hs @@ -0,0 +1,37 @@ +{-# LANGUAGE DeriveGeneric #-} + +module Data.Multiaddr.UnixPath + ( + UnixPath (..), + toString, + parse, + encode, + parseB + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.ByteString.Char8 as BSStrictChar +import qualified Data.Multiaddr.VarInt as VarInt + +import GHC.Generics (Generic) +import System.FilePath (FilePath) +import Data.Serialize.Get (Get) + +newtype UnixPath = UnixPath { path :: FilePath } + deriving (Show, Eq, Ord, Generic) + +toString :: UnixPath -> String +toString (UnixPath p) = show p + +parse :: Parser.ReadP UnixPath +parse = do + path <- Parser.many1 Parser.get + return $ UnixPath $ "/" ++ path + +encode :: UnixPath -> BSStrict.ByteString +encode (UnixPath p) = VarInt.encodeWith $ BSStrictChar.pack p + +parseB :: Get UnixPath +parseB = fmap (UnixPath . BSStrictChar.unpack) $ VarInt.decodeSizeVar + diff --git a/src/Data/Multiaddr/VarInt.hs b/src/Data/Multiaddr/VarInt.hs new file mode 100644 --- /dev/null +++ b/src/Data/Multiaddr/VarInt.hs @@ -0,0 +1,33 @@ +module Data.Multiaddr.VarInt + ( + VarInt (..), + encode, + encodeWith, + decode, + decodeSize, + decodeSizeVar + ) where + +import qualified Data.ByteString as BSStrict + +import Data.Bytes.VarInt (VarInt (..)) +import Data.Bytes.Get (getByteString) +import Data.Bytes.Put (runPutS) +import Data.Bytes.Serial (serialize, deserialize) +import Data.Serialize.Get (Get) + +encode :: VarInt Int -> BSStrict.ByteString +encode = runPutS . serialize + +encodeWith :: BSStrict.ByteString -> BSStrict.ByteString +encodeWith b = + BSStrict.append ((encode . fromIntegral . BSStrict.length) b) b + +decode :: Get (VarInt Int) +decode = deserialize + +decodeSize :: Integral n => n -> Get BSStrict.ByteString +decodeSize n = getByteString $ fromIntegral $ div n 8 + +decodeSizeVar :: Get BSStrict.ByteString +decodeSizeVar = getByteString . fromIntegral =<< decode diff --git a/src/Data/MultiaddrPart.hs b/src/Data/MultiaddrPart.hs new file mode 100644 --- /dev/null +++ b/src/Data/MultiaddrPart.hs @@ -0,0 +1,175 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} + +module Data.MultiaddrPart + ( + MultiaddrPart (..), + toString, + parse, + encode, + parseB, + partHdrS, + partHdrB + ) where + +import qualified Text.ParserCombinators.ReadP as Parser +import qualified Data.ByteString as BSStrict +import qualified Data.Multiaddr.IPFS as IPFS +import qualified Data.Multiaddr.VarInt as VarInt +import qualified Data.Multiaddr.IPv4 as IPv4 +import qualified Data.Multiaddr.IPv6 as IPv6 +import qualified Data.Multiaddr.Port as Port +import qualified Data.Multiaddr.Onion as Onion +import qualified Data.Multiaddr.UnixPath as UnixPath + +import GHC.Generics (Generic) +import Data.Typeable (Typeable) +import Control.Applicative (some, (<|>)) +import Control.Monad (unless) +import Data.Serialize.Get (Get) + +data MultiaddrPart = IP4m { ip4m :: IPv4.IPv4 } + | IP6m { ip6m :: IPv6.IPv6 } + | TCPm { tcpm :: Port.Port } + | UDPm { udpm :: Port.Port } + | DCCPm { dccpm :: Port.Port } + | SCTPm { sctpm :: Port.Port } + | ONIONm { onionm :: Onion.Onion } + | IPFSm { ipfsm :: IPFS.MultihashDigest } + | P2Pm { p2pm :: IPFS.MultihashDigest } + | UNIXm { unixm :: UnixPath.UnixPath } + | UTPm + | UDTm + | QUICm + | HTTPm + | HTTPSm + | WSm + | WSSm + deriving (Show, Eq, Generic, Typeable) + +partHdrB :: MultiaddrPart -> VarInt.VarInt Int +partHdrB (IP4m _) = 4 +partHdrB (IP6m _) = 41 +partHdrB (TCPm _) = 6 +partHdrB (UDPm _) = 17 +partHdrB (DCCPm _) = 33 +partHdrB (SCTPm _) = 132 +partHdrB (ONIONm _) = 444 +partHdrB (IPFSm _) = 421 +partHdrB (P2Pm _) = 420 +partHdrB (UNIXm _) = 400 +partHdrB UTPm = 302 +partHdrB UDTm = 301 +partHdrB QUICm = 81 +partHdrB HTTPm = 480 +partHdrB HTTPSm = 443 +partHdrB WSm = 477 +partHdrB WSSm = 478 + +partHdrS :: MultiaddrPart -> String +partHdrS (IP4m _) = "ip4" +partHdrS (IP6m _) = "ip6" +partHdrS (TCPm _) = "tcp" +partHdrS (UDPm _) = "udp" +partHdrS (DCCPm _) = "dccp" +partHdrS (SCTPm _) = "sctp" +partHdrS (ONIONm _) = "onion" +partHdrS (IPFSm _) = "ipfs" +partHdrS (P2Pm _) = "p2p" +partHdrS (UNIXm _) = "unix" +partHdrS UTPm = "utp" +partHdrS UDTm = "udt" +partHdrS QUICm = "quic" +partHdrS HTTPm = "http" +partHdrS HTTPSm = "https" +partHdrS WSm = "ws" +partHdrS WSSm = "wss" + +toString :: MultiaddrPart -> String +toString p = concat ["/", partHdrS p, go p] + where + go (IP4m i) = "/" ++ IPv4.toString i + go (IP6m i) = "/" ++ IPv6.toString i + go (TCPm p) = "/" ++ Port.toString p + go (UDPm p) = "/" ++ Port.toString p + go (DCCPm p) = "/" ++ Port.toString p + go (SCTPm p) = "/" ++ Port.toString p + go (ONIONm o) = "/" ++ Onion.toString o + go (IPFSm h) = "/" ++ IPFS.toString h + go (P2Pm h) = "/" ++ IPFS.toString h + go (UNIXm p) = "/" ++ UnixPath.toString p + go UTPm = "" + go UDTm = "" + go QUICm = "" + go HTTPm = "" + go HTTPSm = "" + go WSm = "" + go WSSm = "" + +parse :: Parser.ReadP MultiaddrPart +parse = + (IP4m <$> (parseHdr (IP4m undefined) *> parseSep *> IPv4.parse)) <|> + (IP6m <$> (parseHdr (IP6m undefined) *> parseSep *> IPv6.parse)) <|> + (TCPm <$> (parseHdr (TCPm undefined) *> parseSep *> Port.parse)) <|> + (UDPm <$> (parseHdr (UDPm undefined) *> parseSep *> Port.parse)) <|> + (DCCPm <$> (parseHdr (DCCPm undefined) *> parseSep *> Port.parse)) <|> + (SCTPm <$> (parseHdr (SCTPm undefined) *> parseSep *> Port.parse)) <|> + (ONIONm <$> (parseHdr (ONIONm undefined) *> parseSep *> Onion.parse)) <|> + (IPFSm <$> (parseHdr (IPFSm undefined) *> parseSep *> IPFS.parse)) <|> + (P2Pm <$> (parseHdr (P2Pm undefined) *> parseSep *> IPFS.parse)) <|> + (UNIXm <$> (parseHdr (UNIXm undefined) *> parseSep *> UnixPath.parse)) <|> + (parseHdr UTPm) <|> + (parseHdr UDTm) <|> + (parseHdr QUICm) <|> + (parseHdr HTTPm) <|> + (parseHdr HTTPSm) <|> + (parseHdr WSm) <|> + (parseHdr WSSm) + where + parseHdr c = c <$ (parseSep *> Parser.string (partHdrS c)) + parseSep = some $ Parser.char '/' + +encode :: MultiaddrPart -> BSStrict.ByteString +encode p = BSStrict.append (VarInt.encode $ partHdrB p) (go p) + where + go (IP4m i) = IPv4.encode i + go (IP6m i) = IPv6.encode i + go (TCPm p) = Port.encode p + go (UDPm p) = Port.encode p + go (DCCPm p) = Port.encode p + go (SCTPm p) = Port.encode p + go (ONIONm o) = Onion.encode o + go (IPFSm h) = IPFS.encode h + go (P2Pm h) = IPFS.encode h + go (UNIXm p) = UnixPath.encode p + go UTPm = BSStrict.empty + go UDTm = BSStrict.empty + go QUICm = BSStrict.empty + go HTTPm = BSStrict.empty + go HTTPSm = BSStrict.empty + go WSm = BSStrict.empty + go WSSm = BSStrict.empty + +parseB :: Get MultiaddrPart +parseB = + (IP4m <$> (parseHdrB (IP4m undefined) *> IPv4.parseB)) <|> + (IP6m <$> (parseHdrB (IP6m undefined) *> IPv6.parseB)) <|> + (TCPm <$> (parseHdrB (TCPm undefined) *> Port.parseB)) <|> + (UDPm <$> (parseHdrB (UDPm undefined) *> Port.parseB)) <|> + (DCCPm <$> (parseHdrB (DCCPm undefined) *> Port.parseB)) <|> + (SCTPm <$> (parseHdrB (SCTPm undefined) *> Port.parseB)) <|> + (ONIONm <$> (parseHdrB (ONIONm undefined) *> Onion.parseB)) <|> + (IPFSm <$> (parseHdrB (IPFSm undefined) *> IPFS.parseB)) <|> + (P2Pm <$> (parseHdrB (P2Pm undefined) *> IPFS.parseB)) <|> + (UNIXm <$> (parseHdrB (UNIXm undefined) *> UnixPath.parseB)) <|> + (parseHdrB UTPm) <|> + (parseHdrB UDTm) <|> + (parseHdrB QUICm) <|> + (parseHdrB HTTPm) <|> + (parseHdrB HTTPSm) <|> + (parseHdrB WSm) <|> + (parseHdrB WSSm) + where + parseHdrB c = c <$ do + i <- VarInt.decode + unless (i == partHdrB c) $ fail "Wrong protocol index" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,259 @@ +{-# LANGUAGE OverloadedStrings #-} + +import qualified Data.ByteString as BSStrict +import qualified Data.ByteString.Char8 as BSStrictChar +import qualified Data.ByteString.Lazy.Char8 as BSLazyChar +import qualified Codec.Binary.Base32 as Base32 +import qualified Data.Multihash.Digest as MHD +import qualified Data.Multihash.Base as MHB + +import Data.IP (IPv4, IPv6, fromIPv4, fromIPv6, toIPv4, toIPv6) +import Data.Maybe (fromJust) +import Data.Char (toUpper) +import Data.Either.Unwrap (fromRight) +import Control.Exception (evaluate) +import Data.Either (isLeft, isRight) + +import Test.Hspec +import Data.Multiaddr +import Data.Multiaddr.Onion (Onion (..)) +import Data.Multiaddr.UnixPath (UnixPath (..)) +import Data.Multiaddr.Port (toPort) + +parseFail str = it ("should not parse `" ++ str ++ "`") $ do + (toMultiaddr str) `shouldSatisfy` isLeft + +parseSucceed str addr = it ("should parse `" ++ str ++ "`") $ do + (toMultiaddr str) `shouldBe` Right addr + +parseEqual str1 str2 = it ("should be equal `" ++ str1 ++ "` == `" ++ str2) $ do + (toMultiaddr str1) `shouldBe` (toMultiaddr str2) + +parseNotEqual str1 str2 = it ("should not be equal `" ++ str1 ++ "` /= `" ++ str2) $ do + (toMultiaddr str1) `shouldNotBe` (toMultiaddr str2) + +encodeSucceed str bs = it ("should encode `" ++ str ++ "` to `" ++ show bs ++ "`") $ do + (fmap encode $ toMultiaddr str) `shouldBe` (Right $ BSStrict.pack bs) + +decodeSucceed bs str = it ("should decode `" ++ show bs ++ "` to `" ++ str ++ "`") $ do + (decode $ BSStrict.pack bs) `shouldBe` (toMultiaddr str) + +encapsulateSucceed addr1 addr2 addr3 = it ("should encapsulate `" ++ toString addr2 ++ "` onto `" ++ toString addr1 ++ "`") $ do + (encapsulate addr1 addr2) `shouldBe` addr3 + +decapsulateSucceed addr1 addr2 addr3 = it ("should decapsulate `" ++ toString addr1 ++ "` from `" ++ toString addr2 ++ "`") $ do + (decapsulate addr1 addr2) `shouldBe` Just addr3 + +findFirstSucceed part1 part2 addr = it ("should find first `" ++ show part2 ++ "` in `" ++ toString addr) $ do + (findFirstPart part1 addr) `shouldBe` Just part2 + +toIPFSm hash = IPFSm + $ fromRight + $ MHD.decode + $ BSLazyChar.toStrict + $ fromRight + $ MHB.decode MHB.Base58 + $ BSLazyChar.pack hash + +toP2Pm hash = P2Pm + $ fromRight + $ MHD.decode + $ BSLazyChar.toStrict + $ fromRight + $ MHB.decode MHB.Base58 + $ BSLazyChar.pack hash + +toONIONm hash port = ONIONm $ + Onion + (fromRight $ + Base32.decode $ + BSStrictChar.pack $ map toUpper hash) + (fromJust $ toPort port) + +main :: IO () +main = hspec $ do + describe "Multiaddr read" $ do + parseFail "/ip4" + parseFail "/ip4::1" + parseFail "/ip4/fdpsofodsajfdoisa" + parseFail "/ip6" + parseFail "/udp" + parseFail "/tcp" + parseFail "/sctp" + parseFail "/udp/65536" + parseFail "/tcp/65536" + parseFail "/quic/65536" + parseFail "/onion/9imaq4ygg2iegci7:80" + parseFail "/onion/aaimaq4ygg2iegci7:80" + parseFail "/onion/timaq4ygg2iegci7:0" + parseFail "/onion/timaq4ygg2iegci7:-1" + parseFail "/onion/timaq4ygg2iegci7" + parseFail "/onion/timaq4ygg2iegci@:666" + parseFail "/udp/1234/sctp" + parseFail "/udp/1234/udt/1234" + parseFail "/udp/1234/utp/1234" + parseFail "/ip4/127.0.0.1/udp/jfodsajfidosajfoidsa" + parseFail "/ip4/127.0.0.1/udp" + parseFail "/ip4/127.0.0.1/tcp/jfodsajfidosajfoidsa" + parseFail "/ip4/127.0.0.1/tcp" + parseFail "/ip4/127.0.0.1/quic/1234" + parseFail "/ip4/127.0.0.1/ipfs" + parseFail "/ip4/127.0.0.1/ipfs/tcp" + parseFail "/unix" + parseFail "/ip4/1.2.3.4/tcp/80/unix" + parseSucceed "/ip4/1.2.3.4" $ Multiaddr [(IP4m $ toIPv4 [1,2,3,4])] + parseSucceed "/ip4/0.0.0.0" $ Multiaddr [(IP4m $ toIPv4 [0,0,0,0])] + parseSucceed "/ip4/0.0.0.0//////" $ Multiaddr [(IP4m $ toIPv4 [0,0,0,0])] + parseSucceed "/ip6/::1" $ Multiaddr [(IP6m $ toIPv6 [0,0,0,0,0,0,0,1])] + parseSucceed "/ip6/2601:9:4f81:9700:803e:ca65:66e8:c21" $ + Multiaddr + [ + (IP6m $ toIPv6 + [0x2601, 0x9, 0x4f81, 0x9700, 0x803e, 0xca65, 0x66e8, 0xc21]) + ] + parseSucceed "/ip6/2601:9:4f81:9700:803e:ca65:66e8:c21/udp/1234/quic" $ + Multiaddr + [ + (IP6m $ toIPv6 + [0x2601, 0x9, 0x4f81, 0x9700, 0x803e, 0xca65, 0x66e8, 0xc21]), + (UDPm $ fromJust $ toPort 1234), + (QUICm) + ] + parseSucceed "/onion/timaq4ygg2iegci7:1234" $ + Multiaddr [(toONIONm "timaq4ygg2iegci7" 1234)] + parseSucceed "/onion/timaq4ygg2iegci7:80/http" $ + Multiaddr + [ + (toONIONm "timaq4ygg2iegci7" 80), + (HTTPm) + ] + parseSucceed "/udp/0" $ + Multiaddr [(UDPm $ fromJust $ toPort 0)] + parseSucceed "/tcp/0" $ + Multiaddr [(TCPm $ fromJust $ toPort 0)] + parseSucceed "/sctp/0" $ + Multiaddr [(SCTPm $ fromJust $ toPort 0)] + parseSucceed "/udp/1234" $ + Multiaddr [(UDPm $ fromJust $ toPort 1234)] + parseSucceed "/tcp/1234" $ + Multiaddr [(TCPm $ fromJust $ toPort 1234)] + parseSucceed "/tcp/1234////" $ + Multiaddr [(TCPm $ fromJust $ toPort 1234)] + parseSucceed "/udp/65535" $ + Multiaddr [(UDPm $ fromJust $ toPort 65535)] + parseSucceed "/tcp/65535" $ + Multiaddr [(TCPm $ fromJust $ toPort 65535)] + parseSucceed "/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC" $ + Multiaddr [(toIPFSm "QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC")] + parseSucceed "/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC////" $ + Multiaddr [(toIPFSm "QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC")] + parseSucceed "/udp/1234/sctp/1234" $ + Multiaddr [(UDPm $ fromJust $ toPort 1234), (SCTPm $ fromJust $ toPort 1234)] + parseSucceed "/udp/1234/udt" $ + Multiaddr [(UDPm $ fromJust $ toPort 1234), UDTm] + parseSucceed "/udp/1234/utp" $ + Multiaddr [(UDPm $ fromJust $ toPort 1234), UTPm] + parseSucceed "/tcp/1234/http" $ + Multiaddr [(TCPm $ fromJust $ toPort 1234), HTTPm] + parseSucceed "/tcp/1234/https" $ + Multiaddr [(TCPm $ fromJust $ toPort 1234), HTTPSm] + parseSucceed "/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC/tcp/1234" $ + Multiaddr + [ + (toIPFSm "QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC"), + (TCPm $ fromJust $ toPort 1234) + ] + parseSucceed "/ip4/127.0.0.1/udp/1234" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (UDPm $ fromJust $ toPort 1234) + ] + parseSucceed "/ip4/127.0.0.1/udp/0" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (UDPm $ fromJust $ toPort 0) + ] + parseSucceed "/ip4/127.0.0.1/tcp/1234" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (TCPm $ fromJust $ toPort 1234) + ] + parseSucceed "/ip4/127.0.0.1/tcp/1234/" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (TCPm $ fromJust $ toPort 1234) + ] + parseSucceed "/ip4/127.0.0.1/udp/1234/quic" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (UDPm $ fromJust $ toPort 1234), + (QUICm) + ] + parseSucceed "/ip4/127.0.0.1/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (toIPFSm "QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC") + ] + parseSucceed "/ip4/127.0.0.1/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC/tcp/1234" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (toIPFSm "QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC"), + (TCPm $ fromJust $ toPort 1234) + ] + parseSucceed "/unix/a/b/c/d/e" $ + Multiaddr [(UNIXm $ UnixPath "/a/b/c/d/e")] + parseSucceed "/unix/a/b/c/d/e/" $ + Multiaddr [(UNIXm $ UnixPath "/a/b/c/d/e")] + parseSucceed "/unix/stdio///////" $ + Multiaddr [(UNIXm $ UnixPath "/stdio")] + parseSucceed "/unix/stdio////a/b/c/d/e/f////" $ + Multiaddr [(UNIXm $ UnixPath "/stdio////a/b/c/d/e/f")] + parseSucceed "/ip4/1.2.3.4/tcp/80/unix/a/b/c/d/e/f" $ + Multiaddr + [ + (IP4m $ toIPv4 [1,2,3,4]), + (TCPm $ fromJust $ toPort 80), + (UNIXm $ UnixPath "/a/b/c/d/e/f") + ] + parseSucceed "/ip4/127.0.0.1/ipfs/QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC/tcp/1234/unix/stdio" $ + Multiaddr + [ + (IP4m $ toIPv4 [127,0,0,1]), + (toIPFSm "QmcgpsyWgH8Y8ajJz1Cu72KnS5uo2Aa2LpzU7kinSupNKC"), + (TCPm $ fromJust $ toPort 1234), + (UNIXm $ UnixPath "/stdio") + ] + describe "Multiaddr equal" $ do + parseEqual "/ip4/127.0.0.1/tcp/1234" "/ip4/127.0.0.1/tcp/1234/" + parseNotEqual "/ip4/127.0.0.1/udp/1234" "/ip4/127.0.0.1/tcp/1234" + describe "Multiaddr encode" $ do + encodeSucceed "/ip4/127.0.0.1/udp/1234" [4, 127, 0, 0, 1, 17, 4, 210] + encodeSucceed "/ip4/127.0.0.1/tcp/4321" [4, 127, 0, 0, 1, 6, 16, 225] + encodeSucceed "/ip4/127.0.0.1/udp/1234/ip4/127.0.0.1/tcp/4321" [4, 127, 0, 0, 1, 17, 4, 210, 4, 127, 0, 0, 1, 6, 16, 225] + describe "Multiaddr decode" $ do + decodeSucceed [4, 127, 0, 0, 1, 17, 4, 210] "/ip4/127.0.0.1/udp/1234" + decodeSucceed [4, 127, 0, 0, 1, 6, 16, 225] "/ip4/127.0.0.1/tcp/4321" + decodeSucceed [4, 127, 0, 0, 1, 17, 4, 210, 4, 127, 0, 0, 1, 6, 16, 225] "/ip4/127.0.0.1/udp/1234/ip4/127.0.0.1/tcp/4321" + decodeSucceed [188, 3, 0, 16, 192, 67, 152, 49, 180, 130, 24, 72, 0, 80] "/onion/aaimaq4ygg2iegci:80" + describe "Multiaddr encapsulate" $ do + encapsulateSucceed + ("/ip4/127.0.0.1" :: Multiaddr) + ("/udp/1234" :: Multiaddr) + ("/ip4/127.0.0.1/udp/1234" :: Multiaddr) + describe "Multiaddr decapsulate" $ do + decapsulateSucceed + ("/udp/5678" :: Multiaddr) + ("/udp/5678/ip4/127.0.0.1/udp/1234" :: Multiaddr) + ("/ip4/127.0.0.1/udp/1234" :: Multiaddr) + describe "Multiaddr find" $ do + findFirstSucceed + (IP4m undefined) + (IP4m $ toIPv4 [127, 0, 0, 1]) + ("/ip4/127.0.0.1/utp/tcp/5555/udp/1234/utp/ipfs/QmbHVEEepCi7rn7VL7Exxpd2Ci9NNB6ifvqwhsrbRMgQFP" :: Multiaddr)