blob: d76a753fe1c58cd79a8f9bbf619815e631779d53 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
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)
|
