summaryrefslogtreecommitdiffhomepage
path: root/HTTP
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2016-08-22 12:45:25 -0400
committerJoey Hess <joeyh@joeyh.name>2016-08-22 12:45:25 -0400
commitd2ebdb398ad8bcfa16f8b8d62a833da09d436e72 (patch)
treeeac2c53f88494cfe7e0edfc9fef93b092da6a00c /HTTP
parent9762ac8da9b938a40423b79966b35be080686620 (diff)
downloadkeysafe-d2ebdb398ad8bcfa16f8b8d62a833da09d436e72.tar.gz
wire up server to file storage
Diffstat (limited to 'HTTP')
-rw-r--r--HTTP/Server.hs25
1 files changed, 19 insertions, 6 deletions
diff --git a/HTTP/Server.hs b/HTTP/Server.hs
index e941158..03fd712 100644
--- a/HTTP/Server.hs
+++ b/HTTP/Server.hs
@@ -10,16 +10,19 @@ module HTTP.Server (runServer) where
import HTTP
import Types
import Types.Storage
+import Storage.Local
import Serialization ()
-import Servant.API
-import Servant.Server
-import Data.Proxy
+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
@@ -40,10 +43,20 @@ motd :: Handler Motd
motd = return $ Motd "Hello World!"
getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
-getObject _i _pow = return $ ProofOfWorkRequirement 10 10
+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 = return $ Result StoreSuccess
+putObject i _pow o = liftIO $ Result
+ <$> storeShare serverStorage i (Share dummyShareNum o)
countObjects :: Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)
-countObjects _pow = return $ Result $ CountResult 42
+countObjects _pow = liftIO $ Result
+ <$> countShares serverStorage
+
+-- | 1 is a dummy value; the server does not know the actual share numbers.
+dummyShareNum :: ShareNum
+dummyShareNum = 1