add JSON serialization

Fairly straightforward, but did have to decide how to encode all the
ByteStrings, since they are not necessarily utf-8. Used base64.

This commit was sponsored by Henrik Riomar on Patreon.

1 files changed, 67 insertions, 12 deletions

diff --git a/Types.hs b/Types.hs
index 33df35c..3a04f64 100644
--- a/Types.hs
+++ b/Types.hs
@@ -1,22 +1,35 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveGeneric, FlexibleInstances, OverloadedStrings #-}
+
 module Types where
 
 import Data.ByteString
-import qualified Crypto.Hash as H
+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
 
 -- | Things that the developer sees.
 data Seen = Seen
-	{ seenData :: ByteString
+	{ seenData :: Val
 	}
-	deriving (Show)
+	deriving (Show, Generic)
+
+instance ToJSON Seen
+instance FromJSON Seen
 
 -- | Things that the developer enters.
 data Entered = Entered
-	{ enteredData :: ByteString
-	, echoData :: ByteString
+	{ enteredData :: Val
+	, echoData :: Val
 	-- ^ Data that is expected to be Seen, but has not been received
 	-- at the time this was entered.
 	}
-	deriving (Show)
+	deriving (Show, Generic)
+
+instance ToJSON Entered
+instance FromJSON Entered
 
 -- | An activity (either Entered or Seen) with a pointer
 -- to the Activity before this one.
@@ -25,15 +38,57 @@ data Entered = Entered
 data Activity a
 	= Activity a HashPointer Signature
 	| StartActivity a Signature
-	deriving (Show)
+	deriving (Show, Generic)
+
+instance ToJSON (Activity Seen)
+instance FromJSON (Activity Seen)
+instance ToJSON (Activity Entered)
+instance FromJSON (Activity Entered)
 
 activityContent :: Activity a -> a
 activityContent (Activity a _ _) = a
 activityContent (StartActivity a _) = a
 
-data Signature = Signature ByteString
-	deriving (Show)
+data Signature = Signature
+	{ signature :: Val
+	}
+	deriving (Show, Generic)
+
+instance ToJSON Signature
+instance FromJSON Signature
+
+-- | A hash pointer to something that hashes to this value.
+data HashPointer = HashPointer
+	{ hashMethod :: HashMethod
+	, hashValue :: Val
+	}
+	deriving (Show, Generic, Eq)
+
+instance ToJSON HashPointer
+instance FromJSON HashPointer
+
+data HashMethod = SHA256
+	deriving (Show, Generic, Eq)
+
+instance ToJSON HashMethod
+instance FromJSON HashMethod
+
+-- | 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.
+instance ToJSON Val where
+	toJSON (Val b) = object [ "b" .= b64 b ]
+instance FromJSON Val where
+	parseJSON (Object v) = Val <$> (unb64 =<< v .: "b")
+	parseJSON invalid = typeMismatch "ByteString" invalid
+
+b64 :: ByteString -> T.Text
+b64 = T.decodeUtf8 . B64.encode
 
--- | A SHA2 hash pointer to something that hashes to this value.
-newtype HashPointer = HashPointer (H.Digest H.SHA256)
-	deriving (Show, Eq)
+unb64 :: Monad m => T.Text -> m ByteString
+unb64 t = either
+	(\_ -> fail "bad base64 data")
+	return
+	( B64.decode $ T.encodeUtf8 t)