From b5d5f86a88c8dbd1cee9e28a659bfe1c26f38eaa Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 14 Apr 2017 10:05:13 -0400
Subject: improve JSON

Most of the time, ByteStrings will be able to be encoded as utf8, so avoid
base64 when not needed.

Adjusted some of the types in order to generate more usual JSON. In particular,
removed StartActivity.

The JSON now looks like this (with the signature still not populated):

{"signature":{"v":""},"prevActivity":{"hashValue":{"v":"3b1abe614dd43bdb2d9a56777884e2d0f3bac9796e2d25c1ad52bb689c117286"},"hashMethod":"SHA256"},"activity":{"echoData":{"v":""},"enteredData":{"v":"l"}}}

203 bytes to send a single keystroke is not great when there's really
only 1+64(hash) bytes of unique data. So, may end up adding a wire
encoding on top of this. But, JSON is good to have for storage of the
proofs, etc.

Also, it does compress well. Two such JSON objects gzip -9 to 219
bytes, and three to 265 bytes. So, 37 bytes per keystroke. This is
*exactly* as efficient as gzip -9 of $c$hash formatted data.

This commit was sponsored by Jack Hill on Patreon.
---
 Val.hs | 38 ++++++++++++++++++++++++++++++++++++++
 1 file changed, 38 insertions(+)
 create mode 100644 Val.hs

(limited to 'Val.hs')

diff --git a/Val.hs b/Val.hs
new file mode 100644
index 0000000..86a35c9
--- /dev/null
+++ b/Val.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, FlexibleInstances, OverloadedStrings #-}
+
+module Val where
+
+import Data.ByteString
+import GHC.Generics (Generic)
+import Data.Aeson
+import Data.Aeson.Types
+import qualified Codec.Binary.Base64 as B64
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+
+-- | Newtype of ByteString so we can have JSON instances without orphans.
+newtype Val = Val { val :: ByteString }
+	deriving (Show, Generic, Eq, Monoid)
+
+-- | 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 :: ByteString -> T.Text
+b64 = T.decodeUtf8 . B64.encode
+
+unb64 :: Monad m => T.Text -> m ByteString
+unb64 t = either
+	(\_ -> fail "bad base64 data")
+	return
+	( B64.decode $ T.encodeUtf8 t)
-- 
cgit v1.2.3