summaryrefslogtreecommitdiffhomepage
path: root/HTTP/Server.hs
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