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
|
{- 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) ""
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 = go Nothing =<< newManager 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 :: ManagerSettings
torableManager = 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)
|
