1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
|
{- 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 Types.Cost
import Data.List
import Data.Char
import HTTP
import HTTP.Client
import HTTP.ProofOfWork
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 "vzgrspuxbtnlrtup.onion" 4242 -- keysafe.joeyh.name
, Server "localhost" 4242
, Server "localhost" 4242
]
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 i $ \pow ->
putObject i pow o
retrieve :: Server -> ShareNum -> StorableObjectIdent -> IO RetrieveResult
retrieve srv n i =
serverRequest srv RetrieveFailure (RetrieveSuccess . Share n) i $
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 NoPOWIdent countObjects
-- | Not needed for servers.
move :: Server -> Storage -> IO ()
move _ _ = error "move is not implemented for servers"
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 = go Nothing maxProofOfWork
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)
serverRequest'
:: Server
-> (Manager -> BaseUrl -> ExceptT ServantError IO r)
-> IO (Either String r)
serverRequest' srv a = do
-- 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).
manager <- torableManager
res <- runExceptT $ a manager url
return $ case res of
Left err -> Left $ "server failure: " ++ show err
Right r -> Right r
where
url = serverUrl srv
-- | 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)
|
