blob: f024b9ddca8f4802d1afdf5a9d6cc8cb7cde046f (
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
|
{- Copyright 2017 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, FlexibleInstances, OverloadedStrings #-}
module Val where
import Memory
import JSON
import GHC.Generics (Generic)
import Data.Aeson.Types
import qualified Codec.Binary.Base64 as B64
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.ByteString as B
import qualified Data.Semigroup as Sem
-- | Newtype of ByteString so we can have JSON instances without orphans.
newtype Val = Val { val :: B.ByteString }
deriving (Show, Generic, Eq, Sem.Semigroup, Monoid)
instance DataSize Val where
dataSize (Val b) = fromIntegral (B.length b)
-- | JSON instances for Val, using base64 encoding when the value
-- is not utf-8 encoded, and otherwise using a more efficient encoding.
instance ToJSON Val where
toJSON (Val b) = case T.decodeUtf8' b of
Right v -> object [ "v" .= v ]
Left _ -> object [ "b64" .= b64 b ]
instance FromJSON Val where
parseJSON (Object o) = do
mv <- o .:? "v"
case mv of
Just v -> return $ Val $ T.encodeUtf8 v
Nothing -> Val <$> (unb64 =<< o .: "b64")
parseJSON invalid = typeMismatch "ByteString" invalid
b64 :: B.ByteString -> T.Text
b64 = T.decodeUtf8 . B64.encode
unb64 :: Monad m => T.Text -> m B.ByteString
unb64 t = either
(\_ -> fail "bad base64 data")
return
( B64.decode $ T.encodeUtf8 t)
|
