From 2a271b27c65a286882332b6268e8946851c52f2a Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 14 Apr 2017 09:38:04 -0400 Subject: 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. --- Types.hs | 79 ++++++++++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 67 insertions(+), 12 deletions(-) (limited to 'Types.hs') 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) -- cgit v1.2.3