module Network.Tox.Onion.Transport
    ( parseOnionAddr
    , encodeOnionAddr
    , parseDataToRoute
    , encodeDataToRoute
    , forwardOnions
    , AliasSelector(..)
    , OnionDestination(..)
    , OnionMessage(..)
    , Rendezvous(..)
    , DataToRoute(..)
    , OnionData(..)
    , AnnouncedRendezvous(..)
    , AnnounceResponse(..)
    , AnnounceRequest(..)
    , Forwarding(..)
    , ReturnPath(..)
    , OnionRequest(..)
    , OnionResponse(..)
    , Addressed(..)
    , UDPTransport
    , KeyRecord(..)
    , encrypt
    , decrypt
    , peelSymmetric
    , OnionRoute(..)
    , dummyRoute
    , N0
    , N1
    , N2
    , N3
    , onionKey
    , onionAliasSelector
    , selectAlias
    , RouteId(..)
    , routeId
    , putRequest
    , wrapForRoute
    , wrapSymmetric
    , wrapOnion
    , wrapOnionPure
    , unwrapAnnounceResponse
    , wrapIndirectHops
    ) where

import qualified Data.ByteString as B
         ;import Data.ByteString (ByteString)
import Data.Maybe
import Data.Serialize
import Network.Socket

import Crypto.Tox hiding (encrypt,decrypt)
import Network.Tox.TCP.NodeId (udpNodeInfo)
import qualified Data.Tox.Relay as TCP
import Data.Tox.Onion
import Network.Address (nullAddress4)
import Network.Tox.DHT.Transport (SendNodes(..))
import Network.Tox.NodeId
import Network.QueryResponse

encodeOnionAddr :: TransportCrypto
                   -> (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
                   -> (OnionMessage Encrypted,OnionDestination RouteId)
                   -> IO (Maybe (ByteString, SockAddr))
encodeOnionAddr crypto _ (msg,OnionToOwner ni p) =
    return $ Just ( runPut $ putResponse (OnionResponse p msg)
                  , nodeAddr ni )
encodeOnionAddr crypto getRoute (msg,OnionDestination x ni Nothing) = do
    encodeOnionAddr crypto getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
encodeOnionAddr crypto getRoute (msg,OnionDestination _ ni (Just rid)) = do
    let go route = do
            req <- wrapForRoute crypto msg ni route
            return ( runPut $ putRequest req , nodeAddr $ routeNodeA route)
    m <- {-# SCC "encodeOnionAddr.getRoute" #-} getRoute ni rid
    x <- {-# SCC "encodeOnionAddr.wrapForRoute" #-} mapM go m
    return x

wrapForRoute :: TransportCrypto
                      -> OnionMessage Encrypted
                      -> NodeInfo
                      -> OnionRoute
                      -> IO (OnionRequest N0)
wrapForRoute crypto msg ni r =
    wrapIndirectHops crypto msg ni r $ \nonce saddr msg' -> do
        fwd <- wrapOnion crypto (routeAliasA r)
                                nonce
                                (id2key . nodeId $ routeNodeA r)
                                saddr
                                msg'
        return $ OnionRequest { onionNonce    = nonce
                              , onionForward  = fwd
                              , pathFromOwner = NoReturnPath
                              }

wrapIndirectHops :: TransportCrypto
                      -> OnionMessage Encrypted
                      -> NodeInfo
                      -> OnionRoute
                      -> (Nonce24 -> SockAddr -> Forwarding N2 (OnionMessage Encrypted) -> IO a)
                      -> IO a
wrapIndirectHops crypto msg ni r fin = do
    let nonce = msgNonce msg
    fwd <- wrapOnion crypto (routeAliasB r)
                             nonce
                             (id2key . nodeId $ routeNodeB r)
                             (nodeAddr $ routeNodeC r)
        =<< wrapOnion crypto (routeAliasC r)
                             nonce
                             (id2key . nodeId $ routeNodeC r)
                             (nodeAddr ni)
                             (NotForwarded msg)
    fin nonce (nodeAddr $ routeNodeB r) fwd

unwrapAnnounceResponse :: Maybe NodeId -> NodeInfo -> AnnounceResponse -> ([NodeInfo], [Rendezvous], Maybe Nonce32)
unwrapAnnounceResponse alias ni (AnnounceResponse is_stored (SendNodes ns0)) | let ns = map udpNodeInfo ns0
    = case is_stored of
        NotStored n32    -> ( ns , []                                                        , Just n32)
        SendBackKey k    -> ( ns , [Rendezvous k ni]                                         , Nothing )
        Acknowledged n32 -> ( ns , maybeToList $ fmap (\k -> Rendezvous (id2key k) ni) alias , Just n32)