From 7ed6961a0e0ef713c136a9d36f86bc7e31414dc5 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Sat, 20 Aug 2016 17:59:14 -0400
Subject: http client, and --server

---
 CmdLine.hs       |  8 ++++++--
 HTTP.hs          |  6 ++++++
 HTTP/Client.hs   | 27 +++++++++++++++++++++++++++
 HTTP/Server.hs   |  4 +++-
 Types/Storage.hs |  2 ++
 keysafe.cabal    |  2 ++
 keysafe.hs       |  3 +++
 7 files changed, 49 insertions(+), 3 deletions(-)
 create mode 100644 HTTP/Client.hs

diff --git a/CmdLine.hs b/CmdLine.hs
index 14bb185..283e768 100644
--- a/CmdLine.hs
+++ b/CmdLine.hs
@@ -21,12 +21,12 @@ data CmdLine = CmdLine
 	, customShareParams :: Maybe ShareParams
 	}
 
-data Mode = Backup | Restore | UploadQueued | Benchmark
+data Mode = Backup | Restore | UploadQueued | Server | Benchmark
 	deriving (Show)
 
 parse :: Parser CmdLine
 parse = CmdLine
-	<$> optional (backup <|> restore <|> uploadqueued <|> benchmark)
+	<$> optional (backup <|> restore <|> uploadqueued <|> server <|> benchmark)
 	<*> optional (gpgswitch <|> fileswitch)
 	<*> localstorageswitch
 	<*> guiswitch
@@ -45,6 +45,10 @@ parse = CmdLine
 		( long "uploadqueued"
 		<> help "Upload any data to servers that was queued by a previous --backup run."
 		)
+	server = flag' Server
+		( long "server"
+		<> help "Run as a keysafe server, accepting objects and storing them to ~/.keysafe/objects/local/"
+		)
 	benchmark = flag' Benchmark
 		( long "benchmark"
 		<> help "Benchmark speed of keysafe's cryptographic primitives."
diff --git a/HTTP.hs b/HTTP.hs
index ac4eeab..13a7bda 100644
--- a/HTTP.hs
+++ b/HTTP.hs
@@ -66,9 +66,15 @@ instance FromJSON ProofOfWorkRequirement
 instance FromHttpApiData ProofOfWork where
 	parseUrlPiece = Right . ProofOfWork
 
+instance ToHttpApiData ProofOfWork where
+	toUrlPiece (ProofOfWork t) = t
+
 instance FromHttpApiData StorableObjectIdent where
 	parseUrlPiece = Right . StorableObjectIdent . T.encodeUtf8
 
+instance ToHttpApiData StorableObjectIdent where
+	toUrlPiece (StorableObjectIdent b) = T.decodeUtf8 b
+
 instance MimeRender OctetStream StorableObject where
 	mimeRender _ = L.fromStrict . toByteString
 
diff --git a/HTTP/Client.hs b/HTTP/Client.hs
new file mode 100644
index 0000000..e4e9b67
--- /dev/null
+++ b/HTTP/Client.hs
@@ -0,0 +1,27 @@
+{- Copyright 2016 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+module HTTP.Client where
+
+import HTTP
+import Types
+import Types.Storage
+import Servant.API
+import Servant.Client
+import Data.Proxy
+import Network.HTTP.Client (Manager)
+
+apiVersion :: Manager -> BaseUrl -> ClientM APIVersion
+motd :: Manager -> BaseUrl -> ClientM Motd
+proofOfWorkRequirement :: Manager -> BaseUrl -> ClientM (Maybe ProofOfWorkRequirement)
+getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM StorableObject
+putObject :: StorableObjectIdent -> Maybe ProofOfWork -> Types.StorableObject -> Manager -> BaseUrl -> ClientM StoreResult
+countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM CountResult
+apiVersion 
+	:<|> motd
+	:<|> proofOfWorkRequirement
+	:<|> getObject
+	:<|> putObject
+	:<|> countObjects = client (Proxy :: Proxy HttpAPI)
diff --git a/HTTP/Server.hs b/HTTP/Server.hs
index 5df3d06..a6b0f2d 100644
--- a/HTTP/Server.hs
+++ b/HTTP/Server.hs
@@ -1,9 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 {- Copyright 2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module HTTP.Server where
+module HTTP.Server (runServer) where
 
 import HTTP
 import Types
diff --git a/Types/Storage.hs b/Types/Storage.hs
index 5032949..d8cc181 100644
--- a/Types/Storage.hs
+++ b/Types/Storage.hs
@@ -46,4 +46,6 @@ data CountResult = CountResult Integer | CountFailure String
 	deriving (Show, Generic)
 
 instance ToJSON StoreResult
+instance FromJSON StoreResult
 instance ToJSON CountResult
+instance FromJSON CountResult
diff --git a/keysafe.cabal b/keysafe.cabal
index 0e7ff5e..1289629 100644
--- a/keysafe.cabal
+++ b/keysafe.cabal
@@ -50,6 +50,7 @@ Executable keysafe
     , aeson == 0.11.*
     , wai == 3.2.*
     , warp == 3.2.*
+    , http-client == 0.4.*
 
     -- Inlined to change the finite field size to 256
     -- for efficient serialization.
@@ -73,6 +74,7 @@ Executable keysafe
     ExpensiveHash
     Gpg
     HTTP
+    HTTP.Client
     HTTP.Server
     SecretKey
     Serialization
diff --git a/keysafe.hs b/keysafe.hs
index 2af2ad2..2b40842 100644
--- a/keysafe.hs
+++ b/keysafe.hs
@@ -18,6 +18,7 @@ import Cost
 import SecretKey
 import Share
 import Storage
+import HTTP.Server
 import qualified Gpg
 import Data.Maybe
 import Data.Time.Clock
@@ -62,6 +63,8 @@ dispatch cmdline ui storagelocations tunables possibletunables = do
 		restore storagelocations ui possibletunables Gpg.anyKey
 	go CmdLine.UploadQueued _ =
 		uploadQueued
+	go CmdLine.Server _ =
+		runServer 80
 	go CmdLine.Benchmark _ =
 		benchmarkTunables tunables
 
-- 
cgit v1.2.3