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
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)
version :: ( MonadIO m
, MonadMask m)
=> Network.Socket
-> m [Integer]
version = versionWithConstraint ([3,1], [3,1])
versionWithConstraint :: ( MonadIO m
, MonadMask m)
=> ([Integer], [Integer])
-> Network.Socket
-> m [Integer]
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
(Just ("OK"), Just v) -> return v
(Just ("NOVERSION"), _) -> E.i2pError (E.mkI2PError E.noVersionErrorType)
_ -> E.i2pError (E.mkI2PError E.protocolErrorType)
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)
createSession :: ( MonadIO m
, MonadMask m)
=> S.SocketType
-> Network.Socket
-> m (String, D.PrivateDestination, D.PublicDestination)
createSession socketType sock = do
(privDestination, pubDestination) <- createDestination Nothing sock
sessionId <- createSessionWith Nothing privDestination socketType sock
return (sessionId, privDestination, pubDestination)
createSessionWith :: ( MonadIO m
, MonadMask m
, D.Acceptable d
, D.Destination d)
=> Maybe String
-> d
-> S.SocketType
-> Network.Socket
-> m String
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
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)
acceptStream :: ( MonadIO m
, MonadMask m)
=> String
-> Network.Socket
-> m (Network.Socket, D.PublicDestination)
acceptStream sessionId sock =
let acceptString :: String -> BS.ByteString
acceptString s =
BS.concat [ "STREAM ACCEPT "
, "ID=", BS8.pack s, " "
, "SILENT=false"
, "\n"]
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
Just ("OK") -> do
dst <- readDestination sock
return (sock, dst)
Just ("INVALID_ID") -> E.i2pError (E.mkI2PError E.invalidIdErrorType)
_ -> E.i2pError (E.mkI2PError E.protocolErrorType)
connectStream :: ( MonadIO m
, MonadMask m
, D.Connectable d
, D.Destination d)
=> String
-> d
-> Network.Socket
-> m ()
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
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)
sendDatagram :: ( MonadIO m
, MonadMask m
, D.Connectable d
, D.Destination d)
=> String
-> d
-> BS.ByteString
-> m ()
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
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)
liftIO $ Network.sendAll sock sendString
return ()
where maxLength = 31744
receiveDatagram :: ( MonadIO m
, MonadMask m)
=> Network.Socket
-> m (BS.ByteString, Maybe D.PublicDestination)
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)