From 1e12f0574214cd68b2d201889ff15e79a5cc0076 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Mon, 22 Aug 2016 12:07:17 -0400
Subject: return ProofOfWorkRequirement t

This way the requirement can be varied for different operations.
---
 HTTP.hs | 54 +++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 35 insertions(+), 19 deletions(-)

(limited to 'HTTP.hs')

diff --git a/HTTP.hs b/HTTP.hs
index 13a7bda..c7eb21d 100644
--- a/HTTP.hs
+++ b/HTTP.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 {- Copyright 2016 Joey Hess <id@joeyh.name>
@@ -14,27 +15,26 @@ module HTTP where
 import Types
 import Types.Storage
 import Serialization ()
-import Raaz.Core.Encode
 import Servant.API
 import Data.Text
 import Data.Aeson.Types
 import GHC.Generics hiding (V1)
 import qualified Data.Text.Encoding as T
+import qualified Data.ByteString as B
 import qualified Data.ByteString.Lazy as L
+import qualified Raaz.Core.Encode as Raaz
 
 -- | Keysafe's http API
 type HttpAPI = 
 	"keysafe" :> "apiversion" :> Get '[JSON] APIVersion
 	:<|> "keysafe" :> V1 :> "motd" :> Get '[JSON] Motd
-	:<|> "keysafe" :> V1 :> "proofofwork" :> "requirement" 
-		:> Get '[JSON] (Maybe ProofOfWorkRequirement)
 	:<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam
-		:> Get '[OctetStream] StorableObject
+		:> Get '[JSON] (ProofOfWorkRequirement StorableObject)
 	:<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam
 		:> ReqBody '[OctetStream] StorableObject
-		:> Put '[JSON] StoreResult
+		:> Put '[JSON] (ProofOfWorkRequirement StoreResult)
 	:<|> "keysafe" :> V1 :> "stats" :> "countobjects" :> POWParam
-		:> Get '[JSON] CountResult
+		:> Get '[JSON] (ProofOfWorkRequirement CountResult)
 
 newtype APIVersion = APIVersion Int
 	deriving (Generic)
@@ -44,10 +44,12 @@ type V1 = "v1"
 newtype Motd = Motd Text
 	deriving (Generic)
 
-data ProofOfWorkRequirement = ProofOfWorkRequirement
-	{ leadingZeros :: Int
-	, argon2Iterations :: Int
-	}
+data ProofOfWorkRequirement t
+	= Result t
+	| ProofOfWorkRequirement
+		{ leadingZeros :: Int
+		, argon2Iterations :: Int
+		}
 	deriving (Generic)
 
 newtype ProofOfWork = ProofOfWork Text
@@ -60,24 +62,38 @@ instance ToJSON APIVersion
 instance FromJSON APIVersion
 instance ToJSON Motd
 instance FromJSON Motd
-instance ToJSON ProofOfWorkRequirement
-instance FromJSON ProofOfWorkRequirement
+instance ToJSON t => ToJSON (ProofOfWorkRequirement t)
+instance FromJSON t => FromJSON (ProofOfWorkRequirement t)
 
 instance FromHttpApiData ProofOfWork where
 	parseUrlPiece = Right . ProofOfWork
-
 instance ToHttpApiData ProofOfWork where
 	toUrlPiece (ProofOfWork t) = t
 
-instance FromHttpApiData StorableObjectIdent where
-	parseUrlPiece = Right . StorableObjectIdent . T.encodeUtf8
-
+-- StorableObjectIdent contains a hash, which is valid UTF-8.
 instance ToHttpApiData StorableObjectIdent where
 	toUrlPiece (StorableObjectIdent b) = T.decodeUtf8 b
+instance FromHttpApiData StorableObjectIdent where
+	parseUrlPiece = Right . StorableObjectIdent . T.encodeUtf8
 
 instance MimeRender OctetStream StorableObject where
-	mimeRender _ = L.fromStrict . toByteString
-
+	mimeRender _ = L.fromStrict . Raaz.toByteString
 instance MimeUnrender OctetStream StorableObject where
 	mimeUnrender _ = maybe (Left "object encoding error") Right 
-		. fromByteString . L.toStrict
+		. Raaz.fromByteString . L.toStrict
+
+-- StorableObject contains an arbitrary bytestring; it is not UTF-8 encoded.
+-- So, to convert it to Text for Aeson, base64 encode it.
+instance ToJSON StorableObject where
+	toJSON (StorableObject b) = object [ "data" .= b64 b ]
+instance FromJSON StorableObject where
+	parseJSON (Object v) = StorableObject <$> (unb64 =<< v .: "data")
+	parseJSON invalid = typeMismatch "StorableObject" invalid
+
+b64 :: B.ByteString -> Text
+b64 v = T.decodeUtf8 $ Raaz.toByteString (Raaz.encode v :: Raaz.Base64)
+
+unb64 :: Monad m => Text -> m B.ByteString
+unb64 t = maybe (fail "bad base64 data") (return . Raaz.decodeFormat) f
+  where
+	f = Raaz.fromByteString (T.encodeUtf8 t) :: Maybe Raaz.Base64
-- 
cgit v1.2.3