1 files changed, 111 insertions, 0 deletions
diff --git a/HTTP.hs b/HTTP.hs
new file mode 100644
index 0000000..d76a753
--- /dev/null
+++ b/HTTP.hs
@@ -0,0 +1,111 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# 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 HTTP.ProofOfWork
+import Serialization ()
+import Servant.API
+import Data.Text
+import Data.Aeson.Types
+import GHC.Generics hiding (V1)
+import qualified Data.Text as T
+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
+import Data.Monoid
+import Prelude
+
+-- | Keysafe's http API
+type HttpAPI = 
+	"keysafe" :> V1 :> "motd" :> Get '[JSON] Motd
+	:<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam
+		:> Get '[JSON] (POWGuarded StorableObject)
+	:<|> "keysafe" :> V1 :> "objects" :> ObjectIdent :> POWParam
+		:> ReqBody '[OctetStream] StorableObject
+		:> Put '[JSON] (POWGuarded StoreResult)
+	:<|> "keysafe" :> V1 :> "stats" :> "countobjects" :> POWParam
+		:> Get '[JSON] (POWGuarded CountResult)
+
+type V1 = "v1"
+
+newtype Motd = Motd Text
+	deriving (Generic)
+
+data POWGuarded t
+	= Result t
+	| NeedProofOfWork ProofOfWorkRequirement
+	deriving (Generic)
+
+type POWParam = QueryParam "proofofwork" ProofOfWork
+
+type ObjectIdent = Capture "ident" StorableObjectIdent
+
+instance ToJSON Motd
+instance FromJSON Motd
+instance ToJSON t => ToJSON (POWGuarded t)
+instance FromJSON t => FromJSON (POWGuarded t)
+instance ToJSON ProofOfWorkRequirement
+instance FromJSON ProofOfWorkRequirement
+instance ToJSON RequestID
+instance FromJSON RequestID
+instance ToJSON RandomSalt
+instance FromJSON RandomSalt
+
+-- 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 . Raaz.toByteString
+instance MimeUnrender OctetStream StorableObject where
+	mimeUnrender _ = maybe (Left "object encoding error") Right 
+		. 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
+
+-- ProofOfWork contains an arbitrary bytestring and is base64 encoded in
+-- the query string.
+instance ToHttpApiData ProofOfWork where
+	toUrlPiece (ProofOfWork b rid) =
+		fromRandomSalt (randomSalt rid) 
+			<> ":" <> requestHMAC rid 
+			<> ":" <> b64 b
+instance FromHttpApiData ProofOfWork where
+	parseUrlPiece t = do
+		let (salt, rest) = T.break (== ':') t
+		let (hmac, rest') = T.break (== ':') (T.drop 1 rest)
+		b <- unb64 (T.drop 1 rest')
+		return $ ProofOfWork b $ RequestID
+			{ randomSalt = RandomSalt salt
+			, requestHMAC = hmac
+			}
+
+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)
+	(Raaz.fromByteString (T.encodeUtf8 t) :: Maybe Raaz.Base64)