diff options
| -rw-r--r-- | HTTP.hs | 77 | ||||
| -rw-r--r-- | HTTP/Server.hs | 51 | ||||
| -rw-r--r-- | Types/Storage.hs | 13 | ||||
| -rw-r--r-- | keysafe.cabal | 8 | ||||
| -rw-r--r-- | stack.yaml | 2 |
5 files changed, 147 insertions, 4 deletions
@@ -0,0 +1,77 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + +{- Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +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.Lazy as L + +-- | 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 + :<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam + :> ReqBody '[OctetStream] StorableObject + :> Put '[JSON] StoreResult + :<|> "keysafe" :> V1 :> "stats" :> "countobjects" :> POWParam + :> Get '[JSON] CountResult + +newtype APIVersion = APIVersion Int + deriving (Generic) + +type V1 = "v1" + +newtype Motd = Motd Text + deriving (Generic) + +data ProofOfWorkRequirement = ProofOfWorkRequirement + { leadingZeros :: Int + , argon2Iterations :: Int + } + deriving (Generic) + +newtype ProofOfWork = ProofOfWork Text + +type POWParam = QueryParam "proofofwork" ProofOfWork + +type ObjectIdent = Capture "ident" StorableObjectIdent + +instance ToJSON APIVersion +instance FromJSON APIVersion +instance ToJSON Motd +instance FromJSON Motd +instance ToJSON ProofOfWorkRequirement +instance FromJSON ProofOfWorkRequirement + +instance FromHttpApiData ProofOfWork where + parseUrlPiece = Right . ProofOfWork + +instance FromHttpApiData StorableObjectIdent where + parseUrlPiece = Right . StorableObjectIdent . T.encodeUtf8 + +instance MimeRender OctetStream StorableObject where + mimeRender _ = L.fromStrict . toByteString + +instance MimeUnrender OctetStream StorableObject where + mimeUnrender _ = maybe (Left "object encoding error") Right + . fromByteString . L.toStrict diff --git a/HTTP/Server.hs b/HTTP/Server.hs new file mode 100644 index 0000000..5df3d06 --- /dev/null +++ b/HTTP/Server.hs @@ -0,0 +1,51 @@ +{- Copyright 2016 Joey Hess <id@joeyh.name> + - + - Licensed under the GNU AGPL version 3 or higher. + -} + +module HTTP.Server where + +import HTTP +import Types +import Types.Storage +import Serialization () +import Servant.API +import Servant.Server +import Data.Proxy +import Network.Wai +import Network.Wai.Handler.Warp + +runServer :: Int -> IO () +runServer port = run port app + +app :: Application +app = serve userAPI server + +userAPI :: Proxy HttpAPI +userAPI = Proxy + +server :: Server HttpAPI +server = apiVersion + :<|> motd + :<|> proofOfWorkRequirement + :<|> getObject + :<|> putObject + :<|> countObjects + +apiVersion :: Handler APIVersion +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 StorableObject +getObject _i _pow = undefined + +putObject :: StorableObjectIdent -> Maybe ProofOfWork -> StorableObject -> Handler StoreResult +putObject _i _pow _o = return StoreSuccess + +countObjects :: Maybe ProofOfWork -> Handler CountResult +countObjects _pow = return $ CountResult 42 diff --git a/Types/Storage.hs b/Types/Storage.hs index 01ae0ad..5032949 100644 --- a/Types/Storage.hs +++ b/Types/Storage.hs @@ -4,10 +4,13 @@ -} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE DeriveGeneric #-} module Types.Storage where import Types +import GHC.Generics +import Data.Aeson.Types -- | All known locations where shares can be stored, ordered with -- preferred locations first. @@ -31,12 +34,16 @@ data Storage = Storage } data StoreResult = StoreSuccess | StoreAlreadyExists | StoreFailure String - deriving (Show) + deriving (Show, Generic) data RetrieveResult = RetrieveSuccess Share | RetrieveFailure String + deriving (Generic) data ObscureResult = ObscureSuccess | ObscureFailure String - deriving (Show) + deriving (Show, Generic) data CountResult = CountResult Integer | CountFailure String - deriving (Show) + deriving (Show, Generic) + +instance ToJSON StoreResult +instance ToJSON CountResult diff --git a/keysafe.cabal b/keysafe.cabal index 6b82779..0e7ff5e 100644 --- a/keysafe.cabal +++ b/keysafe.cabal @@ -44,6 +44,12 @@ Executable keysafe , optparse-applicative == 0.12.* , readline == 1.0.* , zxcvbn-c == 1.0.* + , servant (>= 0.7 && < 0.9) + , servant-server (>= 0.7 && < 0.9) + , servant-client (>= 0.7 && < 0.9) + , aeson == 0.11.* + , wai == 3.2.* + , warp == 3.2.* -- Inlined to change the finite field size to 256 -- for efficient serialization. @@ -66,6 +72,8 @@ Executable keysafe Entropy ExpensiveHash Gpg + HTTP + HTTP.Server SecretKey Serialization Share @@ -1,6 +1,6 @@ packages: - '.' -resolver: lts-5.18 +resolver: lts-6.12 extra-deps: - dice-entropy-conduit-1.0.0.1 - finite-field-0.8.0 |