{-# LANGUAGE ExistentialQuantification #-} -- |Defines the network API required for a Tor implementation to run. module Tor.NetworkStack( TorNetworkStack(..) , SomeNetworkStack(..) , toBackend , recvAll , recvLine ) where import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L import Data.Word import Network.TLS import Tor.DataFormat.TorAddress -- |A network stack, but with the type variables hidden. data SomeNetworkStack = forall lsock sock . HasBackend sock => MkNS (TorNetworkStack lsock sock) -- |The type of a Tor-compatible network stack. The first type variable is the -- type of a listener socket, the second the type of a standard connection -- socket. data TorNetworkStack lsock sock = TorNetworkStack { connect :: String -> Word16 -> IO (Maybe sock) -- |Lookup the given hostname and return any IP6 (Left) or IP4 (Right) -- addresses associated with it. , getAddress :: String -> IO [TorAddress] , listen :: Word16 -> IO lsock , accept :: lsock -> IO (sock, TorAddress) , recv :: sock -> Int -> IO S.ByteString , write :: sock -> L.ByteString -> IO () , flush :: sock -> IO () , close :: sock -> IO () , lclose :: lsock -> IO () } -- |Receive a line of ASCII text from a socket. recvLine :: TorNetworkStack ls s -> s -> IO L.ByteString recvLine ns s = go [] where go acc = do next <- recv ns s 1 case S.uncons next of Nothing -> return (L.pack (reverse acc)) Just (10, _) -> return (L.pack (reverse acc)) Just (f, _) -> go (f:acc) -- |Receive all the input from the socket as a lazy ByteString; this may cause -- the system to block upon some ByteString operations to fetch more data. recvAll :: TorNetworkStack ls s -> s -> IO L.ByteString recvAll ns s = go [] where go acc = do next <- recv ns s 4096 if S.null next then return (L.fromChunks (reverse acc)) else go (next:acc) -- |Convert a Tor-compatible network stack to a TLS-compatible Backend -- structure. toBackend :: TorNetworkStack ls s -> s -> Backend toBackend ns s = Backend { backendFlush = flush ns s , backendClose = close ns s , backendRecv = recv ns s , backendSend = write ns s . L.fromStrict }