network-anonymous-i2p (empty) → 0.9.0
raw patch · 18 files changed
+1870/−0 lines, 18 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, exceptions, hspec, hspec-attoparsec, hspec-expectations, mtl, network, network-anonymous-i2p, network-attoparsec, network-simple, text, transformers, uuid
Files
- LICENSE +22/−0
- README.md +9/−0
- Setup.hs +3/−0
- network-anonymous-i2p.cabal +101/−0
- src/Network/Anonymous/I2P.hs +298/−0
- src/Network/Anonymous/I2P/Error.hs +88/−0
- src/Network/Anonymous/I2P/Internal/Debug.hs +16/−0
- src/Network/Anonymous/I2P/Protocol.hs +350/−0
- src/Network/Anonymous/I2P/Protocol/Parser.hs +115/−0
- src/Network/Anonymous/I2P/Protocol/Parser/Ast.hs +53/−0
- src/Network/Anonymous/I2P/Types/Destination.hs +76/−0
- src/Network/Anonymous/I2P/Types/Session.hs +16/−0
- src/Network/Anonymous/I2P/Types/Socket.hs +32/−0
- test/Main.hs +10/−0
- test/Network/Anonymous/I2P/Protocol/ParserSpec.hs +200/−0
- test/Network/Anonymous/I2P/ProtocolSpec.hs +473/−0
- test/Network/Anonymous/I2P/Util.hs +7/−0
- test/Spec.hs +1/−0
+ LICENSE view
@@ -0,0 +1,22 @@+The MIT License (MIT) + +Copyright (c) 2015 Leon Mergen + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. +
+ README.md view
@@ -0,0 +1,9 @@+network-anonymous-i2p +===================== + +[](https://travis-ci.org/solatis/haskell-network-anonymous-i2p) +[](https://coveralls.io/r/solatis/haskell-network-anonymous-i2p?branch=master) +[](http://en.wikipedia.org/wiki/MIT_License) +[](http://haskell.org) + +network-anonymous-i2p is a Haskell API for I2P anonymous networking
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple + +main = defaultMain
+ network-anonymous-i2p.cabal view
@@ -0,0 +1,101 @@+name: network-anonymous-i2p +category: Network +version: 0.9.0 +description: Haskell API for I2P anonymous networking + +license: MIT +license-file: LICENSE +copyright: (c) 2014 Leon Mergen +author: Leon Mergen +maintainer: leon@solatis.com +stability: experimental +synopsis: Haskell API for I2P anonymous networking +build-type: Simple +data-files: LICENSE, README.md +cabal-version: >= 1.10 +tested-with: GHC == 7.8, GHC == 7.10 + +flag debug + description: Enable debug support + default: False + +flag eventlog + description: Enable the eventlog, useful for profiling + default: False + +library + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall -ferror-spans -auto-all -caf-all + + if impl(ghc >= 6.13.0) + ghc-options: -rtsopts + + if flag(eventlog) + ghc-options: -eventlog + + if flag(debug) + cpp-options: -DDEBUG + + exposed-modules: Network.Anonymous.I2P + Network.Anonymous.I2P.Error + Network.Anonymous.I2P.Types.Destination + Network.Anonymous.I2P.Types.Session + Network.Anonymous.I2P.Types.Socket + Network.Anonymous.I2P.Protocol + Network.Anonymous.I2P.Protocol.Parser + Network.Anonymous.I2P.Protocol.Parser.Ast + Network.Anonymous.I2P.Internal.Debug + + build-depends: base >= 4.3 && < 5 + + , network + , network-simple + , attoparsec + , network-attoparsec + , exceptions + + , text + , bytestring + , uuid + + , transformers + , mtl + +test-suite test-suite + type: exitcode-stdio-1.0 + default-language: Haskell2010 + hs-source-dirs: test + main-is: Main.hs + ghc-options: -Wall -ferror-spans -threaded -auto-all -caf-all -fno-warn-type-defaults + + other-modules: Network.Anonymous.I2P.Util + Network.Anonymous.I2P.ProtocolSpec + Network.Anonymous.I2P.Protocol.ParserSpec + Spec + Main + + if flag(debug) + cpp-options: -DDEBUG + + build-depends: base >= 4.3 && < 5 + , exceptions + , mtl + , transformers + + , attoparsec + , bytestring + , uuid + , network + , network-simple + + , hspec + , hspec-expectations + , hspec-attoparsec + + , network-anonymous-i2p + +source-repository head + type: git + location: git://github.com/solatis/haskell-network-anonymous-i2p.git + branch: master
+ src/Network/Anonymous/I2P.hs view
@@ -0,0 +1,298 @@+{-# LANGUAGE FlexibleContexts #-} + +-- | This module provides the main interface for establishing secure and +-- anonymous connections with other hosts on the interface using the +-- Invisible Internet Project (I2P). For more information about the I2P +-- network, see: <https://www.geti2p.net/ geti2p.net> +-- +module Network.Anonymous.I2P ( + -- * Introduction to I2P + -- $i2p-introduction + + -- * Client side + -- $i2p-client + + -- * Server side + -- $i2p-server + + -- ** Setting up the context + createDestination + , withSession + , withSession' + + -- ** Virtual streams + , connectStream + , serveStream + + -- ** Datagrams + , serveDatagram + , sendDatagram) where + +import Control.Concurrent (forkIO) +import Control.Concurrent.MVar +import Control.Monad (forever) +import Control.Monad.Catch +import Control.Monad.IO.Class + +import qualified Data.ByteString as BS +import qualified Network.Socket as Network + +import qualified Network.Anonymous.I2P.Protocol as P +import qualified Network.Anonymous.I2P.Types.Destination as D +import qualified Network.Anonymous.I2P.Types.Session as S +import qualified Network.Anonymous.I2P.Types.Socket as S + +-------------------------------------------------------------------------------- +-- $i2p-introduction +-- +-- This module is an implementation of the SAMv3 protocol for I2P. I2P is an +-- internet anonimization network, similar to Tor. Whereas Tor is intended for +-- privately using the internet, I2P is more application oriented, and is intended +-- for private communication between applications. +-- +-- The general idea of the SAM interface to I2P is that you establish a master +-- connection with the SAM bridge, and create new, short-lived connections with +-- the SAM bridge for the communication with the individual peers. +-- +-- I2P provides three different ways of communicating with other hosts: +-- +-- * __Virtual Streams__: the closest thing to reliable TCP sockets that I2P +-- brings, and allows you to start a server, accept connections and establish +-- connections with remote servers. +-- +-- * __Repliable Datagrams__: unreliable delivery of messages to a remote host, +-- but adds a reply-to address to the message so the remote host can send a +-- message back. +-- +-- * __Anonymous Datagrams__: unreliable delivery of messages to a remote host, +-- and the remote host has no way to find out who sent the message. +-- +-- Different methods of communication have different performance characteristics, +-- and an application developer should take these into careful consideration when +-- developing an application. +-- +-------------------------------------------------------------------------------- +-- $i2p-client +-- +-- == Virtual Stream +-- Establishing a 'S.VirtualStream' connection with a remote works as follows: +-- +-- @ +-- main = 'withSession' 'S.VirtualStream' withinSession +-- +-- where +-- dest :: 'D.PublicDestination' +-- dest = undefined +-- +-- withinSession -> 'S.Context' -> IO () +-- withinSession ctx = connectStream ctx dest worker +-- +-- worker (sock, addr) = do +-- -- Now you may use sock to communicate with the remote; addr contains +-- -- the address of the remote we are connected to, which on our case +-- -- should match dest. +-- return () +-- @ +-- +-- == Datagram +-- Sending a 'S.DatagramRepliable' message to a remote: +-- +-- @ +-- main = 'withSession' 'S.DatagramRepliable' withinSession +-- +-- where +-- dest :: 'D.PublicDestination' +-- dest = undefined +-- +-- withinSession -> 'S.Context' -> IO () +-- withinSession ctx = do +-- sendDatagram ctx dest \"Hello, anonymous world!\" +-- +-- -- SAM requires the master connection of a session to be alive longer +-- -- than any opertions that occur on the session are. Since sending a +-- -- datagram returns before the datagram might be actually handled by +-- -- I2P, it is adviced to wait a little while before closing the session. +-- threadDelay 1000000 +-- @ +-- +-------------------------------------------------------------------------------- +-- $i2p-server +-- +-- == Virtual Stream +-- Running a server that accepts 'S.VirtualStream' connections. +-- +-- @ +-- main = 'withSession' 'S.VirtualStream' withinSession +-- +-- where +-- withinSession -> 'S.Context' -> IO () +-- withinSession ctx = serveStream ctx worker +-- +-- worker (sock, addr) = do +-- -- Now you may use sock to communicate with the remote; addr contains +-- -- the address of the remote we are connected to, which we might want +-- -- to store to send back messages asynchronously. +-- return () +-- @ +-- +-- == Datagram +-- Receiving a 'S.DatagramAnonymous' messages from remotes: +-- +-- @ +-- main = 'withSession' 'S.DatagramAnonymous' withinSession +-- +-- where +-- withinSession -> 'S.Context' -> IO () +-- withinSession ctx = +-- serveDatagram ctx worker +-- +-- worker (sock, addr) = do +-- -- Now you may use sock to communicate with the remote; addr is an +-- -- instance of the 'Maybe' monad, and since we only accept anonymous +-- -- messages, should always be 'Nothing'. +-- return () +-- @ +-------------------------------------------------------------------------------- + +-- | Create a new I2P destination endpoint. +-- +-- All communication in I2P starts with having our own host endpoint +-- other people can use to communicate with us. This destination consists +-- of a public and a private part: the 'D.PrivateDestination' you can use +-- to accept connections / messages from other people, the 'D.PublicDestination' +-- you can give out to other people to send messages to you. +-- +-- __Warning__: Never give out your 'D.PrivateDestination' to other people. It +-- contains your private key, and could be used by other people +-- to effectively MITM you. Use your 'D.PublicDestination' to announce +-- the address other people can connect to. +createDestination :: ( MonadIO m + , MonadMask m) + => Maybe D.SignatureType -- ^ Algorithm to use for signature encryption. As per I2P spec defaults to DSA_SHA1. + -> m (D.PrivateDestination, D.PublicDestination) -- ^ The private and public destinations. +createDestination signatureType = + P.connect "127.0.0.1" "7656" (\(sock, _) -> do + _ <- P.version sock + P.createDestination signatureType sock) + + +-- | Starts a new I2P session. A connection with the SAM bridge will be +-- established, and a 'S.Context' object will be created and passed to the +-- callback. This context object is then required for all further operations. +-- +-- After the callback computation finishes, all acquired resources will be +-- properly closed. +withSession :: ( MonadIO m + , MonadMask m) + => S.SocketType -- ^ The type of socket we will be using. + -> (S.Context -> m a) -- ^ The computation to run + -> m a +withSession socketType callback = do + destPair <- createDestination Nothing + withSession' socketType destPair callback + +-- | Alternative implementation of 'withSession' that explicitly accepts a +-- 'D.Destination' pair to use to set up the session. This can be useful +-- if you want to use a specific 'D.SignatureType' to create a local +-- endpoint. +withSession' :: ( MonadIO m + , MonadMask m) + => S.SocketType -- ^ The type of socket we will be using. + -> (D.PrivateDestination, D.PublicDestination) -- ^ Destination to use + -> (S.Context -> m a) -- ^ The computation to run + -> m a +withSession' socketType (privDest, pubDest) callback = + let bindSession (sock, _) = do + _ <- P.version sock + sessionId <- P.createSessionWith Nothing privDest socketType sock + + callback (S.Context sock socketType sessionId privDest pubDest) + + in P.connect "127.0.0.1" "7656" bindSession + +-- | Starts a server to accept 'S.VirtualStream' connections from other hosts +-- and handles them concurrently in different threads. Any acquired resources +-- are cleaned up when the computation ends. +serveStream :: ( MonadIO m + , MonadMask m) + => S.Context + -> ((Network.Socket, D.PublicDestination) -> IO ()) + -> m () +serveStream (S.Context _ _ sessionId _ _) callback = + let acceptNext accepted' (sock, _) = do + _ <- P.version sock + (incomingSock, incomingDest) <- P.acceptStream sessionId sock + putMVar accepted' True + callback (incomingSock, incomingDest) + + acceptFork = liftIO $ do + accepted' <- newEmptyMVar + _ <- forkIO $ P.connect "127.0.0.1" "7656" (acceptNext accepted') + + -- This blocks until an actual connection is accepted, so we ensure there + -- is always just one thread waiting for a new connection. + _ <- takeMVar accepted' + return () + + in forever acceptFork + +-- | Starts a server to accept 'S.DatagramAnonymous' or 'D.DatagramRepliable' +-- connections from other hosts and handles them concurrently in different +-- threads. Any acquired resources are cleaned up when the computation ends. +serveDatagram :: ( MonadIO m + , MonadMask m) + => S.Context + -> ((BS.ByteString, Maybe D.PublicDestination) -> IO ()) + -> m () +serveDatagram (S.Context sock _ _ _ _) callback = + let receiveNext received' = do + res <- P.receiveDatagram sock + putMVar received' True + callback res + + receiveFork = liftIO $ do + received' <- newEmptyMVar + _ <- forkIO $ receiveNext received' + + -- This blocks until an actual datagram is received, so we ensure there + -- is always just one thread waiting for a new connection. + _ <- takeMVar received' + return () + + in forever receiveFork + +-- | Connects to a remote 'S.VirtualStream' host. Any acquired resources are +-- cleaned up when the computation ends. Automatically creates a local return +-- destination required for bi-directional communication. +connectStream :: ( MonadIO m + , MonadMask m) + => S.Context -- ^ Our state + -> D.PublicDestination -- ^ Destination to connect to. + -> ((Network.Socket, D.PublicDestination) -> IO ()) -- ^ Computation to run once connection has been established. + -> m () +connectStream (S.Context _ _ sessionId _ _) remoteDestination callback = + let connectAddress (sock, _) = do + -- Connect to the remote destination within our session. + _ <- P.version sock + _ <- P.connectStream sessionId remoteDestination sock + + -- Any data that is transmitted through the socket at this point is between + -- the 'localDestination' and the 'remoteDestination' + liftIO $ callback (sock, remoteDestination) + + in P.connect "127.0.0.1" "7656" connectAddress + +-- | Sends a datagram to a remote destination. +-- +-- __Warning__: This function returns before the actual datagram has arrived at +-- and handled by the SAM bridge. If you close the session opened +-- with 'withSession', a race condition will occur where the datagram +-- will possibly arrive /after/ the session has been closed, and as +-- such will never be delivered. +sendDatagram :: ( MonadIO m + , MonadMask m) + => S.Context -- ^ Our context + -> D.PublicDestination -- ^ Destination to send message to + -> BS.ByteString -- ^ The message to send + -> m () +sendDatagram (S.Context _ _ sessionId _ _) = P.sendDatagram sessionId
+ src/Network/Anonymous/I2P/Error.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveDataTypeable #-} + +-- | I2P error types, inspired by System.IO.Error +module Network.Anonymous.I2P.Error where + +import Data.Typeable (Typeable) + +import Control.Monad.IO.Class +import Control.Exception (throwIO) +import Control.Exception.Base (Exception) + +-- | Error type used +type I2PError = I2PException + +-- | Exception that we use to throw. It is the only type of exception +-- we throw, and the type of error is embedded within the exception. +data I2PException = I2PError { + i2peType :: I2PErrorType -- ^ Our error type + } deriving (Show, Eq, Typeable) + +-- | Derives our I2P exception from the standard exception, which opens it +-- up to being used with all the regular try/catch/bracket/etc functions. +instance Exception I2PException + +-- | An abstract type that contains a value for each variant of 'I2PError' +data I2PErrorType + = NoVersion + | DuplicatedSessionId + | DuplicatedDestination + | InvalidKey + | InvalidId + | Timeout + | Unreachable + | ProtocolError + | MessageTooLong + deriving (Show, Eq) + +-- | Generates new I2PException +mkI2PError :: I2PErrorType -> I2PError +mkI2PError t = I2PError { i2peType = t } + +-- | I2P error when no protocol version can be agreed upon +noVersionErrorType :: I2PErrorType +noVersionErrorType = NoVersion + +-- | I2P error when a session id already exists +duplicatedSessionIdErrorType :: I2PErrorType +duplicatedSessionIdErrorType = DuplicatedSessionId + +-- | I2P error when a destination already exists +duplicatedDestinationErrorType :: I2PErrorType +duplicatedDestinationErrorType = DuplicatedDestination + +-- | I2P error when an invalid (destination) key is used +invalidKeyErrorType :: I2PErrorType +invalidKeyErrorType = InvalidKey + +-- | I2P error when an invalid (session) id is used +invalidIdErrorType :: I2PErrorType +invalidIdErrorType = InvalidId + +-- | I2P error when a timeout has occurred +timeoutErrorType :: I2PErrorType +timeoutErrorType = Timeout + +-- | I2P error when a host was unreachable +unreachableErrorType :: I2PErrorType +unreachableErrorType = Unreachable + +-- | I2P error when communication with the SAM bridge fails +messageTooLongErrorType :: I2PErrorType +messageTooLongErrorType = MessageTooLong + +-- | I2P error when communication with the SAM bridge fails +protocolErrorType :: I2PErrorType +protocolErrorType = ProtocolError + +-- | Raise an I2P Exception in the IO monad +i2pException :: (MonadIO m) + => I2PException + -> m a +i2pException = liftIO . throwIO + +-- | Raise an I2P error in the IO monad +i2pError :: (MonadIO m) + => I2PError + -> m a +i2pError = i2pException
+ src/Network/Anonymous/I2P/Internal/Debug.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} + +-- | Debugging helper functions, for internal use only +module Network.Anonymous.I2P.Internal.Debug where + +import Debug.Trace (trace) + +-- | Alias to Debug.Trace(trace), but disabled in non-debug builds +log :: String -> a -> a + +#ifdef DEBUG +log = trace +#else +log _ ret = ret +#endif
+ src/Network/Anonymous/I2P/Protocol.hs view
@@ -0,0 +1,350 @@+{-# LANGUAGE OverloadedStrings #-} + +-- | Protocol description +-- +-- Defines functions that handle the advancing of the SAMv3 protocol. +-- +-- __Warning__: This function is used internally by 'Network.Anonymous.I2P' +-- and using these functions directly is unsupported. The +-- interface of these functions might change at any time without +-- prior notice. +-- +module Network.Anonymous.I2P.Protocol ( NST.connect + , version + , versionWithConstraint + , createDestination + , createSession + , createSessionWith + , acceptStream + , connectStream + , sendDatagram + , receiveDatagram) where + +import Control.Applicative ((<*)) +import Control.Monad.Catch +import Control.Monad.IO.Class + +import qualified Data.Text as T +import qualified Data.Text.Encoding as TE +import qualified Data.UUID as Uuid +import qualified Data.UUID.V4 as Uuid + +import qualified Data.Attoparsec.ByteString as Atto +import qualified Data.Attoparsec.ByteString.Char8 as Atto8 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import qualified Network.Simple.TCP as NST + +import qualified Network.Socket as Network hiding (recv, send) +import qualified Network.Socket.ByteString as Network + +import qualified Network.Attoparsec as NA + +import qualified Network.Anonymous.I2P.Error as E +import qualified Network.Anonymous.I2P.Internal.Debug as D +import qualified Network.Anonymous.I2P.Protocol.Parser as Parser +import qualified Network.Anonymous.I2P.Protocol.Parser.Ast as Ast +import qualified Network.Anonymous.I2P.Types.Destination as D +import qualified Network.Anonymous.I2P.Types.Socket as S + + +-- | According to the I2P protocol, the first two tokens in a response are always +-- in a fixed position, and for each step in the protocol, we expect two very +-- specific keys to be here. +-- +-- This is a function that sends a buffer to a socket, waits for and parses the +-- respone, and returns the remaining tokens. +expectResponse :: ( MonadIO m + , MonadMask m) + => Network.Socket + -> BS.ByteString + -> (BS.ByteString, BS.ByteString) + -> m [Ast.Token] +expectResponse sock output (first, second) = do + liftIO $ D.log + ("sending to remote: " ++ show output) + Network.sendAll sock output + + res <- NA.parseOne sock (Atto.parse Parser.line) + + liftIO $ putStrLn ("got response: " ++ show res) + + case res of + (Ast.Token first' Nothing : Ast.Token second' Nothing : xs) -> if first == first' && second == second' + then return xs + else E.i2pError (E.mkI2PError E.protocolErrorType) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + +-- | Announces ourselves with SAM bridge and negotiates protocol version +-- +-- Defaults to protocol version 3.1, which is the only one we support at the +-- moment. +version :: ( MonadIO m + , MonadMask m) + => Network.Socket -- ^ Our connection with SAM bridge + -> m [Integer] -- ^ Version agreed upon, stores as a list of integers; for + -- example, [3,1] means version 3.1 +version = versionWithConstraint ([3,1], [3,1]) + +-- | Performs same handshake as 'version', but with an explicit min/max supported +-- version provided. +versionWithConstraint :: ( MonadIO m + , MonadMask m) + => ([Integer], [Integer]) -- ^ Min/max version we want to agree on, stored as a list + -- of integers. For example, ([3,0], [3,1]) means min + -- version 3.0, max version 3.1 + -> Network.Socket -- ^ Our connection with SAM bridge + -> m [Integer] -- ^ Version agreed upon, stores as a list of integers; for + -- example, [3,1] means version 3.1 +versionWithConstraint (minV, maxV) sock = + let versionToString :: [Integer] -> BS.ByteString + versionToString vs = + let textList :: [Integer] -> [T.Text] + textList = map (T.pack . show) + + versionify :: [T.Text] -> T.Text + versionify = T.intercalate "." + + in TE.encodeUtf8 (versionify (textList vs)) + + helloString :: BS.ByteString + helloString = BS.concat ["HELLO VERSION MIN=", versionToString minV, " MAX=", versionToString maxV, "\n"] + + versionParser :: Atto.Parser [Integer] + versionParser = (Atto8.decimal `Atto.sepBy` Atto8.char '.') + + in do + res <- expectResponse sock helloString ("HELLO", "REPLY") + case (Ast.value "RESULT" res, + Ast.valueAs versionParser "VERSION" res) of + + -- This is the normal result, and 'VERSION' will contain our (parsed) version + (Just ("OK"), Just v) -> return v + (Just ("NOVERSION"), _) -> E.i2pError (E.mkI2PError E.noVersionErrorType) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + +-- | Creates a new I2P public/private destination pair +createDestination :: ( MonadIO m + , MonadMask m) + => Maybe D.SignatureType + -> Network.Socket + -> m (D.PrivateDestination, D.PublicDestination) +createDestination signature sock = + let signatureToString :: Maybe D.SignatureType -> BS.ByteString + signatureToString Nothing = "" + signatureToString (Just D.DsaSha1) = "SIGNATURE_TYPE=DSA_SHA1" + + signatureToString (Just D.EcdsaSha256P256) = "SIGNATURE_TYPE=ECDSA_SHA256_P256" + signatureToString (Just D.EcdsaSha384P384) = "SIGNATURE_TYPE=ECDSA_SHA384_P384" + signatureToString (Just D.EcdsaSha512P521) = "SIGNATURE_TYPE=ECDSA_SHA512_P521" + + signatureToString (Just D.RsaSha2562048) = "SIGNATURE_TYPE=RSA_SHA256_2048" + signatureToString (Just D.RsaSha3843072) = "SIGNATURE_TYPE=RSA_SHA384_3072" + signatureToString (Just D.RsaSha5124096) = "SIGNATURE_TYPE=RSA_SHA512_4096" + + signatureToString (Just D.EdDsaSha512Ed25519) = "SIGNATURE_TYPE=EdDSA_SHA512_Ed25519" + + createDestinationString :: BS.ByteString + createDestinationString = + BS.concat [ "DEST GENERATE " + , signatureToString signature + , "\n"] + + in do + res <- expectResponse sock createDestinationString ("DEST", "REPLY") + case (Ast.value "PRIV" res, Ast.value "PUB" res) of + (Just priv, Just pub) -> return (D.PrivateDestination priv, D.PublicDestination pub) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + +-- | Create a session with default parameters provided. +createSession :: ( MonadIO m + , MonadMask m) + => S.SocketType -- ^ I2P socket type to create + -> Network.Socket -- ^ Our connection with SAM bridge + -> m (String, D.PrivateDestination, D.PublicDestination) -- ^ Our session id and our private destination key +createSession socketType sock = do + (privDestination, pubDestination) <- createDestination Nothing sock + sessionId <- createSessionWith Nothing privDestination socketType sock + + return (sessionId, privDestination, pubDestination) + +-- | Create a session, and explicitly provide all parameters to use +createSessionWith :: ( MonadIO m + , MonadMask m + , D.Acceptable d + , D.Destination d) + => Maybe String -- ^ Session id to use. If none is provided, a new + -- unique session id is created. + -> d -- ^ Destination to use. + -> S.SocketType -- ^ I2P socket type to create + -> Network.Socket -- ^ Our connection with SAM bridge + -> m String -- ^ Our session id + +-- Specialization where no session is was provided. In this case, we create a +-- new session id based on a UUID, and enter recursion with the fresh session id +-- provided. +createSessionWith Nothing destination socketType sock = do + uuid <- liftIO Uuid.nextRandom + + D.log + ("created session id: " ++ show uuid) + createSessionWith (Just (Uuid.toString uuid)) destination socketType sock + +createSessionWith (Just sessionId) destination socketType sock = + let socketTypeToString :: S.SocketType -> BS.ByteString + socketTypeToString S.VirtualStream = "STREAM" + socketTypeToString S.DatagramRepliable = "DATAGRAM" + socketTypeToString S.DatagramAnonymous = "RAW" + + sessionString :: String -> BS.ByteString + sessionString sid = + BS.concat [ "SESSION CREATE STYLE=", socketTypeToString socketType, " " + , "ID=", BS8.pack sid, " " + , "DESTINATION=", D.asByteString destination + , "\n"] + + in do + res <- expectResponse sock (sessionString sessionId) ("SESSION", "STATUS") + case Ast.value "RESULT" res of + -- This is the normal result, and 'VERSION' will contain our (parsed) version + Just ("OK") -> return sessionId + Just ("DUPLICATED_ID") -> E.i2pError (E.mkI2PError E.duplicatedSessionIdErrorType) + Just ("DUPLICATED_DEST") -> E.i2pError (E.mkI2PError E.duplicatedDestinationErrorType) + Just ("INVALID_KEY") -> E.i2pError (E.mkI2PError E.invalidKeyErrorType) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + +-- | For VirtualStream sockets, accepts one new connection +acceptStream :: ( MonadIO m + , MonadMask m) + => String -- ^ Our session id + -> Network.Socket -- ^ Our connection with SAM bridge + -> m (Network.Socket, D.PublicDestination) -- ^ Returns as soon as connection has been accepted +acceptStream sessionId sock = + let acceptString :: String -> BS.ByteString + acceptString s = + BS.concat [ "STREAM ACCEPT " + , "ID=", BS8.pack s, " " + , "SILENT=false" + , "\n"] + + -- After a connection has been accepted, the first line denotes the base64 + -- representation of the remote destination. + readDestination s = + let lineParser :: Atto.Parser BS.ByteString + lineParser = Atto8.takeTill (== '\n') <* Atto8.endOfLine + + in do + buf <- NA.parseOne s (Atto.parse lineParser) + return (D.PublicDestination buf) + + in do + res <- expectResponse sock (acceptString sessionId) ("STREAM", "STATUS") + case Ast.value "RESULT" res of + -- This is the normal result, and 'VERSION' will contain our (parsed) version + Just ("OK") -> do + dst <- readDestination sock + return (sock, dst) + Just ("INVALID_ID") -> E.i2pError (E.mkI2PError E.invalidIdErrorType) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + +-- | For VirtualStream sockets, establishes connection with a remote +connectStream :: ( MonadIO m + , MonadMask m + , D.Connectable d + , D.Destination d) + => String -- ^ Our session id + -> d -- ^ Destination we wish to connect to + -> Network.Socket -- ^ Our connection with SAM bridge + -> m () -- ^ Returning state +connectStream sessionId destination sock = + let connectString :: String -> BS.ByteString + connectString s = + BS.concat [ "STREAM CONNECT " + , "ID=", BS8.pack s, " " + , "DESTINATION=", D.asByteString destination, " " + , "SILENT=false" + , "\n"] + + in do + res <- expectResponse sock (connectString sessionId) ("STREAM", "STATUS") + case Ast.value "RESULT" res of + -- This is the normal result, and 'VERSION' will contain our (parsed) version + Just ("OK") -> return () + Just ("INVALID_ID") -> E.i2pError (E.mkI2PError E.invalidIdErrorType) + Just ("INVALID_KEY") -> E.i2pError (E.mkI2PError E.invalidKeyErrorType) + Just ("TIMEOUT") -> E.i2pError (E.mkI2PError E.timeoutErrorType) + Just ("CANT_REACH_PEER") -> E.i2pError (E.mkI2PError E.unreachableErrorType) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + + +-- | For DatagramRepliable and DatagramAnonymous, send a message +sendDatagram :: ( MonadIO m + , MonadMask m + , D.Connectable d + , D.Destination d) + => String -- ^ Our session id + -> d -- ^ Destination we wish to send message to + -> BS.ByteString -- ^ Message we wish to send + -> m () -- ^ Returning state +sendDatagram sessionId destination message + | BS.length message > maxLength = E.i2pError (E.mkI2PError E.messageTooLongErrorType) + | otherwise = + let sendString = + BS.concat [ "3.0 " + , BS8.pack sessionId, " " + , D.asByteString destination, " " + , "\n" + , message] + + in do + -- Establish connection to UDP SAM service at port 7655 + addrinfos <- liftIO $ Network.getAddrInfo Nothing (Just "127.0.0.1") (Just "7655") + let serveraddr = head addrinfos + sock <- liftIO $ Network.socket (Network.addrFamily serveraddr) Network.Datagram Network.defaultProtocol + liftIO $ Network.connect sock (Network.addrAddress serveraddr) + + -- And write the message + liftIO $ Network.sendAll sock sendString + return () + + where maxLength = 31744 + +-- | For DatagramRepliable and DatagramAnonymous, receive a message +receiveDatagram :: ( MonadIO m + , MonadMask m) + => Network.Socket -- ^ Our connection with SAM bridge + -> m (BS.ByteString, Maybe D.PublicDestination) -- ^ Received buffer, possibly with a reply destination +receiveDatagram sock = + + let receive :: Int -> IO BS.ByteString + receive 0 = return BS.empty + receive bytes = do + recv <- D.log + ("Reading " ++ show bytes ++ " bytes as datagram") + Network.recv sock bytes + + recv' <- receive (bytes - BS.length recv) + + return (BS.append recv recv') + + handleRepliable tokens = + case (Ast.value "SIZE" tokens, Ast.value "DESTINATION" tokens) of + (Just size, Just destination) -> do + buf <- liftIO $ (receive . read . BS8.unpack) size + return (buf, Just (D.PublicDestination destination)) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + + handleAnonymous tokens = + case Ast.value "SIZE" tokens of + Just size -> do + buf <- liftIO $ (receive . read . BS8.unpack) size + return (buf, Nothing) + _ -> E.i2pError (E.mkI2PError E.protocolErrorType) + + in do + res <- NA.parseOne sock (Atto.parse Parser.line) + + case res of + (Ast.Token "DATAGRAM" Nothing : Ast.Token "RECEIVED" Nothing : xs) -> handleRepliable xs + (Ast.Token "RAW" Nothing : Ast.Token "RECEIVED" Nothing : xs) -> handleAnonymous xs + _ -> E.i2pError (E.mkI2PError E.protocolErrorType)
+ src/Network/Anonymous/I2P/Protocol/Parser.hs view
@@ -0,0 +1,115 @@+-- | Parser defintions +-- +-- Defines parsers used by the I2P SAM protocol +-- +-- __Warning__: This function is used internally by 'Network.Anonymous.I2P' +-- and using these functions directly is unsupported. The +-- interface of these functions might change at any time without +-- prior notice. +-- + +module Network.Anonymous.I2P.Protocol.Parser where + +import Control.Applicative ((*>), (<$>), (<*), + (<|>)) + +import qualified Data.Attoparsec.ByteString as Atto +import qualified Data.Attoparsec.ByteString.Char8 as Atto8 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import Data.Word (Word8) +import qualified Network.Anonymous.I2P.Protocol.Parser.Ast as A + +-- | Ascii offset representation of a double quote. +doubleQuote :: Word8 +doubleQuote = 34 + +-- | Ascii offset representation of a single quote. +singleQuote :: Word8 +singleQuote = 39 + +-- | Ascii offset representation of a backslash. +backslash :: Word8 +backslash = 92 + +-- | Ascii offset representation of an equality sign. +equals :: Word8 +equals = 61 + +-- | Parses a single- or double-quoted value, and returns all bytes within the +-- value; the unescaping is beyond the scope of this function (since different +-- unescaping mechanisms might be desired). +-- +-- Looking at the SAMv3 code on github, it appears as if the protocol is kind +-- hacked together at the moment: no character escaping is performed at all, +-- and no formal tokens / AST is used. +-- +-- So this function already goes way beyond what is required, but it cannot +-- hurt to do so. +quotedValue :: Atto.Parser BS.ByteString +quotedValue = + let quoted :: Word8 -- ^ The character used for quoting + -> Atto.Parser BS.ByteString -- ^ The value inside the quotes, without the surrounding quotes + quoted c = (Atto.word8 c *> escaped c <* Atto.word8 c) + + -- | Parses an escaped string, with an arbitrary surrounding quote type. + escaped :: Word8 -> Atto.Parser BS.ByteString + escaped c = BS8.concat <$> Atto8.many' + -- Make sure that we eat pairs of backslashes; this will make sure + -- that a string such as "\\\\" is interpreted correctly, and the + -- ending quoted will not be interpreted as escaped. + ( Atto8.string (BS8.pack "\\\\") + + -- This eats all escaped quotes and leaves them in tact; the unescaping + -- is beyond the scope of this function. + <|> Atto8.string (BS.pack [backslash, c]) + + -- And for the rest: eat everything that is not a quote. + <|> (BS.singleton <$> Atto.satisfy (/= c))) + + in quoted doubleQuote <|> quoted singleQuote + +-- | An unquoted value is "everything until a whitespace or newline is reached". +-- This is pretty broad, but the SAM implementation in I2P just uses a strtok, +-- and is quite hackish. +unquotedValue :: Atto.Parser BS.ByteString +unquotedValue = + Atto8.takeWhile1 (not . Atto8.isSpace) + +-- | Parses either a quoted value or an unquoted value +value :: Atto.Parser BS.ByteString +value = + quotedValue <|> unquotedValue + +-- | Parses key and value +keyValue :: Atto.Parser A.Token +keyValue = do + A.Token k _ <- key + _ <- Atto.word8 equals + v <- value + + return (A.Token k (Just v)) + +-- | Parses a key, which, after studying the SAMv3 code, is anything until either +-- a space has been reached, or an '=' is reached. +key :: Atto.Parser A.Token +key = + let isKeyEnd '=' = True + isKeyEnd c = Atto8.isSpace c + + in flip A.Token Nothing <$> Atto8.takeWhile1 (not . isKeyEnd) + +-- | A Token is either a Key or a Key/Value combination. +token :: Atto.Parser A.Token +token = + Atto.skipWhile Atto8.isHorizontalSpace *> (keyValue <|> key) + +-- | Parser that reads keys or key/values +tokens :: Atto.Parser [A.Token] +tokens = + Atto.many' token + +-- | A generic parser that reads a whole line of key/values and ends in a newline +line :: Atto.Parser A.Line +line = + tokens <* Atto8.endOfLine
+ src/Network/Anonymous/I2P/Protocol/Parser/Ast.hs view
@@ -0,0 +1,53 @@+-- | Abstract syntax tree used by the 'Parser', including helper functions +-- for traversing the tree. +-- +-- __Warning__: This function is used internally by 'Network.Anonymous.I2P' +-- and using these functions directly is unsupported. The +-- interface of these functions might change at any time without +-- prior notice. +-- + +module Network.Anonymous.I2P.Protocol.Parser.Ast where +import qualified Data.Attoparsec.ByteString as Atto + +import qualified Data.ByteString as BS + +-- | A token is a key and can maybe have an associated value +data Token = + Token BS.ByteString (Maybe BS.ByteString) + deriving (Show, Eq) + +-- | A line is just a sequence of tokens -- the 'Parser' ends the chain +-- when a newline is received. +type Line = [Token] + +-- | Returns true if the key was found +key :: BS.ByteString -- ^ The key to look for + -> [Token] -- ^ Tokens to consider + -> Bool -- ^ Result +key _ [] = False -- Key was not found +key k1 (Token k2 _:xs) = (k1 == k2) || key k1 xs -- If keys match, return true, otherwise enter recursion + +-- | Looks up a key and returns the value if found +value :: BS.ByteString -- ^ Key to look for + -> [Token] -- ^ Tokens to consider + -> Maybe BS.ByteString -- ^ The value if the key was found +value _ [] = Nothing -- Key not found! +value k1 (Token k2 v:xs) = if k1 == k2 -- This assumes keys are unique + then v -- This returns the value of the key, if any value is associated + else value k1 xs -- Otherwise we continue our quest (in recursion) + +-- | Retrieves value, and applies it to an Attoparsec parser +valueAs :: Atto.Parser a + -> BS.ByteString + -> [Token] + -> Maybe a +valueAs p k xs = + let parseValue bs = + case Atto.parseOnly p bs of + Left _ -> Nothing + Right r -> Just r + + in case value k xs of + Nothing -> Nothing + Just v -> parseValue v
+ src/Network/Anonymous/I2P/Types/Destination.hs view
@@ -0,0 +1,76 @@+-- | I2P destination related types +module Network.Anonymous.I2P.Types.Destination where + +import qualified Data.ByteString as BS + +-- | Interface for any destination +class Destination a where + -- | Any destination should be convertable to a ByteString in order to + -- send it over a socket. + asByteString :: a -> BS.ByteString + +-- | An I2P destination we can connect to. +class Connectable a where + +-- | An I2P destination we can accept connections from. +class Acceptable a where + +-- | I2P Public destination +-- +-- A public destination is the base64 representation of the public I2P +-- key of a destination, and should be given out to other people to connect +-- to your host. +data PublicDestination = PublicDestination BS.ByteString deriving (Eq, Show) + +-- | We can connect to a public destination +instance Connectable PublicDestination + +-- | A public destination is a 'Destination' and can be converted to a ByteString. +instance Destination PublicDestination where + asByteString (PublicDestination bs) = bs + +-- | I2P Private destination +-- +-- A private destination is the base64 representation of the private I2P +-- key of a destination, and you should keep this address to yourself. It +-- can be used to accepts connections, and as such, if you give this private +-- destination out to others, you are effectively giving them the ability +-- to MITM you. +data PrivateDestination = PrivateDestination BS.ByteString deriving (Eq, Show) + +-- | We can connect to a private destination +instance Connectable PrivateDestination + +-- | We can accept connections at a private destination +instance Acceptable PrivateDestination + +-- | A private destination is a 'Destination' and can be converted to a ByteString. +instance Destination PrivateDestination where + asByteString (PrivateDestination bs) = bs + +-- | Supported signature types by I2P, as defined at +-- <https://geti2p.net/en/docs/spec/common-structures#type_Signature I2P Common Structure Documentation> +data SignatureType = + -- | DSA_SHA1 -- the default, and supported by all I2P versions + DsaSha1 | + + -- | ECDSA_SHA256_P256, supported by version 0.9.12 and up + EcdsaSha256P256 | + + -- | ECDSA_SHA384_P384, supported by version 0.9.12 and up + EcdsaSha384P384 | + + -- | ECDSA_SHA512_P521, supported by version 0.9.12 and up + EcdsaSha512P521 | + + -- | RSA_SHA256_2048, supported by version 0.9.12 and up + RsaSha2562048 | + + -- | RSA_SHA384_3072, supported by version 0.9.12 and up + RsaSha3843072 | + + -- | RSA_SHA512_4096, supported by version 0.9.12 and up + RsaSha5124096 | + + -- | EdDSA_SHA512_Ed25519, supported by version 0.9.15 and up + EdDsaSha512Ed25519
+ src/Network/Anonymous/I2P/Types/Session.hs view
@@ -0,0 +1,16 @@+-- | Session related types +module Network.Anonymous.I2P.Types.Session where + +import qualified Network.Anonymous.I2P.Types.Destination as D +import qualified Network.Anonymous.I2P.Types.Socket as S +import qualified Network.Socket as NS + +-- | Context object that is required for all functions that operate on top +-- of the SAM bridge. +data Context = Context { + conn :: NS.Socket, -- ^ Our connection with the SAM bridge + socketType :: S.SocketType, -- ^ The type of connection we are managing + sessionId :: String, -- ^ Our session id + privDest :: D.PrivateDestination, -- ^ Our private destination + pubDest :: D.PublicDestination -- ^ Our public destination which we can give out to others + }
+ src/Network/Anonymous/I2P/Types/Socket.hs view
@@ -0,0 +1,32 @@+-- | Socket related types +module Network.Anonymous.I2P.Types.Socket where + +import qualified Network.Socket as NS + +-- | Alias for a hostname +type HostName = NS.HostName + +-- | Alias for a port number +type PortNumber = NS.PortNumber + +-- | Socket types +data SocketType = + -- | Virtual streams are guaranteed to be sent reliably and in order, with + -- failure and success notification as soon as it is available. Streams are + -- bidirectional communication sockets between two I2P destinations, but their + -- opening has to be requested by one of them. + VirtualStream | + + -- | While I2P doesn't inherently contain a FROM address, for ease of use + -- an additional layer is provided as repliable datagrams - unordered + -- and unreliable messages of up to 31744 bytes that include a FROM + -- address (leaving up to 1KB for header material). This FROM address + -- is authenticated internally by SAM (making use of the destination's + -- signing key to verify the source) and includes replay prevention. + DatagramRepliable | + + -- | Squeezing the most out of I2P's bandwidth, SAM allows clients to send + -- and receive anonymous datagrams, leaving authentication and reply + -- information up to the client themselves. These datagrams are + -- unreliable and unordered, and may be up to 32768 bytes. + DatagramAnonymous
+ test/Main.hs view
@@ -0,0 +1,10 @@+module Main where + +import Test.Hspec.Runner +import qualified Spec + +import Network (withSocketsDo) + +main :: IO () +main = + withSocketsDo $ hspecWith defaultConfig Spec.spec
+ test/Network/Anonymous/I2P/Protocol/ParserSpec.hs view
@@ -0,0 +1,200 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Anonymous.I2P.Protocol.ParserSpec where + +import qualified Data.ByteString as BS +import Network.Anonymous.I2P.Protocol.Parser +import Network.Anonymous.I2P.Protocol.Parser.Ast (Token (..)) + +import Test.Hspec +import Test.Hspec.Attoparsec + +testDestination :: BS.ByteString +testDestination = "TedPIHKiYHLLavX~2XgghB-jYBFkwkeztWM5rwyJCO2yR2gT92FcuEahEcTrykTxafzv~4jSQOL5w0EqElqlM~PEFy5~L1pOyGB56-yVd4I-g2fsM9MGKlXNOeQinghKOcfbQx1LVY35-0X5lQSNX-8I~U7Lefukj7gSC5hieWkDS6WiUW6nYw~t061Ra0GXf2qzqFTB4nkQvnCFKaZGtNwOUUpmIbF0OtLyr6TxC7BQKgcg4jyZPS1LaBO6Wev0ZFYiQHLk4S-1LQFBfT13BxN34g-eCInwHlYeMD6NEdiy0BYHhnbBTq02HbgD3FjxW~GBBB-6a~eFABaIiJJ08XR8Mm6KKpNh~gQXut2OLxs55UhEkqk8YmTODrf6yzWzldCdaaAEVMfryO9oniWWCVl1FgLmzUHPGQ3yzvb8OlXiED2hunEfaEg0fg77FRDnYJnDHMF7i5zcUzRGb67rUa1To~H65hR9cFNWTAwX4svC-gRbbvxfi-bthyj-QqeBBQAEAAcAAOEyRS5bFHDrXnWpsjcRvpQj436gS4iCjCzdOohWgeBKC~gfLVY658op9GF6oRJ78ezPN9FBE0JqNrAM75-uL9CIeJd8JUwdldm83RNSVI1ZPZBK-5F3DgIjTsqHDMzQ9xPETiBO2UZZogXSThx9I9uYuAtg296ZhziKjYnl7wi2i3IgQlNbuPW16ajOcNeKnL1OqFipAL9e3k~LEhgBNM3J2hK1M4jO~BQ19TxIXXUfBsHFU4YjwkAOKqOxR1iP8YD~xUSfdtF9mBe6fT8-WW3-n2WgHXiTLW3PJjJuPYM4hNKNmsxsEz5vi~DE6H1pUsPVs2oXFYKZF3EcsKUVaAVWJBarBPuVNYdJgIbgl1~TJeNor8hGQw6rUTJFaZ~jjQ==" + +spec :: Spec +spec = do + describe "parsing quoted values" $ do + it "it should succeed when providing a doublequoted value" $ + let msg :: BS.ByteString + msg = "\"foo\"" + + in msg ~> quotedValue `shouldParse` "foo" + + it "it should succeed when providing a doublequoted value with spaces" $ + let msg :: BS.ByteString + msg = "\"foo bar\"" + + in msg ~> quotedValue `shouldParse` "foo bar" + + it "it should succeed when providing a doublequoted value with an escaped quote" $ + let msg :: BS.ByteString + msg = "\"foo \\\" bar\"" + + in msg ~> quotedValue `shouldParse` "foo \\\" bar" + + it "it should stop after a doublequoted value has been reached" $ + let msg :: BS.ByteString + msg = "\"foo bar\" \"baz\"" + + in msg ~> quotedValue `shouldParse` "foo bar" + + it "it should succeed when providing a singlequoted value" $ + let msg :: BS.ByteString + msg = "'foo'" + + in msg ~> quotedValue `shouldParse` "foo" + + it "it should succeed when providing a singlequoted value with spaces" $ + let msg :: BS.ByteString + msg = "'foo bar'" + + in msg ~> quotedValue `shouldParse` "foo bar" + + it "it should succeed when providing a singlequoted value with an escaped quote" $ + let msg :: BS.ByteString + msg = "'foo \\' bar'" + + in msg ~> quotedValue `shouldParse` "foo \\' bar" + + + it "it should stop after a singlequoted value has been reached" $ + let msg :: BS.ByteString + msg = "'foo bar' 'baz'" + + in msg ~> quotedValue `shouldParse` "foo bar" + + describe "parsing unquoted values" $ do + it "it should succeed when providing a simple value" $ + let msg :: BS.ByteString + msg = "foo" + + in msg ~> unquotedValue `shouldParse` "foo" + + it "it should stop after whitespace" $ + let msg :: BS.ByteString + msg = "foo bar" + + in msg ~> unquotedValue `shouldParse` "foo" + + it "it should stop after a newline" $ + let msg :: BS.ByteString + msg = "foo\r\nbar" + + in msg ~> unquotedValue `shouldParse` "foo" + + it "it should eat a destination" $ + testDestination ~> unquotedValue `shouldParse` testDestination + + it "it should eat a destination and not continue with more" $ + BS.concat [testDestination, " foo=bar"] ~> unquotedValue `shouldParse` testDestination + + it "should fail on empty input" $ + unquotedValue `shouldFailOn` BS.empty + + describe "parsing keys" $ do + it "it should succeed when providing a simple key" $ + let msg :: BS.ByteString + msg = "foo" + + in msg ~> key `shouldParse` (Token "foo" Nothing) + + it "it should succeed when providing a space separated key" $ + let msg :: BS.ByteString + msg = "foo bar" + + in msg ~> key `shouldParse` (Token "foo" Nothing) + + it "it should succeed when providing an equals separated key" $ + let msg :: BS.ByteString + msg = "foo=bar" + + in msg ~> key `shouldParse` (Token "foo" Nothing) + + it "should fail on empty input" $ + key `shouldFailOn` BS.empty + + describe "parsing key/values" $ do + it "it should succeed when providing a simple key/value" $ + let msg :: BS.ByteString + msg = "foo=bar" + + in msg ~> keyValue `shouldParse` (Token "foo" (Just "bar")) + + it "it should succeed when providing a key/value where the value contains an equals sign" $ + let msg :: BS.ByteString + msg = "foo=bar=wombat" + + in msg ~> keyValue `shouldParse` (Token "foo" (Just "bar=wombat")) + + it "it should succeed when providing a destination as value" $ + let msg :: BS.ByteString + msg = BS.concat ["destination=", testDestination] + + in msg ~> keyValue `shouldParse` (Token "destination" (Just testDestination)) + + it "it should succeed when providing a quoted value" $ + let msg :: BS.ByteString + msg = "foo=\"bar wombat\"" + + in msg ~> keyValue `shouldParse` (Token "foo" (Just "bar wombat")) + + it "should fail on empty value" $ + keyValue `shouldFailOn` ("foo=" :: BS.ByteString) + + it "should fail on empty key" $ + keyValue `shouldFailOn` ("=bar" :: BS.ByteString) + + describe "parsing a token" $ do + it "should parse a key when only providing a key" $ + let msg :: BS.ByteString + msg = "foo" + + in msg ~> token `shouldParse` (Token "foo" Nothing) + + it "should parse a key/value when providing a key/value" $ + let msg :: BS.ByteString + msg = "foo=bar" + + in msg ~> token `shouldParse` (Token "foo" (Just "bar")) + + it "should skip any preceding horizontal whitespace" $ + let msg :: BS.ByteString + msg = " foo" + + in msg ~> token `shouldParse` (Token "foo" Nothing) + + it "should not skip any preceding newlines" $ + let msg :: BS.ByteString + msg = "\nfoo" + + in token `shouldFailOn` msg + + describe "parsing many tokens" $ do + it "should parse multiple keys correctly" $ + let msg :: BS.ByteString + msg = "foo bar" + + in msg ~> tokens `shouldParse` [(Token "foo" Nothing), (Token "bar" Nothing)] + + it "should parse multiple key/valuess correctly" $ + let msg :: BS.ByteString + msg = "foo=bar wom=bat" + + in msg ~> tokens `shouldParse` [(Token "foo" (Just "bar")), (Token "wom" (Just "bat"))] + + it "should be able to mix and match key/values and keys" $ + let msg :: BS.ByteString + msg = "foo=bar wombat foz=baz" + + in msg ~> tokens `shouldParse` [(Token "foo" (Just "bar")), (Token "wombat" Nothing), Token "foz" (Just "baz")] + + describe "parsing a line" $ do + it "should parse multiple keys correctly" $ + let msg :: BS.ByteString + msg = "foo bar\n" + + in msg ~> line `shouldParse` [(Token "foo" Nothing), (Token "bar" Nothing)] + + it "should fail when no newline is provided" $ + line `shouldFailOn` ("foo bar" :: BS.ByteString)
+ test/Network/Anonymous/I2P/ProtocolSpec.hs view
@@ -0,0 +1,473 @@+{-# LANGUAGE OverloadedStrings #-} + +module Network.Anonymous.I2P.ProtocolSpec where + +import Control.Concurrent.MVar +import Control.Concurrent (ThreadId, forkIO, + killThread, + threadDelay) +import Control.Monad.Catch +import Control.Monad.IO.Class + +import qualified Network.Simple.TCP as NS (accept, listen, + send) +import qualified Network.Socket as NS (Socket) +import qualified Network.Socket.ByteString as NSB (sendAll, recv) + +import qualified Network.Anonymous.I2P.Error as E +import qualified Network.Anonymous.I2P.Protocol as P (connect, + createDestination, + createSession, + createSessionWith, + version, + versionWithConstraint, + acceptStream, + connectStream, + sendDatagram, + receiveDatagram) +import qualified Network.Anonymous.I2P.Types.Destination as D +import qualified Network.Anonymous.I2P.Types.Socket as S +import qualified Network.Anonymous.I2P.Util as U + +import qualified Data.ByteString as BS +import qualified Data.ByteString.Char8 as BS8 +import Data.Maybe (fromJust, isJust, isNothing) +import qualified Data.UUID as Uuid +import qualified Data.UUID.Util as Uuid +import qualified Data.UUID.V4 as Uuid + +import Test.Hspec + +mockServer :: ( MonadIO m + , MonadMask m) + => String + -> (NS.Socket -> IO a) + -> m ThreadId +mockServer port callback = do + tid <- liftIO $ forkIO $ + NS.listen "*" port (\(lsock, _) -> NS.accept lsock (\(sock, _) -> do + _ <- callback sock + threadDelay 1000000 + return ())) + + liftIO $ threadDelay 500000 + return tid + +testSockets :: NS.Socket -> NS.Socket -> IO (BS.ByteString, BS.ByteString) +testSockets sink source = + let uuidAsBs = BS8.pack . Uuid.toString + + recvAll :: NS.Socket -> Int -> IO BS.ByteString + recvAll _ 0 = return (BS.empty) + recvAll sock bytes = do + recv <- NSB.recv sock bytes + recv' <- recvAll sock (bytes - BS.length recv) + + return (BS.append recv recv') + + in do + uuid <- Uuid.nextRandom + + NSB.sendAll sink (uuidAsBs uuid) + + received <- recvAll source (BS.length (uuidAsBs uuid)) + return (uuidAsBs uuid, received) + +spec :: Spec +spec = do + describe "when connecting to a SAM bridge" $ do + it "connecting to the default port should work" $ do + P.connect "127.0.0.1" "7656" (\_ -> return ()) `shouldReturn` () + + it "connecting to a non-existent port should not work" $ do + (P.connect "127.0.0.1" "1234" return) `shouldThrow` anyIOException + + describe "when negotiating protocol version" $ do + it "should use protocol version 3.1 when connecting to SAM" $ + P.connect "127.0.0.1" "7656" (P.version . fst) `shouldReturn` [3,1] + + it "should return an arbitrary version if we supply it" $ + let serverSock = flip NS.send "HELLO REPLY RESULT=OK VERSION=1.2\n" + + in do + thread <- liftIO $ mockServer "4322" serverSock + P.connect "127.0.0.1" "4322" (P.version . fst) `shouldReturn` [1,2] + killThread thread + + it "should use throw an error if no correct version can be found" $ + P.connect "127.0.0.1" "7656" (P.versionWithConstraint ([4,0], [4,1]) . fst) `shouldThrow` U.isI2PError E.noVersionErrorType + + it "should throw an error when the host sends an incomplete reply" $ + let serverSock = flip NS.send "HELLO VERSION REPLY " + + in do + thread <- liftIO $ mockServer "4323" serverSock + P.connect "127.0.0.1" "4323" (P.version . fst) `shouldThrow` anyIOException -- thrown by parser, not our own library + killThread thread + + it "should throw an error when the host responds with an error" $ + let serverSock = flip NS.send "HELLO REPLY RESULT=I2P_ERROR MESSAGE=\"fooMessage\"\n" + + in do + thread <- liftIO $ mockServer "4324" serverSock + P.connect "127.0.0.1" "4324" (P.version . fst) `shouldThrow` U.isI2PError E.protocolErrorType + killThread thread + + describe "when creating a destination" $ do + it "should be able to create new destinations with all signature types" $ + let createSession signatureType (sock, _) = do + (priv, pub) <- P.version sock >> P.createDestination (Just signatureType) sock + return ((D.asByteString priv, D.asByteString pub)) + + performTest signatureType = do + (priv, pub) <- P.connect "127.0.0.1" "7656" (createSession signatureType) + + -- Validate that our private signature starts with our public sig. + -- Note that we strip the last 2 bytes, since they might not match + -- and be just padding bytes. + (BS.take ((BS.length pub) - 3) priv) `shouldBe` (BS.take ((BS.length pub) - 3) pub) + + sigTypes = [ D.DsaSha1 + , D.EcdsaSha256P256 + , D.EcdsaSha384P384 + , D.EcdsaSha512P521 + , D.RsaSha2562048 + , D.RsaSha3843072 + , D.RsaSha5124096 + , D.EdDsaSha512Ed25519 ] + + + -- If something fails here, an exception will be thrown + in mapM performTest sigTypes >> return () + + describe "when creating a session" $ do + it "should be able to create all types of socket types" $ + let createSession socketType (sock, _) = do + (privDestination, _) <- P.version sock >> P.createDestination Nothing sock + P.createSessionWith Nothing privDestination socketType sock + + performTest socketType = do + sessionId <- P.connect "127.0.0.1" "7656" (createSession socketType) + + (Uuid.fromString sessionId) `shouldSatisfy` isJust + (Uuid.version (fromJust (Uuid.fromString sessionId))) `shouldBe` 4 + + socketTypes = [ S.VirtualStream + , S.DatagramRepliable + , S.DatagramAnonymous ] + + in mapM performTest socketTypes >> return () + + it "should throw a protocol error when creating a session twice" $ + let performTest socketType (sock, _) = do + -- Note that we have to be inside the same connection here. + _ <- P.version sock + _ <- P.createSession socketType sock + P.createSession socketType sock `shouldThrow` U.isI2PError E.protocolErrorType + + in P.connect "127.0.0.1" "7656" (performTest S.VirtualStream) + + it "should throw a protocol error when creating a session with a duplicated nickname id" $ + let socketType = S.VirtualStream + phase1 (sock1, _) = do + (privDestination1, _) <- P.version sock1 >> P.createDestination Nothing sock1 + sessionId1 <- P.createSessionWith Nothing privDestination1 socketType sock1 + + P.connect "127.0.0.1" "7656" (phase2 sessionId1) + + phase2 sessionId1 (sock2, _) = do + (privDestination2, _) <- P.version sock2 >> P.createDestination Nothing sock2 + P.createSessionWith (Just sessionId1) privDestination2 socketType sock2 `shouldThrow` U.isI2PError E.duplicatedSessionIdErrorType + + in P.connect "127.0.0.1" "7656" phase1 + + it "should throw an error when providing an invalid destination key" $ + let performTest socketType (sock, _) = do + _ <- P.version sock + P.createSessionWith Nothing (D.PrivateDestination "123invalid") socketType sock `shouldThrow` U.isI2PError E.invalidKeyErrorType + + in P.connect "127.0.0.1" "7656" (performTest S.VirtualStream) + + it "should throw a protocol error when creating a session with a duplicated destination key" $ + let socketType = S.VirtualStream + + phase2 privDestination1 (sock2, _) = do + (P.version sock2 >> P.createSessionWith Nothing privDestination1 socketType sock2) `shouldThrow` U.isI2PError E.duplicatedDestinationErrorType + + phase1 (sock1, _) = do + (privDestination1, _) <- P.version sock1 >> P.createDestination Nothing sock1 + _ <- P.createSessionWith Nothing privDestination1 socketType sock1 + + P.connect "127.0.0.1" "7656" (phase2 privDestination1) + + in P.connect "127.0.0.1" "7656" phase1 + + describe "when accepting a stream connection" $ do + it "should be returning an error when we try to accept before creating a session" $ + let phase1 (sock, _) = P.version sock >> P.acceptStream "nonExistingSessionId" sock + + in P.connect "127.0.0.1" "7656" phase1 `shouldThrow` U.isI2PError E.invalidIdErrorType + + it "should be returning an error when we try to accept a stream using an invalid sockettype" $ + let socketTypes = [ S.DatagramRepliable + , S.DatagramAnonymous ] + + phase2 sessionId (sock, _) = P.version sock >> P.acceptStream sessionId sock + + phase1 socketType (sock, _) = do + (privDestination, _) <- P.version sock >> P.createDestination Nothing sock + sessionId <- P.createSessionWith Nothing privDestination socketType sock + + P.connect "127.0.0.1" "7656" (phase2 sessionId) + + performTest socketType = P.connect "127.0.0.1" "7656" (phase1 socketType) `shouldThrow` U.isI2PError E.protocolErrorType + + in mapM performTest socketTypes >> return () + + describe "when connecting to a stream connection" $ do + it "should be returning an error when we try to connect before creating a session" $ + let phase1 (sock, _) = P.version sock >> P.connectStream "nonExistingSessionId" (D.PublicDestination "123") sock + + in P.connect "127.0.0.1" "7656" phase1 `shouldThrow` U.isI2PError E.invalidIdErrorType + + it "should be returning an error when we try to connect with a stream using an invalid sockettype" $ + let socketTypes = [ S.DatagramRepliable + , S.DatagramAnonymous ] + + phase2 sessionId (sock, _) = P.version sock >> P.connectStream sessionId (D.PublicDestination "123") sock + + phase1 socketType (sock, _) = do + (privDestination, _) <- P.version sock >> P.createDestination Nothing sock + sessionId <- P.createSessionWith Nothing privDestination socketType sock + + P.connect "127.0.0.1" "7656" (phase2 sessionId) + + performTest socketType = P.connect "127.0.0.1" "7656" (phase1 socketType) `shouldThrow` U.isI2PError E.protocolErrorType + + in mapM performTest socketTypes >> return () + + it "should be returning an error when we try to connect with a stream with an invalid destination type" $ + let socketType = S.VirtualStream + + phase2 sessionId (sock, _) = P.version sock >> P.connectStream sessionId (D.PublicDestination "invalidDestination") sock + + phase1 (sock, _) = do + (privDestination, _) <- P.version sock >> P.createDestination Nothing sock + sessionId <- P.createSessionWith Nothing privDestination socketType sock + + P.connect "127.0.0.1" "7656" (phase2 sessionId) + + in P.connect "127.0.0.1" "7656" phase1 `shouldThrow` U.isI2PError E.invalidKeyErrorType + + it "should be returning an error when we try to connect with a stream to a destination that does not exist" $ + let socketType = S.VirtualStream + + createDestination = do + P.connect "127.0.0.1" "7656" (\(sock, _) -> do + (_, destination) <- P.version sock >> P.createDestination Nothing sock + return (destination)) + + phase2 dest sessionId (sock, _) = P.version sock >> P.connectStream sessionId dest sock + + phase1 dest (sock, _) = do + (privateDestination, _) <- P.version sock >> P.createDestination Nothing sock + sessionId <- P.createSessionWith Nothing privateDestination socketType sock + + P.connect "127.0.0.1" "7656" (phase2 dest sessionId) + + in do + destination <- createDestination + + -- At this point, the socket is closed and the destination does not any longer exist + P.connect "127.0.0.1" "7656" (phase1 destination) `shouldThrow` U.isI2PError E.unreachableErrorType + + it "should be returning an unreachable error when we do not accept the connection" $ + let connectConnection destination sessionId (sock, _) = + P.version sock >> P.connectStream sessionId destination sock + + phase2 publicDestinationAccept (sockConnect, _) = do + putStrLn "creating connect session" + (privateDestinationConnect, _) <- P.version sockConnect >> P.createDestination Nothing sockConnect + sessionIdConnect <- P.createSessionWith Nothing privateDestinationConnect S.VirtualStream sockConnect + + putStrLn "start connecting to accept destination" + + -- At this point, we should be able to connect + P.connect "127.0.0.1" "7656" (connectConnection publicDestinationAccept sessionIdConnect) `shouldThrow` U.isI2PError E.unreachableErrorType + + phase1 (sockAccept, _) = do + putStrLn "creating accept session" + (privateDestinationAccept, publicDestinationAccept) <- P.version sockAccept >> P.createDestination Nothing sockAccept + + _ <- P.createSessionWith Nothing privateDestinationAccept S.VirtualStream sockAccept + P.connect "127.0.0.1" "7656" (phase2 publicDestinationAccept) + + in P.connect "127.0.0.1" "7656" phase1 + + + describe "when accepting and connecting to a stream connection" $ do + it "accepted connection and originating connection should be able to communicate" $ + let socketType = S.VirtualStream + + acceptAndTestConnection sessionId connectDestination connectSockMVar finishedTest (sock, _) = do + (acceptSock, acceptDestination) <- P.version sock >> P.acceptStream sessionId sock + + -- The destination we just accepted should equal the destination we + -- connected from. + connectDestination `shouldBe` acceptDestination + + -- Now, let's grab the socket we used to connect and validate we can + -- send messages in both directions. + connectSock <- takeMVar connectSockMVar + + (sent1, recv1) <- testSockets acceptSock connectSock + (sent2, recv2) <- testSockets connectSock acceptSock + + sent1 `shouldBe` recv1 + sent2 `shouldBe` recv2 + + putMVar finishedTest True + return () + + connectConnection destination sessionId connectSockMVar finishedTestMVar (sock, _) = do + P.version sock >> P.connectStream sessionId destination sock + + putMVar connectSockMVar sock + + -- This blocks until the test case is finished, to avoid closing sockets. + finished <- takeMVar finishedTestMVar + finished `shouldBe` True + + phase2 sessionIdAccept publicDestinationAccept (sockConnect, _) = do + (privateDestinationConnect, publicDestinationConnect) <- P.version sockConnect >> P.createDestination Nothing sockConnect + sessionIdConnect <- P.createSessionWith Nothing privateDestinationConnect socketType sockConnect + + finishedTestMVar <- newEmptyMVar + connectSockMVar <- newEmptyMVar + + -- Start accepting connections, and wait for a second to get our + -- 'accept' to come alive. + threadId <- forkIO $ P.connect "127.0.0.1" "7656" (acceptAndTestConnection sessionIdAccept publicDestinationConnect connectSockMVar finishedTestMVar) + threadDelay 1000000 + + -- At this point, we should be able to connect + _ <- P.connect "127.0.0.1" "7656" (connectConnection publicDestinationAccept sessionIdConnect connectSockMVar finishedTestMVar) + + killThread threadId + + phase1 (sockAccept, _) = do + putStrLn "creating accept session" + (privateDestinationAccept, publicDestinationAccept) <- P.version sockAccept >> P.createDestination Nothing sockAccept + + sessionIdAccept <- P.createSessionWith Nothing privateDestinationAccept socketType sockAccept + P.connect "127.0.0.1" "7656" (phase2 sessionIdAccept publicDestinationAccept) + + in P.connect "127.0.0.1" "7656" phase1 + + + + + describe "when sending and receiving datagram messages" $ do + it "should be able to receive a datagram message with a reply destination" $ + let socketTypes = [ S.DatagramRepliable + , S.DatagramAnonymous ] + + createSink socketType sinkSock' sinkDestination' testFinished' (sockSink, _) = do + putStrLn "creating sink session" + (privateDestinationSink, publicDestinationSink) <- P.version sockSink >> P.createDestination Nothing sockSink + _ <- P.createSessionWith Nothing privateDestinationSink socketType sockSink + + putMVar sinkDestination' publicDestinationSink + putMVar sinkSock' sockSink + + -- Block until test is finished, so the sockets stay alive + finished <- readMVar testFinished' + finished `shouldBe` True + + createSource socketType sourceSession testFinished (sockSource, _) = do + putStrLn "creating source session" + (privateDestinationSource, _) <- P.version sockSource >> P.createDestination Nothing sockSource + sessionIdSource <- P.createSessionWith Nothing privateDestinationSource socketType sockSource + + putMVar sourceSession sessionIdSource + + -- Block until test is finished, so the sockets stay alive + finished <- readMVar testFinished + finished `shouldBe` True + + performTest socketType = do + testFinished' <- newEmptyMVar + + -- Our 'source' socket is the party that sends the datagram + sourceSessionId' <- newEmptyMVar + + -- Our 'sink' socket is the party that receives the datagram + sinkSock' <- newEmptyMVar + sinkDestination' <- newEmptyMVar + + _ <- forkIO $ P.connect "127.0.0.1" "7656" (createSink socketType sinkSock' sinkDestination' testFinished') + _ <- forkIO $ P.connect "127.0.0.1" "7656" (createSource socketType sourceSessionId' testFinished') + + -- First, we need our source socket and session id, and the destination + -- where we should send the message to. + sinkDestination <- takeMVar sinkDestination' + sourceSessionId <- takeMVar sourceSessionId' + + -- Now, lets' wait until the sink socket is ready to receive + sinkSock <- takeMVar sinkSock' + + -- Put a message on top of our source socket + P.sendDatagram sourceSessionId sinkDestination (BS8.pack "Hello, world!") + + putStrLn "Now attempting to receive a datagram in the sink" + + -- Wait for a message to arrive on our sink socket + (msg, destination) <- P.receiveDatagram sinkSock + + msg `shouldBe` (BS8.pack "Hello, world!") + + case socketType of + S.DatagramAnonymous -> destination `shouldSatisfy` isNothing + S.DatagramRepliable -> destination `shouldSatisfy` isJust + _ -> fail ("internal error: unrecognized socketType") + + return () + + in mapM performTest socketTypes >> return () + + + it "datagram messages have size limitations" $ + let bigMessage = + BS.concat (replicate 3174 "lorem ipsum hello world foo bar baz") + + createSink sinkDestination (sockSink, _) = do + (publicDestinationSink, _) <- P.version sockSink >> P.createDestination Nothing sockSink + putMVar sinkDestination publicDestinationSink + + createSource sourceSession (sockSource, _) = do + (privateDestinationSource, _) <- P.version sockSource >> P.createDestination Nothing sockSource + sessionIdSource <- P.createSessionWith Nothing privateDestinationSource S.DatagramRepliable sockSource + + putMVar sourceSession sessionIdSource + + performTest = do + -- Our 'source' socket is the party that sends the datagram + sourceSessionId' <- newEmptyMVar + + -- Our 'sink' socket is the party that receives the datagram + sinkDestination' <- newEmptyMVar + + _ <- forkIO $ P.connect "127.0.0.1" "7656" (createSink sinkDestination') + _ <- forkIO $ P.connect "127.0.0.1" "7656" (createSource sourceSessionId') + + -- First, we need our source socket and session id, and the destination + -- where we should send the message to. + sinkDestination <- takeMVar sinkDestination' + sourceSessionId <- takeMVar sourceSessionId' + + -- Put a message on top of our source socket + P.sendDatagram sourceSessionId sinkDestination bigMessage `shouldThrow` U.isI2PError E.messageTooLongErrorType + + return () + + in performTest
+ test/Network/Anonymous/I2P/Util.hs view
@@ -0,0 +1,7 @@+module Network.Anonymous.I2P.Util where + +import qualified Network.Anonymous.I2P.Error as E + +-- | Returns true if exception is of a certain type +isI2PError :: E.I2PErrorType -> E.I2PException -> Bool +isI2PError lhs (E.I2PError rhs) = lhs == rhs
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover -optF --module-name=Spec #-}