summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2016-08-22 12:07:17 -0400
committerJoey Hess <joeyh@joeyh.name>2016-08-22 12:23:53 -0400
commit1e12f0574214cd68b2d201889ff15e79a5cc0076 (patch)
treee086991e403591205fa73d25129bfac1fc9b1ac8
parent7ed6961a0e0ef713c136a9d36f86bc7e31414dc5 (diff)
downloadkeysafe-1e12f0574214cd68b2d201889ff15e79a5cc0076.tar.gz
return ProofOfWorkRequirement t
This way the requirement can be varied for different operations.
-rw-r--r--HTTP.hs54
-rw-r--r--HTTP/Client.hs8
-rw-r--r--HTTP/Server.hs18
-rw-r--r--Types.hs5
4 files changed, 48 insertions, 37 deletions
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
diff --git a/HTTP/Client.hs b/HTTP/Client.hs
index e4e9b67..2120217 100644
--- a/HTTP/Client.hs
+++ b/HTTP/Client.hs
@@ -15,13 +15,11 @@ 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
+getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (ProofOfWorkRequirement StorableObject)
+putObject :: StorableObjectIdent -> Maybe ProofOfWork -> Types.StorableObject -> Manager -> BaseUrl -> ClientM (ProofOfWorkRequirement StoreResult)
+countObjects :: Maybe ProofOfWork -> Manager -> BaseUrl -> ClientM (ProofOfWorkRequirement CountResult)
apiVersion
:<|> motd
- :<|> proofOfWorkRequirement
:<|> getObject
:<|> putObject
:<|> countObjects = client (Proxy :: Proxy HttpAPI)
diff --git a/HTTP/Server.hs b/HTTP/Server.hs
index a6b0f2d..e941158 100644
--- a/HTTP/Server.hs
+++ b/HTTP/Server.hs
@@ -17,7 +17,7 @@ import Data.Proxy
import Network.Wai
import Network.Wai.Handler.Warp
-runServer :: Int -> IO ()
+runServer :: Port -> IO ()
runServer port = run port app
app :: Application
@@ -29,7 +29,6 @@ userAPI = Proxy
server :: Server HttpAPI
server = apiVersion
:<|> motd
- :<|> proofOfWorkRequirement
:<|> getObject
:<|> putObject
:<|> countObjects
@@ -40,14 +39,11 @@ apiVersion = return (APIVersion 1)
motd :: Handler Motd
motd = return $ Motd "Hello World!"
-proofOfWorkRequirement :: Handler (Maybe ProofOfWorkRequirement)
-proofOfWorkRequirement = return $ Just $ ProofOfWorkRequirement 3 1
+getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Handler (ProofOfWorkRequirement StorableObject)
+getObject _i _pow = return $ ProofOfWorkRequirement 10 10
-getObject :: StorableObjectIdent -> Maybe ProofOfWork -> Handler StorableObject
-getObject _i _pow = undefined
+putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler (ProofOfWorkRequirement StoreResult)
+putObject _i _pow _o = return $ Result StoreSuccess
-putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler StoreResult
-putObject _i _pow _o = return StoreSuccess
-
-countObjects :: Maybe ProofOfWork -> Handler CountResult
-countObjects _pow = return $ CountResult 42
+countObjects :: Maybe ProofOfWork -> Handler (ProofOfWorkRequirement CountResult)
+countObjects _pow = return $ Result $ CountResult 42
diff --git a/Types.hs b/Types.hs
index e66e3b2..a132f26 100644
--- a/Types.hs
+++ b/Types.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, MultiParamTypeClasses, FlexibleInstances, DeriveGeneric #-}
{- Copyright 2016 Joey Hess <id@joeyh.name>
-
@@ -11,6 +11,7 @@ import Types.Cost
import qualified Data.ByteString as B
import Data.String
import Control.DeepSeq
+import GHC.Generics (Generic)
-- | keysafe stores secret keys.
newtype SecretKey = SecretKey B.ByteString
@@ -29,7 +30,7 @@ instance Bruteforceable EncryptedSecretKey UnknownPassword where
-- | An object in a form suitable to be stored on a keysafe server.
newtype StorableObject = StorableObject { fromStorableObject :: B.ByteString }
- deriving (Show, Eq, Ord)
+ deriving (Show, Eq, Ord, Generic)
-- | An identifier for a StorableObject
newtype StorableObjectIdent = StorableObjectIdent B.ByteString