diff options
Diffstat (limited to 'HTTP')
| -rw-r--r-- | HTTP/Client.hs | 25 | ||||
| -rw-r--r-- | HTTP/ProofOfWork.hs | 4 | ||||
| -rw-r--r-- | HTTP/Server.hs | 1 |
3 files changed, 11 insertions, 19 deletions
diff --git a/HTTP/Client.hs b/HTTP/Client.hs index 25ff536..9626eab 100644 --- a/HTTP/Client.hs +++ b/HTTP/Client.hs @@ -15,11 +15,8 @@ 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 Network.HTTP.Client.Internal (Connection) 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 @@ -28,10 +25,10 @@ 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 :: ClientM Motd +getObject :: StorableObjectIdent -> Maybe ProofOfWork -> ClientM (POWGuarded StorableObject) +putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> ClientM (POWGuarded StoreResult) +countObjects :: Maybe ProofOfWork -> ClientM (POWGuarded CountResult) motd :<|> getObject :<|> putObject :<|> countObjects = client httpAPI tryA :: IO a -> IO (Either SomeException a) @@ -43,7 +40,7 @@ serverRequest -> (String -> a) -> (r -> a) -> p - -> (Maybe ProofOfWork -> Manager -> BaseUrl -> ExceptT ServantError IO (POWGuarded r)) + -> (Maybe ProofOfWork -> ClientM (POWGuarded r)) -> IO a serverRequest srv onerr onsuccess p a = do r <- tryA $ go Nothing maxProofOfWork @@ -69,7 +66,7 @@ serverRequest srv onerr onsuccess p a = do -- comparing IP addresses (which are masked somewhat by using tor). serverRequest' :: Server - -> (Manager -> BaseUrl -> ExceptT ServantError IO r) + -> (ClientM r) -> IO (Either String r) serverRequest' srv a = go Nothing (serverUrls srv) where @@ -77,7 +74,7 @@ serverRequest' srv a = go Nothing (serverUrls srv) maybe "no known address" (\err -> "server failure: " ++ show err) lasterr go _ (url:urls) = do manager <- torableManager - res <- runExceptT $ a manager url + res <- runClientM a (ClientEnv manager url) case res of Left err -> go (Just err) urls Right r -> return (Right r) @@ -104,12 +101,6 @@ torConnection onionaddress p = do 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 diff --git a/HTTP/ProofOfWork.hs b/HTTP/ProofOfWork.hs index 61fea20..54e2223 100644 --- a/HTTP/ProofOfWork.hs +++ b/HTTP/ProofOfWork.hs @@ -16,7 +16,7 @@ import ByteStrings import GHC.Generics import qualified Data.Text as T import qualified Data.ByteString as B -import Data.Text.Encoding (encodeUtf8) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) import Raaz.Core.Encode import qualified Raaz import Data.BloomFilter.Hash @@ -109,7 +109,7 @@ mkRequestID secret = mkRequeestID' secret <$> mkRandomSalt mkRequeestID' :: RequestIDSecret -> RandomSalt -> RequestID mkRequeestID' (RequestIDSecret key) salt = let hmac = Raaz.hmacSha256 key (encodeUtf8 $ fromRandomSalt salt) - in RequestID salt (T.pack (showBase16 hmac)) + in RequestID salt $ decodeUtf8 $ Raaz.toByteString (Raaz.encode hmac :: Base16) validRequestID :: RequestIDSecret -> RequestID -> Bool validRequestID secret rid = diff --git a/HTTP/Server.hs b/HTTP/Server.hs index 61bdbfd..1abcc56 100644 --- a/HTTP/Server.hs +++ b/HTTP/Server.hs @@ -18,6 +18,7 @@ import CmdLine (ServerConfig(..)) import Storage.Local import Serialization () import Servant +import Network.Wai (Application) import Network.Wai.Handler.Warp import Control.Monad.IO.Class import Control.Concurrent |