blob: 03fd712399413aaae90e8fbc59bb56c89b97a10c (
plain)
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
|
{-# LANGUAGE OverloadedStrings #-}
{- Copyright 2016 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module HTTP.Server (runServer) where
import HTTP
import Types
import Types.Storage
import Storage.Local
import Serialization ()
import Servant
import Network.Wai
import Network.Wai.Handler.Warp
import Control.Monad.IO.Class
runServer :: Port -> IO ()
runServer port = run port app
serverStorage :: Storage
serverStorage = localStorage "server"
app :: Application
app = serve userAPI server
userAPI :: Proxy HttpAPI
userAPI = Proxy
server :: Server HttpAPI
server = apiVersion
:<|> motd
:<|> getObject
:<|> putObject
:<|> countObjects
apiVersion :: Handler APIVersion
apiVersion = return (APIVersion 1)
motd :: Handler Motd
motd = return $ Motd "Hello World!"
getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
getObject i _pow = do
r <- liftIO $ retrieveShare serverStorage dummyShareNum i
case r of
RetrieveSuccess (Share _n o) -> return $ Result o
RetrieveFailure _ -> throwError err404
putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler (ProofOfWorkRequirement StoreResult)
putObject i _pow o = liftIO $ Result
<$> storeShare serverStorage i (Share dummyShareNum o)
countObjects :: Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)
countObjects _pow = liftIO $ Result
<$> countShares serverStorage
-- | 1 is a dummy value; the server does not know the actual share numbers.
dummyShareNum :: ShareNum
dummyShareNum = 1
|