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

module HTTP.Client where

import HTTP
import HTTP.ProofOfWork
import Types
import Types.Server
import Types.Storage
import Types.Cost
import Servant.API
import Servant.Client
import Data.Proxy
import Network.HTTP.Client hiding (port, host, Proxy)
import Network.HTTP.Client.Internal (Connection, makeConnection)
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Control.Exception
import qualified Network.Socket
import Network.Socket.ByteString (sendAll, recv)
import Network.Socks5
import qualified Data.ByteString.UTF8 as BU8
import Data.List
import Data.Char

httpAPI :: Proxy HttpAPI
httpAPI = Proxy

motd :: Manager -> BaseUrl -> ClientM Motd
getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded StorableObject)
putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Manager -> BaseUrl -> ClientM (POWGuarded StoreResult)
countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (POWGuarded CountResult)
motd :<|> getObject :<|> putObject :<|> countObjects = client httpAPI

tryA :: IO a -> IO (Either SomeException a)
tryA = try

serverRequest
	:: POWIdent p
	=> Server
	-> (String -> a)
	-> (r -> a)
	-> p
	-> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (POWGuarded r))
	-> IO a
serverRequest srv onerr onsuccess p a = do
	r <- tryA $ go Nothing maxProofOfWork
	case r of
		Left e -> return $ onerr (show e)
		Right v -> return v
  where
	go pow (Seconds timeleft)
		| timeleft <= 0 = return $ onerr "server asked for too much proof of work; gave up"
		| otherwise = do
			res <- serverRequest' srv (a pow)
			case res of
				Left err -> return $ onerr err
				Right (Result r) -> return $ onsuccess r
				Right (NeedProofOfWork req) -> go
					(Just $ genProofOfWork req p)
					(Seconds timeleft - generationTime req)

-- 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
-- accessing different objects came from the same user, except by
-- comparing IP addresses (which are masked somewhat by using tor).
serverRequest'
	:: Server
	-> (Manager -> BaseUrl -> ExceptT ServantError IO r)
	-> IO (Either String r)
serverRequest' srv a = go Nothing (serverUrls srv)
  where
	go lasterr [] = return $ Left $
		maybe "no known address" (\err -> "server failure: " ++ show err) lasterr
	go _ (url:urls) = do
		manager <- torableManager
		res <- runExceptT $ a manager url
		case res of
			Left err -> go (Just err) urls
			Right r -> return (Right r)

-- | 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 :: String -> 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)

serverUrls :: Server -> [BaseUrl]
serverUrls srv = map go (serverAddress srv)
  where
	go (ServerAddress addr port) = BaseUrl Http addr port ""