scuttlebutt-types 0.3.0 → 0.4.0

raw patch · 4 files changed

+65/−43 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG +10/−0
• scuttlebutt-types.cabal +1/−1
• src/Ssb/Types/Message.hs +50/−38
• test/MessageSpec.hs +4/−4

@@ -1,3 +1,13 @@+scuttlebutt-types (0.4.0) unstable; urgency=medium++  * Simplified Post type (API change)+  * Support parsing a Post with a root or branch that has a value+    that is not a valid link.+  * Fix parsing of Post recps.+  * Mention renamed to UserLink. (API change)++ -- Joey Hess <id@joeyh.name>  Mon, 26 Feb 2018 14:32:59 -0400+ scuttlebutt-types (0.3.0) unstable; urgency=medium    * Handle about messages whose image field is a string linking to a blob,

@@ -1,5 +1,5 @@ Name: scuttlebutt-types-Version: 0.3.0+Version: 0.4.0 License: BSD3 License-File: LICENSE Author: bkil.hu, Peter Ferenc Hajdu, Joey Hess

@@ -10,9 +10,7 @@ 	narrowParse, 	PrivateContent(..), 	Post(..),-	Branch(..),-	Mentions(..),-	Mention(..),+	UserLink(..), 	About(..), 	AboutImage(..), 	Contact(..),@@ -32,6 +30,7 @@ import Data.List import Data.Char import Control.Applicative+import Control.Monad import qualified Data.Text as T import qualified Data.Vector as V import qualified Data.ByteString.Lazy as L@@ -111,48 +110,61 @@ 	{ text :: T.Text 	, channel :: Maybe T.Text 	, root :: Maybe MessageLink-	, branch :: Maybe Branch-	, recps :: Maybe [FeedLink]-	, mentions :: Maybe Mentions+	, branch :: [MessageLink]+	, recps :: [UserLink]+	, mentions :: [UserLink] 	} deriving (Show, Eq, Generic)  instance FromJSON Post where-	parseJSON = parseMessageType "post" (genericParseJSON defaultOptions)---- | 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)+	parseJSON = parseMessageType "post" $ withObject "Post" $ \o -> Post+		<$> o .: "text"+		<*> o .:? "channel"+		<*> parseroot o+		<*> parsebranch o+		<*> (o .:? "recps" .!= mempty)+		<*> parsementions o+	  where+	  	-- root is optional.+		-- Avoid failing if it contains something that is not a+		-- valid link.+		parseroot o = join <$> explicitParseFieldMaybe+			(pure . parseMaybe parseJSON)+			o "root"+		-- branch can be a string or an object, and is optional.+		-- Avoid failing if it contains something that is not a+		-- valid link.+		parsebranch o = do+			v <- explicitParseFieldMaybe+				(arrayOrSingleton (parseMaybe parseJSON))+				o "branch"+				.!= mempty+			return (catMaybes v)+		-- mentions can be an array or an object, and is optional.+		-- Avoid failing if it contains something that is not a+		-- valid link.+		parsementions o = do+			v <- explicitParseFieldMaybe+				(arrayOrSingleton (parseMaybe parseJSON))+				o "mentions"+				.!= mempty+			return (catMaybes v) --- | 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+-- | Apply a parser to each thing in an array, or to a single item not in+-- an array.+arrayOrSingleton :: (Value -> a) -> Value -> Parser [a]+arrayOrSingleton p v@(Object _) = pure [p v]+arrayOrSingleton p v@(String _) = pure [p v]+arrayOrSingleton p (Array v) = pure (map p (V.toList v))+arrayOrSingleton _ _ = fail "expected Array or Object" --- | A reference to other feeds, entities, or blobs that were mentioned in--- a Post.-data Mention = Mention-	{ mentionLink :: Link-	, mentionName :: Maybe T.Text+-- | A link to a user, sometimes including a name.+data UserLink = UserLink+	{ userLink :: Link+	, userName :: Maybe T.Text 	} deriving (Show, Eq, Generic) -instance FromJSON Mention where-	parseJSON = parseStrippingPrefix "mention"+instance FromJSON UserLink where+	parseJSON = parseStrippingPrefix "user"  -- | About-messages set attributes about someone or something. -- They can be used to set a name or picture for users, files, or messages.

@@ -68,10 +68,10 @@ 		root (content message) `shouldBe` 			MessageLink <$> parseSha256 "rf1JvoFg1pHE6TkuuMxsjBNevFck7LQvXGhkLMNlaYs=" 		branch (content message) `shouldBe`-			Just (Branch [fromJust $ MessageLink <$> parseSha256 "G37a4PUTbysiETQazyYATwLkfn/ZzigmIheAx905MLU="])-		recps (content message) `shouldBe` Nothing-		map (linkTo . mentionLink) . fromMentions <$> (mentions (content message)) `shouldBe`-			Just [ "dnr1swLSAgf36g+FzGjNLgmytj2IIyDaYeKZ7F5GdzY=" ]+			[fromJust $ MessageLink <$> parseSha256 "G37a4PUTbysiETQazyYATwLkfn/ZzigmIheAx905MLU="]+		recps (content message) `shouldBe` mempty+		(map (linkTo . userLink) $ mentions $ content message) `shouldBe`+			[ "dnr1swLSAgf36g+FzGjNLgmytj2IIyDaYeKZ7F5GdzY=" ]  	it "does not parse content that is not a post" $ do 		(decode originalAbout :: Maybe (Message Post)) `shouldBe` Nothing