diff options
author | Joey Hess <joeyh@joeyh.name> | 2016-08-22 12:07:17 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2016-08-22 12:23:53 -0400 |
commit | 1e12f0574214cd68b2d201889ff15e79a5cc0076 (patch) | |
tree | e086991e403591205fa73d25129bfac1fc9b1ac8 /HTTP.hs | |
parent | 7ed6961a0e0ef713c136a9d36f86bc7e31414dc5 (diff) | |
download | keysafe-1e12f0574214cd68b2d201889ff15e79a5cc0076.tar.gz |
return ProofOfWorkRequirement t
This way the requirement can be varied for different operations.
Diffstat (limited to 'HTTP.hs')
-rw-r--r-- | HTTP.hs | 54 |
1 files changed, 35 insertions, 19 deletions
@@ -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 |