{- Copyright 2016 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU AGPL version 3 or higher.
 -}

{-# LANGUAGE OverloadedStrings #-}

module Storage.Network (
	Server(..),
	networkServers,
	networkStorage,
	torableManager
) where

import Types
import Types.Storage
import Data.List
import Data.Char
import HTTP
import HTTP.Client
import Servant.Client
import Network.Wai.Handler.Warp (Port)
import Network.HTTP.Client hiding (port, host)
import Network.HTTP.Client.Internal (Connection, makeConnection)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import qualified Network.Socket
import Network.Socket.ByteString (sendAll, recv)
import Network.Socks5
import qualified Data.ByteString.UTF8 as BU8

type HostName = String

data Server = Server
	{ serverName :: HostName
	, serverPort :: Port
	}

serverUrl :: Server -> BaseUrl
serverUrl srv = BaseUrl Http (serverName srv) (serverPort srv) ""

-- | These can be either tor .onion addresses, or regular hostnames.
-- Using tor is highly recommended, to avoid correlation attacks.
networkServers :: IO [Server]
networkServers = return 
	[ Server "localhost" 8080
	, Server "localhost" 8080
	, Server "localhost" 8080
	]

networkStorage :: Server -> Storage
networkStorage server = Storage
	{ storeShare = store server
	, retrieveShare = retrieve server
	, obscureShares = obscure server
	, countShares = count server
	, moveShares = move server
	}

store :: Server -> StorableObjectIdent -> Share -> IO StoreResult
store srv i (Share _n o) = 
	serverRequest srv StoreFailure id $ \pow ->
		putObject i pow o

retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult
retrieve srv n i = 
	serverRequest srv RetrieveFailure (RetrieveSuccess . Share n) $
		getObject i

-- | Servers should automatically obscure, so do nothing.
-- (Could upload chaff.)
obscure :: Server -> IO ObscureResult
obscure _ = return ObscureSuccess

count :: Server -> IO CountResult
count srv = serverRequest srv CountFailure id countObjects

-- | Not needed for servers.
move :: Server -> Storage -> IO ()
move _ _ = error "move is not implemented for servers"

serverRequest
	:: Server
	-> (String -> a)
	-> (r -> a)
	-> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (ProofOfWorkRequirement r))
	-> IO a
serverRequest srv onerr onsuccess a = 
	-- A new Manager is allocated for each request, rather than reusing
	-- any connection. This is a feature; it makes correlation attacks
	-- harder because the server can't tell if two connections
	-- (over tor) came from the same user.
	go Nothing =<< torableManager
  where
	url = serverUrl srv
	go pow manager = do
		res <- runExceptT $ a pow manager url
		case res of
			Left err -> return $ onerr $ 
				"server failure: " ++ show err
			Right (Result r) -> return $ onsuccess r
			Right needpow -> error "NEEDPOW" -- loop with pow

-- | HTTP Manager supporting tor .onion and regular hosts
torableManager :: IO Manager
torableManager = newManager $ defaultManagerSettings
	{ managerRawConnection = return conn
	}
  where
	conn addr host port
		| ".onion" `isSuffixOf` map toLower host = torConnection host port
		| otherwise = do
			regular <- managerRawConnection defaultManagerSettings
			regular addr host port

torConnection :: HostName -> Port -> IO Connection
torConnection onionaddress p = do
	(socket, _) <- socksConnect torsockconf socksaddr
	socketConnection socket 8192
  where
	torsocksport = 9050
	torsockconf = defaultSocksConf "127.0.0.1" torsocksport
	socksdomain = SocksAddrDomainName (BU8.fromString onionaddress)
	socksaddr = SocksAddress socksdomain (fromIntegral p)

socketConnection :: Network.Socket.Socket -> Int -> IO Connection
socketConnection socket chunksize = makeConnection
	(recv socket chunksize)
	(sendAll socket)
	(Network.Socket.close socket)