diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2017-08-16 11:41:25 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2017-08-16 11:41:25 -0700 |
| commit | 379f036b39e0f7dac360ba04b281f6ea4ce8f20e (patch) | |
| tree | 01a86517d6234562088561c3c4b51365ed722807 /HTTP/Client.hs | |
| parent | 680449e656820db2b899a8631060cf62359b9b74 (diff) | |
| parent | 0229f026b1ae0344c4c052593564800035268d81 (diff) | |
| download | keysafe-379f036b39e0f7dac360ba04b281f6ea4ce8f20e.tar.gz | |
Merge tag '0.20170811'
tagging package keysafe version 0.20170811
# gpg: Signature made Fri 11 Aug 2017 03:58:54 PM MST
# gpg: using RSA key 28A500C35207EAB72F6C0F25DB12DB0FF05F8F38
# gpg: Good signature from "Joey Hess <joeyh@joeyh.name>" [full]
# Primary key fingerprint: E85A 5F63 B31D 24C1 EBF0 D81C C910 D922 2512 E3C7
# Subkey fingerprint: 28A5 00C3 5207 EAB7 2F6C 0F25 DB12 DB0F F05F 8F38
Diffstat (limited to 'HTTP/Client.hs')
| -rw-r--r-- | HTTP/Client.hs | 25 |
1 files changed, 8 insertions, 17 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 |