diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,3 +1,20 @@ +scuttlebutt-types (0.3.0) unstable; urgency=medium + + * Handle about messages whose image field is a string linking to a blob, + rather than an object. + * Removed ToJSON instance for Message, until something can be done about + https://github.com/ssbc/ssb-feed/issues/11 + * Added contentType. + * Support parsing a Post with multiple branches. + * Support parsing a Post when its mentions field is an object rather than + an array. + * Changes to Message data type to support above changes. (API change) + * Support parsing a Post that mentions something that is a not a valid + ssb link. + * Added description to About. + + -- Joey Hess Fri, 06 Oct 2017 14:48:37 -0400 + scuttlebutt-types (0.2.0) unstable; urgency=medium * Improved Link types. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -3,7 +3,10 @@ This library contains Haskell data types for common Secure Scuttlebutt -messages, including JSON serialization. +messages, including JSON deserialization. + +(JSON serialization support is blocked by +) Git repositories: diff --git a/scuttlebutt-types.cabal b/scuttlebutt-types.cabal --- a/scuttlebutt-types.cabal +++ b/scuttlebutt-types.cabal @@ -1,5 +1,5 @@ Name: scuttlebutt-types -Version: 0.2.0 +Version: 0.3.0 License: BSD3 License-File: LICENSE Author: bkil.hu, Peter Ferenc Hajdu, Joey Hess @@ -15,7 +15,7 @@ optimized for efficient replication for peer to peer protocols. . This library contains data types for common Scuttlebutt messages, - including JSON serialization. + including JSON deserialization. Library Hs-Source-Dirs: src @@ -34,7 +34,8 @@ ed25519, cryptonite, text, - memory + memory, + vector Default-Language: Haskell2010 Test-Suite scuttlebutt-types-test diff --git a/src/Ssb/Types/Message.hs b/src/Ssb/Types/Message.hs --- a/src/Ssb/Types/Message.hs +++ b/src/Ssb/Types/Message.hs @@ -1,14 +1,17 @@ -{-# LANGUAGE DeriveGeneric, OverloadedStrings, FlexibleContexts #-} +{-# LANGUAGE DeriveGeneric, OverloadedStrings, FlexibleContexts, GeneralizedNewtypeDeriving #-} module Ssb.Types.Message ( Signature, Message(..), messageLink, AnyContent(..), + contentType, parseMessage, narrowParse, PrivateContent(..), Post(..), + Branch(..), + Mentions(..), Mention(..), About(..), AboutImage(..), @@ -30,6 +33,7 @@ import Data.Char import Control.Applicative import qualified Data.Text as T +import qualified Data.Vector as V import qualified Data.ByteString.Lazy as L import Prelude hiding (sequence) @@ -47,7 +51,6 @@ } deriving (Show, Eq, Generic) instance FromJSON a => FromJSON (Message a) -instance ToJSON a => ToJSON (Message a) instance Functor Message where fmap f m = m { content = f (content m) } @@ -68,6 +71,13 @@ instance FromJSON AnyContent where parseJSON = pure . AnyContent +-- | Get the declared type of content in a Message AnyContent. +contentType :: Message AnyContent -> T.Text +contentType = fromMaybe "" + . parseMaybe (withObject "AnyContent" (.: "type")) + . fromAnyContent + . content + -- | For best efficiency when the type of a message is not known, -- first parse to a Message AnyContent, and then use this function -- with `parseMaybe` or `parseEither` to try to further parse that @@ -101,17 +111,44 @@ { text :: T.Text , channel :: Maybe T.Text , root :: Maybe MessageLink - , branch :: Maybe MessageLink + , branch :: Maybe Branch , recps :: Maybe [FeedLink] - , mentions :: Maybe [Mention] + , mentions :: Maybe Mentions } deriving (Show, Eq, Generic) instance FromJSON Post where parseJSON = parseMessageType "post" (genericParseJSON defaultOptions) --- | A generic reference to other feeds, entities, or blobs +-- | Link to the message in the thread that a Post replies to. +-- +-- Generally there is only one link, but sometimes more than one. +newtype Branch = Branch { fromBranch :: [MessageLink] } + deriving (Show, Eq, Monoid) + +instance FromJSON Branch where + parseJSON v@(String _) = Branch . (:[]) <$> parseJSON v + parseJSON v@(Array _) = Branch <$> parseJSON v + parseJSON invalid = typeMismatch "Branch" invalid + +newtype Mentions = Mentions { fromMentions :: [Mention] } + deriving (Show, Eq, Monoid) + +-- | Sometimes it's an array of objects. +-- Sometimes there is no array, but a single object. +-- And sometimes the Mention contains an invalid Link; avoid failing on +-- those. +instance FromJSON Mentions where + parseJSON v@(Object _) = pure $ + Mentions $ catMaybes [parseMaybe parseJSON v] + parseJSON (Array v) = pure $ + Mentions $ mapMaybe (parseMaybe parseJSON) (V.toList v) + parseJSON invalid = typeMismatch "Mentions" invalid + +-- | A reference to other feeds, entities, or blobs that were mentioned in +-- a Post. data Mention = Mention { mentionLink :: Link + , mentionName :: Maybe T.Text } deriving (Show, Eq, Generic) instance FromJSON Mention where @@ -124,6 +161,7 @@ { about :: Link , name :: Maybe T.Text , image :: Maybe AboutImage + , description :: Maybe T.Text } deriving (Show, Eq, Generic) instance FromJSON About where @@ -137,8 +175,17 @@ , aboutImageHeight :: Maybe Int } deriving (Show, Eq, Generic) +-- | AboutImage can be encoded as either a JSON object or as a string, +-- which is the BlobLink. instance FromJSON AboutImage where - parseJSON = parseStrippingPrefix "aboutimage" + parseJSON o@(Object _) = parseStrippingPrefix "aboutimage" o + parseJSON s@(String _) = AboutImage + <$> parseJSON s + <*> pure Nothing + <*> pure Nothing + <*> pure Nothing + <*> pure Nothing + parseJSON invalid = typeMismatch "AboutImage" invalid -- | Contact-messages determine who you are following or blocking. data Contact = Contact diff --git a/test/MessageSpec.hs b/test/MessageSpec.hs --- a/test/MessageSpec.hs +++ b/test/MessageSpec.hs @@ -68,9 +68,9 @@ root (content message) `shouldBe` MessageLink <$> parseSha256 "rf1JvoFg1pHE6TkuuMxsjBNevFck7LQvXGhkLMNlaYs=" branch (content message) `shouldBe` - MessageLink <$> parseSha256 "G37a4PUTbysiETQazyYATwLkfn/ZzigmIheAx905MLU=" + Just (Branch [fromJust $ MessageLink <$> parseSha256 "G37a4PUTbysiETQazyYATwLkfn/ZzigmIheAx905MLU="]) recps (content message) `shouldBe` Nothing - map (linkTo . mentionLink) <$> (mentions (content message)) `shouldBe` + map (linkTo . mentionLink) . fromMentions <$> (mentions (content message)) `shouldBe` Just [ "dnr1swLSAgf36g+FzGjNLgmytj2IIyDaYeKZ7F5GdzY=" ] it "does not parse content that is not a post" $ do @@ -98,6 +98,23 @@ \ \"signature\": \"mPC156lndHN2oES/UE0GPK/Z8QgFLG8B/bba2TycXzPZZ7IShQhmFiasE0r0ZBTfRmU9KyuVdfwVYogkY2IACA==.sig.ed25519\"\ \}" +altAbout :: ByteString +altAbout = "\ +\{\ +\ \"previous\": null,\ +\ \"author\": \"@t0/CL/qifMsFniGq7fZ0KNjmC5/MLpJpuxPi/fFNvzU=.ed25519\",\ +\ \"sequence\": 1,\ +\ \"timestamp\": 1491509688475,\ +\ \"hash\": \"sha256\",\ +\ \"content\": {\ +\ \"type\": \"about\",\ +\ \"about\": \"@t0/CL/qifMsFniGq7fZ0KNjmC5/MLpJpuxPi/fFNvzU=.ed25519\",\ +\ \"image\": \"&+FICZpX7m4zJE99OVgBj/0IPaIH23T9ea8bBDazMsTw=.sha256\",\ +\ \"name\": \"jlipps\"\ +\ },\ +\ \"signature\": \"Qji3DvYtHu5kLs86Cxcor0jNrIC13qGrzqoIrSPCf750WrRKpdbqmFGKOqSiIUVT713i7BSnX7thrc7dXBkKDA==.sig.ed25519\"\ +\}" + aboutSpec :: Spec aboutSpec = describe "about" $ do it "extracts message about" $ do @@ -114,6 +131,11 @@ Just (Just 512) fmap aboutImageHeight (image (content message)) `shouldBe` Just (Just 512) + it "extracts message about with short AboutImage" $ do + let Just message = (decode altAbout) :: Maybe (Message About) + fmap aboutImageLink (image (content message)) `shouldBe` + BlobLink <$> parseSha256 "+FICZpX7m4zJE99OVgBj/0IPaIH23T9ea8bBDazMsTw=" + name (content message) `shouldBe` Just "jlipps" originalContact :: ByteString originalContact = "\