diff --git a/CHANGELOG b/CHANGELOG new file mode 100644 --- /dev/null +++ b/CHANGELOG @@ -0,0 +1,5 @@ +scuttlebutt-types (0.1.0) unstable; urgency=low + + * First release, split off from haskell-scuttlebutt. + + -- Joey Hess Thu, 05 Oct 2017 12:47:48 -0400 diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,29 @@ +BSD 3-Clause License + +Copyright (c) 2017, bkil.hu, Peter Ferenc Hajdu, Joey Hess +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +* Neither the name of the copyright holder nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,23 @@ +Secure Scuttlebutt is a database of unforgeable append-only feeds, +optimized for efficient replication for peer to peer protocols. + + +This library contains Haskell data types for common Secure Scuttlebutt +messages, including JSON serialization. + +Git repositories: + +* https://git.joeyh.name/git/haskell-scuttlebutt-types.git +* git-ssb repository: + ssb://%h2FnIacUWXelN8YGY0NcShMjQCqkcDF8XVpW64LgTHE=.sha256 + +Contributions welcome! Please use git-ssb or email for making pull requests +and issue tracking. Also you can find fellow haskellers on the #haskell +channel on SSB, and discuss this library there. + +Other Haskell Scuttlebutt resources: + +* The haskell-scuttlebutt git repository is built on top of + scuttlebutt-types, and has dreams of one day growing up to be a + real scuttlebutt client. It git-ssb repository is here: + ssb://%Nk2lTG8YHweKZEAfDrmzyjrkHPX1C9jHmYqc6csTCdU=.sha256 diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/scuttlebutt-types.cabal b/scuttlebutt-types.cabal new file mode 100644 --- /dev/null +++ b/scuttlebutt-types.cabal @@ -0,0 +1,56 @@ +Name: scuttlebutt-types +Version: 0.1.0 +License: BSD3 +License-File: LICENSE +Author: bkil.hu, Peter Ferenc Hajdu, Joey Hess +Maintainer: Joey Hess +Copyright: 2017 bkil.hu, Peter Ferenc Hajdu, Joey Hess +Category: Network +Build-Type: Simple +Extra-Source-Files: README.md CHANGELOG +Cabal-Version: >=1.10 +Synopsis: generic types for Secure Scuttlebutt +Description: + Secure Scuttlebutt is a database of unforgeable append-only feeds, + optimized for efficient replication for peer to peer protocols. + . + This library contains data types for common Scuttlebutt messages, + including JSON serialization. + +Library + Hs-Source-Dirs: src + GHC-Options: -Wall -fno-warn-tabs + Exposed-Modules: + Ssb.Types + Ssb.Types.Message + Ssb.Types.Key + Ssb.Types.Link + Build-Depends: + base (>= 4.7 && < 5), + bytestring, + bytestring-conversion, + base64-bytestring, + aeson, + ed25519, + text + Default-Language: Haskell2010 + +Test-Suite scuttlebutt-types-test + Type: exitcode-stdio-1.0 + Hs-Source-Dirs: test + Main-Is: Spec.hs + Build-Depends: + base, + scuttlebutt-types, + hspec, + bytestring, + aeson + Other-Modules: + MessageSpec + KeySpec + Ghc-Options: -Wall -fno-warn-tabs -threaded -rtsopts -with-rtsopts=-N + Default-Language: Haskell2010 + +source-repository head + type: git + location: https://git.joeyh.name/git/haskell-scuttlebutt-types.git diff --git a/src/Ssb/Types.hs b/src/Ssb/Types.hs new file mode 100644 --- /dev/null +++ b/src/Ssb/Types.hs @@ -0,0 +1,7 @@ +module Ssb.Types ( + module Ssb.Types.Message, + module Ssb.Types.Key +) where + +import Ssb.Types.Message +import Ssb.Types.Key diff --git a/src/Ssb/Types/Key.hs b/src/Ssb/Types/Key.hs new file mode 100644 --- /dev/null +++ b/src/Ssb/Types/Key.hs @@ -0,0 +1,57 @@ +{-# LANGUAGE DeriveGeneric, OverloadedStrings #-} + +module Ssb.Types.Key ( + PublicKey(..), + parsePublicKey, + parseEd25519PublicKey, + formatPublicKey, +) where + +import Data.ByteString +import Data.Text.Encoding (encodeUtf8, decodeUtf8) +import qualified Data.Text as T +import qualified Data.ByteString.Base64 as B64 +import qualified Data.Aeson as Aeson +import qualified Crypto.Sign.Ed25519 as Ed +import GHC.Generics +import Data.Monoid + +newtype PublicKey = Ed25519PublicKey { ed25519Key :: Ed.PublicKey } + deriving (Eq, Ord, Generic) + +instance Aeson.FromJSON PublicKey where + parseJSON = Aeson.withText "PublicKey" $ \t -> + case parsePublicKey (encodeUtf8 t) of + Just pk -> return pk + Nothing -> fail ("public key decode failure: " ++ T.unpack t) + +instance Aeson.ToJSON PublicKey where + toJSON = Aeson.String . decodeUtf8 . formatPublicKey + +instance Show PublicKey where + show = T.unpack . decodeUtf8 . formatPublicKey + +-- | Parses a SSB public key, which is base64 encoded, and has a prefix of +-- "@" and a suffix specifying the type of the key. +parsePublicKey :: ByteString -> Maybe PublicKey +parsePublicKey b = do + b' <- stripPrefix "@" b + case stripSuffix ".ed25519" b' of + Just b'' -> parseEd25519PublicKey b'' + Nothing -> Nothing + +-- | Decodes a SSB Ed25519 public key, which is base64 encoded. +parseEd25519PublicKey :: ByteString -> Maybe PublicKey +parseEd25519PublicKey b = Ed25519PublicKey <$> maybeEd25519PublicKey + where + decodedPublicKey = B64.decode b + maybeEd25519PublicKey = either + (const Nothing) + (Just . Ed.PublicKey) + decodedPublicKey + +-- | Formats a SSB public key to a base64 encoded string with a prefix of +-- "@" and suffix specifying the type of the key. +formatPublicKey :: PublicKey -> ByteString +formatPublicKey (Ed25519PublicKey { ed25519Key = k }) = + "@" <> B64.encode (Ed.unPublicKey k) <> ".ed25519" diff --git a/src/Ssb/Types/Link.hs b/src/Ssb/Types/Link.hs new file mode 100644 --- /dev/null +++ b/src/Ssb/Types/Link.hs @@ -0,0 +1,26 @@ +-- | TODO newtypes for everything + +module Ssb.Types.Link where + +import Ssb.Types.Key + +import Data.Aeson + +-- | A link to a message. +type MessageLink = String + +-- | A link to a feed. +newtype FeedLink = FeedLink { unFeedLink :: PublicKey } + deriving (Show, Eq, Ord) + +instance FromJSON FeedLink where + parseJSON d = FeedLink <$> parseJSON d + +instance ToJSON FeedLink where + toJSON = toJSON . unFeedLink + +-- | A link to a blob. +type BlobLink = String + +-- | A link to a message, feed, or blob. +type GenericLink = String diff --git a/src/Ssb/Types/Message.hs b/src/Ssb/Types/Message.hs new file mode 100644 --- /dev/null +++ b/src/Ssb/Types/Message.hs @@ -0,0 +1,208 @@ +{-# LANGUAGE DeriveGeneric, OverloadedStrings, FlexibleContexts #-} + +module Ssb.Types.Message ( + Signature, + HashType, + Message(..), + AnyContent(..), + narrowParse, + PrivateContent(..), + Post(..), + Mention(..), + About(..), + AboutImage(..), + Contact(..), + Vote(..), + Pub(..), + parseMessageType +) where + +import Ssb.Types.Key +import Ssb.Types.Link + +import GHC.Generics +import Data.Aeson +import Data.Aeson.Types +import Data.Int (Int64) +import qualified Data.Text as T +import Data.Maybe +import Data.List +import Data.Char +import Control.Applicative + +import Prelude hiding (sequence) + +type Signature = String + +type HashType = String + +data Message a = Message + { previous :: Maybe MessageLink + , author :: FeedLink + , sequence :: Int64 + , timestamp :: Float + , hash :: HashType + , content :: a + , signature :: Signature + } 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) } + +-- | Parsing a Message AnyContent allows parsing the message envelope, +-- regardless of the type of content in the message. +data AnyContent = AnyContent { fromAnyContent :: Value } + deriving (Show, Eq) + +instance FromJSON AnyContent where + parseJSON = pure . AnyContent + +-- | 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 +-- to different message types. +-- +-- For example: +-- +-- > Just somemsg = decode b :: Maybe Message AnyContent +-- > case parseMaybe narrowParse somemsg :: Maybe (Message Post) of +-- > Just postmsg -> ... +-- > Nothing -> case parseMaybe narrowParse somemsg :: Maybe (Message PrivateContent) of +-- > Just privmsg -> ... +-- > Nothing -> ... +narrowParse :: FromJSON a => Message AnyContent -> Parser (Message a) +narrowParse m = do + c <- parseJSON (fromAnyContent (content m)) + return $ m { content = c } + +-- | A message with encrypted content. +data PrivateContent = PrivateContent T.Text + deriving (Show, Eq) + +-- Any message that has a content that is a string, rather than a JSON +-- object, is an encrypted message. +instance FromJSON PrivateContent where + parseJSON = withText "PrivateContent" (pure . PrivateContent) + +-- | A post is a text-based message, for a public or private audience. +-- It can be a reply to other posts. +data Post = Post + { text :: T.Text + , channel :: Maybe T.Text + , root :: Maybe MessageLink + , branch :: Maybe MessageLink + , recps :: Maybe [FeedLink] + , mentions :: Maybe [Mention] + } deriving (Show, Eq, Generic) + +instance FromJSON Post where + parseJSON = parseMessageType "post" (genericParseJSON defaultOptions) + +-- | A generic reference to other feeds, entities, or blobs +data Mention = Mention + { mentionLink :: GenericLink + } deriving (Show, Eq, Generic) + +instance FromJSON Mention where + parseJSON = parseStrippingPrefix "mention" + +-- | About-messages set attributes about someone or something. +-- They can be used to set a name or picture for users, files, or messages. +-- However, they're most commonly published about users. +data About = About + { about :: GenericLink + , name :: Maybe T.Text + , image :: Maybe AboutImage + } deriving (Show, Eq, Generic) + +instance FromJSON About where + parseJSON = parseMessageType "about" (genericParseJSON defaultOptions) + +data AboutImage = AboutImage + { aboutImageLink :: BlobLink + , aboutImageSize :: Maybe Int + , aboutImageType :: Maybe T.Text + , aboutImageWidth :: Maybe Int + , aboutImageHeight :: Maybe Int + } deriving (Show, Eq, Generic) + +instance FromJSON AboutImage where + parseJSON = parseStrippingPrefix "aboutimage" + +-- | Contact-messages determine who you are following or blocking. +data Contact = Contact + { contact :: FeedLink + , following :: Bool + , blocking :: Bool + } deriving (Show, Eq, Generic) + +instance FromJSON Contact where + parseJSON = parseMessageType "contact" $ + withObject "Contect" $ \o -> Contact + <$> o .: "contact" + <*> o .:? "following" .!= False + <*> o .:? "blocking" .!= False + +-- | Vote-messages signal approval about someone or something. +-- Votes can be on users, messages, or blobs. +data Vote = Vote + { voteLink :: GenericLink + , voteValue :: Int + , voteExpression :: Maybe T.Text + } deriving (Show, Eq, Generic) + +instance FromJSON Vote where + parseJSON = parseMessageType "vote" $ withObject "Vote" $ \o -> do + -- For some reason the JSON wraps the vote in another object. + v <- o .: "vote" + Vote + <$> v .: "link" + <*> (v .: "value" <|> stringvalue v) + <*> v .:? "expression" + where + -- It's not uncommon for the value to be a string containing a + -- number, although it's supposed to be a plain number. + stringvalue v = do + s <- v .: "value" :: Parser T.Text + case s of + "1" -> return 1 + "0" -> return 0 + "-1" -> return (-1) + _ -> fail "unknown vote value" + +-- Pub-messages announce the address, port, and public key of pubs. +-- They are automatically published by Scuttlebot after successfully +-- using an invite to a pub. +data Pub = Pub + { pubHost :: T.Text + , pubPort :: Int + , pubKey :: PublicKey + } deriving (Show, Eq, Generic) + +instance FromJSON Pub where + parseJSON = parseMessageType "pub" $ withObject "Pub" $ \o -> do + -- For some reason the JSON wraps the pub in another object. + v <- o .: "address" + parseStrippingPrefix "pub" v + +-- | Parse the content of a message using the provided Parser, +-- which will typically be genericParseJSON defaultOptions. +-- +-- The "type" field must contain the specified Text for the parse to succeed. +parseMessageType :: T.Text -> (Value -> Parser a) -> Value -> Parser a +parseMessageType ty parser v@(Object o) = do + t <- o .: "type" + if t == ty + then parser v + else fail $ "wrong message type " ++ T.unpack t ++ " (expected " ++ T.unpack ty ++ ")" +parseMessageType ty _ invalid = typeMismatch (T.unpack ty) invalid + +-- | Parse, stripping a common prefix from the haskell record names. +parseStrippingPrefix :: (Generic a, GFromJSON Zero (Rep a)) => String -> Value -> Parser a +parseStrippingPrefix prefix = + genericParseJSON $ defaultOptions { fieldLabelModifier = f } + where + f s = fromMaybe s $ stripPrefix prefix $ map toLower s diff --git a/test/KeySpec.hs b/test/KeySpec.hs new file mode 100644 --- /dev/null +++ b/test/KeySpec.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE OverloadedStrings #-} + +module KeySpec where + +import Ssb.Types.Key +import Test.Hspec +import Data.ByteString + +base64PublicKey :: ByteString +base64PublicKey = "@opBinLmYiID9SMEoZJPH60LmduSYAR7J00P7/Gj9vHw=.ed25519" + +spec :: Spec +spec = describe "public key" $ do + it "can be deserialized and serialized from base64 bytestrings" $ do + let (Just publicKey) = parsePublicKey base64PublicKey + (formatPublicKey publicKey) `shouldBe` base64PublicKey diff --git a/test/MessageSpec.hs b/test/MessageSpec.hs new file mode 100644 --- /dev/null +++ b/test/MessageSpec.hs @@ -0,0 +1,217 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveGeneric #-} + +module MessageSpec where + +import Test.Hspec +import Ssb.Types.Message +import Ssb.Types.Key +import Ssb.Types.Link +import Data.Aeson +import Data.ByteString.Lazy +import Data.Maybe + +import Prelude hiding (sequence) + +spec :: Spec +spec = do + messageSpec + postSpec + aboutSpec + contactSpec + voteSpec + privateContentSpec + pubSpec + +originalMessage :: ByteString +originalMessage = "\ +\{\ +\ \"previous\": \"%3AWRZYdDHKOmLOWvzHbwJFjx9g8hOQH/NXZkwciA63Y=.sha256\",\ +\ \"author\": \"@EMovhfIrFk4NihAKnRNhrfRaqIhBv1Wj8pTxJNgvCCY=.ed25519\",\ +\ \"sequence\": 184,\ +\ \"timestamp\": 1449954503740,\ +\ \"hash\": \"sha256\",\ +\ \"content\": {\ +\ \"type\": \"post\",\ +\ \"text\": \"@johnny use https://github.com/ssbc/ssb-msgs and https://github.com/ssbc/ssb-ref is probably useful too.\",\ +\ \"root\": \"%rf1JvoFg1pHE6TkuuMxsjBNevFck7LQvXGhkLMNlaYs=.sha256\",\ +\ \"branch\": \"%G37a4PUTbysiETQazyYATwLkfn/ZzigmIheAx905MLU=.sha256\",\ +\ \"mentions\": [\ +\ {\ +\ \"link\": \"@dnr1swLSAgf36g+FzGjNLgmytj2IIyDaYeKZ7F5GdzY=.ed25519\",\ +\ \"name\": \"johnny\"\ +\ }\ +\ ]\ +\ },\ +\ \"signature\": \"28GiO52GFjJnrwpKo359FamEes7JB9gTiiZaidKLL1C1NRueqGq2IAYQ1V+T2AnBgUJLRZUIyNtLTlBcx4RGAA==.sig.ed25519\"\ +\}" + +messageSpec :: Spec +messageSpec = describe "message" $ do + it "extracts message content" $ do + let (Just message) = (decode originalMessage) :: Maybe (Message AnyContent) + previous message `shouldBe` Just "%3AWRZYdDHKOmLOWvzHbwJFjx9g8hOQH/NXZkwciA63Y=.sha256" + author message `shouldBe` fromJust (FeedLink <$> parseEd25519PublicKey "EMovhfIrFk4NihAKnRNhrfRaqIhBv1Wj8pTxJNgvCCY=") + sequence message `shouldBe` 184 + timestamp message `shouldBe` 1449954503740 + hash message `shouldBe` "sha256" + signature message `shouldBe` "28GiO52GFjJnrwpKo359FamEes7JB9gTiiZaidKLL1C1NRueqGq2IAYQ1V+T2AnBgUJLRZUIyNtLTlBcx4RGAA==.sig.ed25519" + +postSpec :: Spec +postSpec = describe "post" $ do + it "extracts message post" $ do + let (Just message) = (decode originalMessage) :: Maybe (Message Post) + content message `shouldBe` Post + { text = "@johnny use https://github.com/ssbc/ssb-msgs and https://github.com/ssbc/ssb-ref is probably useful too." + , channel = Nothing + , root = Just "%rf1JvoFg1pHE6TkuuMxsjBNevFck7LQvXGhkLMNlaYs=.sha256" + , branch = Just "%G37a4PUTbysiETQazyYATwLkfn/ZzigmIheAx905MLU=.sha256" + , recps = Nothing + , mentions = Just + [ Mention { mentionLink = "@dnr1swLSAgf36g+FzGjNLgmytj2IIyDaYeKZ7F5GdzY=.ed25519" } + ] + } + + it "does not parse content that is not a post" $ do + (decode originalAbout :: Maybe (Message Post)) `shouldBe` Nothing + +originalAbout :: ByteString +originalAbout = "\ +\{\ +\ \"previous\": \"%6+FS+LB8nDkgHZKanIB6kK5AYBK2SZYH55q5zv/5XIQ=.sha256\",\ +\ \"author\": \"@4RUNgFpvI4ZHH6mPPC9GLzsdv33Cs2JGMMcs8rJSMuU=.ed25519\",\ +\ \"sequence\": 5,\ +\ \"timestamp\": 1464267463411,\ +\ \"hash\": \"sha256\",\ +\ \"content\": {\ +\ \"type\": \"about\",\ +\ \"about\": \"@4RUNgFpvI4ZHH6mPPC9GLzsdv33Cs2JGMMcs8rJSMuU=.ed25519\",\ +\ \"image\": {\ +\ \"link\": \"&Ro1xCJNDIwwKul2SLSU1e4hrwekPcBI6OrBFN0JWnQM=.sha256\",\ +\ \"size\": 502712,\ +\ \"type\": \"image/png\",\ +\ \"width\": 512,\ +\ \"height\": 512\ +\ }\ +\ },\ +\ \"signature\": \"mPC156lndHN2oES/UE0GPK/Z8QgFLG8B/bba2TycXzPZZ7IShQhmFiasE0r0ZBTfRmU9KyuVdfwVYogkY2IACA==.sig.ed25519\"\ +\}" + +aboutSpec :: Spec +aboutSpec = describe "about" $ do + it "extracts message about" $ do + let Just message = (decode originalAbout) :: Maybe (Message About) + about (content message) `shouldBe` "@4RUNgFpvI4ZHH6mPPC9GLzsdv33Cs2JGMMcs8rJSMuU=.ed25519" + name (content message) `shouldBe` Nothing + fmap aboutImageLink (image (content message)) `shouldBe` + Just "&Ro1xCJNDIwwKul2SLSU1e4hrwekPcBI6OrBFN0JWnQM=.sha256" + fmap aboutImageSize (image (content message)) `shouldBe` + Just (Just 502712) + fmap aboutImageType (image (content message)) `shouldBe` + Just (Just "image/png") + fmap aboutImageWidth (image (content message)) `shouldBe` + Just (Just 512) + fmap aboutImageHeight (image (content message)) `shouldBe` + Just (Just 512) + +originalContact :: ByteString +originalContact = "\ +\{\ +\ \"previous\": \"%kLJuVKntE9LsPeTSyiVSNnb2vkiGXzBUMeDPoGr6BBw=.sha256\",\ +\ \"author\": \"@ye+QM09iPcDJD6YvQYjoQc7sLF/IFhmNbEqgdzQo3lQ=.ed25519\",\ +\ \"sequence\": 5442,\ +\ \"timestamp\": 1488618790507,\ +\ \"hash\": \"sha256\",\ +\ \"content\": {\ +\ \"type\": \"contact\",\ +\ \"contact\": \"@o91tsjBgL0l0zs475aRWYSAXFxvirZS7VrXmirY/msI=.ed25519\",\ +\ \"following\": true\ +\ },\ +\ \"signature\": \"zknuPbUwMeBaDZzZ9iBETOPbZ7SYqetd3RVkq2mYSyr4QI/7uwho3GnerIF3fLcvW3MgRM5SvFvSTnpxxQFoCg==.sig.ed25519\"\ +\}" + +contactSpec :: Spec +contactSpec = describe "contact" $ do + it "extracts message contact" $ do + let Just message = (decode originalContact) :: Maybe (Message Contact) + content message `shouldBe` Contact + { contact = fromJust $ FeedLink <$> parseEd25519PublicKey "o91tsjBgL0l0zs475aRWYSAXFxvirZS7VrXmirY/msI=" + , following = True + , blocking = False + } + +originalVote :: ByteString +originalVote = "\ +\{\ +\ \"previous\": \"%jiyo59Or2Rrm+05QJIZ/fLfCeBhiaJ+tjJgW/USgtYs=.sha256\",\ +\ \"author\": \"@/02iw6SFEPIHl8nMkYSwcCgRWxiG6VP547Wcp1NW8Bo=.ed25519\",\ +\ \"sequence\": 3304,\ +\ \"timestamp\": 1459235596255,\ +\ \"hash\": \"sha256\",\ +\ \"content\": {\ +\ \"type\": \"vote\",\ +\ \"vote\": {\ +\ \"link\": \"%lu9JsdUl4astKykyaVFdkLb7//tS0K08BMs6dT+fErA=.sha256\",\ +\ \"value\": 1\ +\ }\ +\ },\ +\ \"signature\": \"iw/wREQJ4UEecnfuFNIiZt9kMZXkQc8SP2jmhVbUvPj9Eo50D2yJKfza+Qf/tYwOuFaE9et4pbucPD/4OMlbAg==.sig.ed25519\"\ +\}" + +voteSpec :: Spec +voteSpec = describe "vote" $ do + it "extracts message vote" $ do + let Just message = (decode originalVote) :: Maybe (Message Vote) + content message `shouldBe` Vote + { voteLink = "%lu9JsdUl4astKykyaVFdkLb7//tS0K08BMs6dT+fErA=.sha256" + , voteValue = 1 + , voteExpression = Nothing + } + +-- Not a real private message content, because the test couldn't decrypt it anyway. +originalPrivateContent :: ByteString +originalPrivateContent = "\ +\{\ +\ \"previous\": \"%RFY6DRn3syOm7GodwpNTePx0I4ZWyZMVsmZ4V1QqiDQ=.sha256\",\ +\ \"author\": \"@9nTgtYmvW4HID6ayt6Icwc8WZxdifx5SlSKKIX/X/1g=.ed25519\",\ +\ \"sequence\": 245,\ +\ \"timestamp\": 1481349557377,\ +\ \"hash\": \"sha256\",\ +\ \"content\": \"dummy\",\ +\ \"signature\": \"2urg9PG4+esti1DIf4DnFfsUXXnOzwXHv+QnflKQQ0145pNw+SIXeYkhNhzqdFm2fz7wzWb7YVlFMPIL11EaBQ==.sig.ed25519\"\ +\}" + +privateContentSpec :: Spec +privateContentSpec = describe "private" $ do + it "extracts message private" $ do + let Just message = (decode originalPrivateContent) :: Maybe (Message PrivateContent) + author message `shouldBe` fromJust (FeedLink <$> parseEd25519PublicKey "9nTgtYmvW4HID6ayt6Icwc8WZxdifx5SlSKKIX/X/1g=") + content message `shouldBe` PrivateContent "dummy" + +originalPub :: ByteString +originalPub = "\ +\{\ +\ \"previous\": \"%qYdhzyTbQwrdTOpKVvFS0nFCOvK5SekDhxLjHs6i1jo=.sha256\",\ +\ \"author\": \"@26RTWG0+zR1DLO43p4VjB/UzTNKgQ+TNvLey37E/YdI=.ed25519\",\ +\ \"sequence\": 3,\ +\ \"timestamp\": 1497928539321,\ +\ \"hash\": \"sha256\",\ +\ \"content\": {\ +\ \"type\": \"pub\",\ +\ \"address\": {\ +\ \"host\": \"ssb.hypersignal.xyz\",\ +\ \"port\": 8008,\ +\ \"key\": \"@XRg7pXoQqsWDDk4dmgvSWHUqzwS6BmqMo4IdbMKPjWA=.ed25519\"\ +\ }\ +\ },\ +\ \"signature\": \"nWBpjqbnw4sGkaD+0OpxzmTo5VeGOnRcj2hxWjATlO9e7F9eK2yJACOaa5hzGT1E967uFhwmvwUA6FMq3Z0MBQ==.sig.ed25519\"\ +\}" + +pubSpec :: Spec +pubSpec = describe "pub" $ do + it "extracts message pub" $ do + let Just message = (decode originalPub) :: Maybe (Message Pub) + pubHost (content message) `shouldBe` "ssb.hypersignal.xyz" + pubPort (content message) `shouldBe` 8008 + Just (pubKey (content message)) `shouldBe` + parseEd25519PublicKey "XRg7pXoQqsWDDk4dmgvSWHUqzwS6BmqMo4IdbMKPjWA=" diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}