diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -2,6 +2,10 @@ `icloud-notes` uses [PVP Versioning][1]. +## 0.1.0.3 -- 2026-07-30 + +* Add `protobuf` and `cereal` dependencies; replace `proto3-wire` for protobuf decoding. + ## 0.1.0.2 -- 2026-07-30 * Remove unused `proto3-suite` dependency. diff --git a/hstratus-notes.cabal b/hstratus-notes.cabal --- a/hstratus-notes.cabal +++ b/hstratus-notes.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: hstratus-notes -version: 0.1.0.2 +version: 0.1.0.3 synopsis: Access iCloud Notes description: Browse notes and folders from iCloud Notes using an authenticated session @@ -71,7 +71,8 @@ , http-client >=0.5 && <0.8 , http-types >=0.12.1 && <0.13 , hstratus-auth >=0.1 && <0.3 - , proto3-wire >=1.0 && <2 + , cereal >=0.5 && <0.6 + , protobuf >=0.2 && <0.3 , text >=1.2.3 && <2.2 , time >=1.9 && <1.15 , zlib >=0.6 && <0.8 @@ -106,7 +107,8 @@ , hstratus-auth >=0.1 && <0.3 , hstratus-notes , hstratus-notes:hstratus-notes-internal - , proto3-wire >=1.0 && <2 + , cereal >=0.5 && <0.6 + , protobuf >=0.2 && <0.3 , QuickCheck >=2.14 && <3 , temporary >=1.2 && <1.4 , text >=1.2.3 && <2.2 diff --git a/src-internal/Network/HStratus/Internal/Notes/Proto.hs b/src-internal/Network/HStratus/Internal/Notes/Proto.hs --- a/src-internal/Network/HStratus/Internal/Notes/Proto.hs +++ b/src-internal/Network/HStratus/Internal/Notes/Proto.hs @@ -1,46 +1,186 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} + {- | Module : Network.HStratus.Internal.Notes.Proto Copyright : (c) 2026 Tim Emiola Maintainer : Tim Emiola SPDX-License-Identifier: BSD-3-Clause -Hand-written proto3-wire decoders for the Apple Notes protobuf schema. +Protobuf decoders for the Apple Notes wire schema. -Uses proto3-wire's lower-level @Parser@ API rather than code generation -because the schema has non-consecutive field numbers (e.g. @note_text = 2@, -@attribute_run = 5@); explicit @\`at\` N@ bindings prevent the silent -field-number mismatches that Generic derivation would introduce. -Fields not listed in the decoders are silently ignored by the wire decoder. +Uses 'Data.ProtocolBuffers' with Generic-derived 'Decode' instances for the +wire layer ('Wire*' types), then converts to plain domain types for use in +"Network.HStratus.Internal.Notes.Decode". Fields absent in the wire bytes +default to zero, empty, or 'Nothing', matching proto3 semantics. + +The 'Wire*' types are exported so that the test-suite encoder +('HStratus.Notes.TestHelper') can construct fixture bytes via 'Encode' +instances without depending on @proto3-wire@. -} module Network.HStratus.Internal.Notes.Proto - ( ProtoNote (..) + ( -- * Decoded note types + ProtoNote (..) , ProtoAttributeRun (..) , ProtoParagraphStyle (..) , decodeNoteStoreProto + + -- * Wire types + , WireNoteStoreProto (..) + , WireDocument (..) + , WireNote (..) + , WireAttributeRun (..) + , WireParagraphStyle (..) + , WireChecklist (..) + , WireAttachmentInfo (..) ) where import Data.ByteString (ByteString) import Data.Int (Int32) +import Data.Maybe (fromMaybe) +import Data.ProtocolBuffers + ( Decode + , Encode + , Message + , Optional + , Repeated + , Value + , decodeMessage + , getField + ) +import Data.Serialize (runGet) import Data.Text (Text) import qualified Data.Text.Lazy as LT -import Proto3.Wire.Decode - ( Parser - , RawMessage - , at - , embedded - , embedded' - , int32 - , one - , parse - , repeated - , text - ) +import GHC.Generics (Generic) --- Proto types mirror the schema closely; conversion to domain NoteText/NoteRun --- types happens in Decode.hs where gzip decompression also lives. +------------------------------------------------------------------------ +-- Wire types (Generic-derived Encode/Decode) +------------------------------------------------------------------------ +-- | Outermost @NoteStoreProto@ message; field 2 holds the nested 'WireDocument'. +data WireNoteStoreProto = WireNoteStoreProto + { wnspDocument :: Optional 2 (Message WireDocument) + } + deriving (Generic, Show) + + +instance Encode WireNoteStoreProto + + +instance Decode WireNoteStoreProto + + +-- | @Document@ message nested inside 'WireNoteStoreProto'; field 3 holds the 'WireNote'. +data WireDocument = WireDocument + { wdNote :: Optional 3 (Message WireNote) + } + deriving (Generic, Show) + + +instance Encode WireDocument + + +instance Decode WireDocument + + +-- | @Note@ message; field 2 is the note text, field 5 is the attribute runs. +data WireNote = WireNote + { wnNoteText :: Optional 2 (Value Text) + -- ^ full plain-text content (proto field 2) + , wnAttributeRuns :: Repeated 5 (Message WireAttributeRun) + -- ^ attribute runs describing formatting (proto field 5) + } + deriving (Generic, Show) + + +instance Encode WireNote + + +instance Decode WireNote + + +-- | @AttributeRun@ message describing a span of formatted text. +data WireAttributeRun = WireAttributeRun + { warLength :: Optional 1 (Value Int32) + -- ^ number of UTF-16 code units this run covers + , warParagraphStyle :: Optional 2 (Message WireParagraphStyle) + -- ^ paragraph-level formatting; absent when the run carries none + , warFontWeight :: Optional 5 (Value Int32) + -- ^ font weight: 1=bold, 2=italic, 3=bold+italic; absent means no weight + , warUnderlined :: Optional 6 (Value Int32) + -- ^ non-zero when underlined + , warStrikethrough :: Optional 7 (Value Int32) + -- ^ non-zero when strikethrough + , warLink :: Optional 9 (Value Text) + -- ^ hyperlink URL; absent means no link + , warAttachmentInfo :: Optional 12 (Message WireAttachmentInfo) + -- ^ attachment sub-message; absent when no attachment + } + deriving (Generic, Show) + + +instance Encode WireAttributeRun + + +instance Decode WireAttributeRun + + +-- | @ParagraphStyle@ message describing paragraph-level formatting. +data WireParagraphStyle = WireParagraphStyle + { wpsStyleType :: Optional 1 (Value Int32) + -- ^ 0=title, 1=heading, 2=subheading, 4=monospaced, 100=bullet, 101=dash, 102=numbered, 103=checklist + , wpsIndentAmount :: Optional 4 (Value Int32) + -- ^ indent level; absent means zero + , wpsChecklist :: Optional 5 (Message WireChecklist) + -- ^ checklist sub-message; absent when not a checklist paragraph + , wpsListStart :: Optional 7 (Value Int32) + -- ^ starting list item number; absent or zero means no explicit start + , wpsBlockQuote :: Optional 8 (Value Int32) + -- ^ non-zero when this paragraph is a block quote + } + deriving (Generic, Show) + + +instance Encode WireParagraphStyle + + +instance Decode WireParagraphStyle + + +-- | @Checklist@ sub-message (field 5 of 'WireParagraphStyle'). +data WireChecklist = WireChecklist + { wclDone :: Optional 2 (Value Int32) + -- ^ non-zero when the checklist item is checked + } + deriving (Generic, Show) + + +instance Encode WireChecklist + + +instance Decode WireChecklist + + +-- | @AttachmentInfo@ sub-message (field 12 of 'WireAttributeRun'). +data WireAttachmentInfo = WireAttachmentInfo + { waiAttachmentId :: Optional 1 (Value Text) + -- ^ attachment identifier string + } + deriving (Generic, Show) + + +instance Encode WireAttachmentInfo + + +instance Decode WireAttachmentInfo + + +------------------------------------------------------------------------ +-- Plain domain types (unchanged; consumed by Decode.hs) +------------------------------------------------------------------------ + -- | Top-level note content decoded from the protobuf payload. data ProtoNote = ProtoNote { pnNoteText :: Text @@ -76,80 +216,76 @@ { ppsStyleType :: Int32 -- ^ style_type field 1: 0=title, 1=heading, 2=subheading, 4=monospaced, 100=bullet, 101=dash, 102=numbered, 103=checklist , ppsIndent :: Int32 - -- ^ indent_amount field 4; 0 when absent. + -- ^ indent_amount field 4; 0 when absent , ppsChecked :: Maybe Bool - -- ^ checklist.done field 5 sub-field 2; 'Nothing' when checklist sub-message absent. + -- ^ checklist.done field 5 sub-field 2; 'Nothing' when checklist sub-message absent , ppsListStart :: Maybe Int32 - -- ^ starting_list_item_number field 7; 'Nothing' when absent or zero. + -- ^ starting_list_item_number field 7; 'Nothing' when absent or zero , ppsBlockQuote :: Bool - -- ^ block_quote field 8 non-zero. + -- ^ block_quote field 8 non-zero } deriving (Eq, Show) -{- | Decode a gzip-decompressed protobuf ByteString into a 'ProtoNote'. +------------------------------------------------------------------------ +-- Decoding +------------------------------------------------------------------------ + +{- | Decode a decompressed protobuf 'ByteString' into a 'ProtoNote'. Returns 'Left' with a message if the outer document or note field is absent, -which would indicate a malformed or empty payload rather than a real note. +indicating a malformed or empty payload. -} decodeNoteStoreProto :: ByteString -> Either String ProtoNote -decodeNoteStoreProto bs = - case parse parseNoteStoreProto bs of - Left err -> Left (show err) - Right Nothing -> Left "NoteStoreProto: document field absent" - Right (Just Nothing) -> Left "Document: note field absent" - Right (Just (Just note)) -> Right note - - --- Drill straight through NoteStoreProto (field 2) → Document (field 3) → Note --- without defining a separate Document record type. Each `embedded` call wraps --- the result in Maybe: Nothing means the field was absent in the wire bytes. -parseNoteStoreProto :: Parser RawMessage (Maybe (Maybe ProtoNote)) -parseNoteStoreProto = embedded (embedded parseProtoNote `at` 3) `at` 2 +decodeNoteStoreProto bs = do + outer <- runGet decodeMessage bs + doc <- + maybe + (Left "NoteStoreProto: document field absent") + Right + (getField (wnspDocument outer)) + wNote <- + maybe + (Left "Document: note field absent") + Right + (getField (wdNote doc)) + pure (toProtoNote wNote) --- `one text LT.empty` reads a singular string field, returning the default --- (empty) when the field is absent. `fmap LT.toStrict` converts the lazy --- Text that proto3-wire produces to the strict Text used in ProtoNote. --- `repeated (embedded' ...)` collects all occurrences of a length-delimited --- field into a list; embedded' (vs embedded) is used inside repeated because --- the field is known to be present (not optional) at each occurrence. -parseProtoNote :: Parser RawMessage ProtoNote -parseProtoNote = +toProtoNote :: WireNote -> ProtoNote +toProtoNote wn = ProtoNote - <$> (fmap LT.toStrict (one text LT.empty) `at` 2) - <*> (repeated (embedded' parseProtoAttributeRun) `at` 5) + { pnNoteText = fromMaybe mempty (getField (wnNoteText wn)) + , pnAttributeRuns = map toProtoAttributeRun (getField (wnAttributeRuns wn)) + } --- Scalar optional fields (font_weight, underlined, strikethrough) use --- `one int32 0` — the proto3 default of 0 means "absent / no effect" for --- all of them (0 = FONT_WEIGHT_UNKNOWN, 0 = not underlined, etc.). --- `embedded` for paragraph_style returns Maybe: Nothing when the run carries --- no paragraph-level formatting. -parseProtoAttributeRun :: Parser RawMessage ProtoAttributeRun -parseProtoAttributeRun = +toProtoAttributeRun :: WireAttributeRun -> ProtoAttributeRun +toProtoAttributeRun war = ProtoAttributeRun - <$> (one int32 0 `at` 1) - <*> (embedded parseParagraphStyle `at` 2) - <*> (one int32 0 `at` 5) -- font_weight (fields 3 and 4 are absent in schema) - <*> (one int32 0 `at` 6) -- underlined - <*> (one int32 0 `at` 7) -- strikethrough - <*> fmap (>>= \t -> if LT.null t then Nothing else Just t) (embedded parseAttachmentInfo `at` 12) - <*> (one text LT.empty `at` 9) -- link (field 8 skipped: superscript) - - -parseAttachmentInfo :: Parser RawMessage LT.Text -parseAttachmentInfo = one text LT.empty `at` 1 + { parLength = fromMaybe 0 (getField (warLength war)) + , parParagraphStyle = fmap toParagraphStyle (getField (warParagraphStyle war)) + , parFontWeight = fromMaybe 0 (getField (warFontWeight war)) + , parUnderlined = fromMaybe 0 (getField (warUnderlined war)) + , parStrikethrough = fromMaybe 0 (getField (warStrikethrough war)) + , parAttachmentId = + getField (warAttachmentInfo war) >>= \ai -> + let t = maybe LT.empty LT.fromStrict (getField (waiAttachmentId ai)) + in if LT.null t then Nothing else Just t + , parLink = maybe LT.empty LT.fromStrict (getField (warLink war)) + } -parseParagraphStyle :: Parser RawMessage ProtoParagraphStyle -parseParagraphStyle = +toParagraphStyle :: WireParagraphStyle -> ProtoParagraphStyle +toParagraphStyle wps = ProtoParagraphStyle - <$> (one int32 0 `at` 1) - <*> (one int32 0 `at` 4) - <*> (embedded parseChecklist `at` 5) - <*> (fmap (\n -> if n == 0 then Nothing else Just n) (one int32 0) `at` 7) - <*> (fmap (/= 0) (one int32 0) `at` 8) - - -parseChecklist :: Parser RawMessage Bool -parseChecklist = fmap (/= 0) (one int32 0 `at` 2) + { ppsStyleType = fromMaybe 0 (getField (wpsStyleType wps)) + , ppsIndent = fromMaybe 0 (getField (wpsIndentAmount wps)) + , ppsChecked = + fmap + (\cl -> fromMaybe 0 (getField (wclDone cl)) /= 0) + (getField (wpsChecklist wps)) + , ppsListStart = + getField (wpsListStart wps) >>= \n -> + if n == 0 then Nothing else Just n + , ppsBlockQuote = fromMaybe 0 (getField (wpsBlockQuote wps)) /= 0 + } diff --git a/test/HStratus/Notes/DecodeSpec.hs b/test/HStratus/Notes/DecodeSpec.hs --- a/test/HStratus/Notes/DecodeSpec.hs +++ b/test/HStratus/Notes/DecodeSpec.hs @@ -124,23 +124,23 @@ strikethroughFixtureBytes :: ByteString -strikethroughFixtureBytes = mkNoteGzip "hi" [runFields 2 [(7, 1)]] +strikethroughFixtureBytes = mkNoteGzip "hi" [strikethroughRun 2] bulletIndent1FixtureBytes :: ByteString -bulletIndent1FixtureBytes = mkNoteGzip "hi" [runWith 1 (psStyleType 100 <> psIndentAmount 1)] +bulletIndent1FixtureBytes = mkNoteGzip "hi" [runWith 1 (psIndentAmount 1 (psStyleType 100))] checklistDoneFixtureBytes :: ByteString -checklistDoneFixtureBytes = mkNoteGzip "hi" [runWith 1 (psStyleType 103 <> psChecklist True)] +checklistDoneFixtureBytes = mkNoteGzip "hi" [runWith 1 (psChecklist True (psStyleType 103))] checklistUndoneFixtureBytes :: ByteString -checklistUndoneFixtureBytes = mkNoteGzip "hi" [runWith 1 (psStyleType 103 <> psChecklist False)] +checklistUndoneFixtureBytes = mkNoteGzip "hi" [runWith 1 (psChecklist False (psStyleType 103))] numberedListStart3FixtureBytes :: ByteString -numberedListStart3FixtureBytes = mkNoteGzip "hi" [runWith 1 (psStyleType 102 <> psListStart 3)] +numberedListStart3FixtureBytes = mkNoteGzip "hi" [runWith 1 (psListStart 3 (psStyleType 102))] blockQuoteFixtureBytes :: ByteString diff --git a/test/HStratus/Notes/ProtoSpec.hs b/test/HStratus/Notes/ProtoSpec.hs --- a/test/HStratus/Notes/ProtoSpec.hs +++ b/test/HStratus/Notes/ProtoSpec.hs @@ -6,8 +6,7 @@ Maintainer : Tim Emiola SPDX-License-Identifier: BSD-3-Clause -Tests for the proto3-wire decoders in -'Network.HStratus.Internal.Notes.Proto'. +Tests for the protobuf decoders in 'Network.HStratus.Internal.Notes.Proto'. -} module HStratus.Notes.ProtoSpec (spec) where @@ -131,19 +130,19 @@ noteWithStrikethroughBytes :: ByteString -noteWithStrikethroughBytes = mkNote "hi" [runFields 2 [(7, 1)]] +noteWithStrikethroughBytes = mkNote "hi" [strikethroughRun 2] bulletIndent1Bytes :: ByteString -bulletIndent1Bytes = mkNote "hi" [runWith 1 (psStyleType 100 <> psIndentAmount 1)] +bulletIndent1Bytes = mkNote "hi" [runWith 1 (psIndentAmount 1 (psStyleType 100))] checklistDoneBytes :: ByteString -checklistDoneBytes = mkNote "hi" [runWith 1 (psStyleType 103 <> psChecklist True)] +checklistDoneBytes = mkNote "hi" [runWith 1 (psChecklist True (psStyleType 103))] checklistUndoneBytes :: ByteString -checklistUndoneBytes = mkNote "hi" [runWith 1 (psStyleType 103 <> psChecklist False)] +checklistUndoneBytes = mkNote "hi" [runWith 1 (psChecklist False (psStyleType 103))] checklistAbsentBytes :: ByteString @@ -151,7 +150,7 @@ numberedListStart3Bytes :: ByteString -numberedListStart3Bytes = mkNote "hi" [runWith 1 (psStyleType 102 <> psListStart 3)] +numberedListStart3Bytes = mkNote "hi" [runWith 1 (psListStart 3 (psStyleType 102))] blockQuoteBytes :: ByteString diff --git a/test/HStratus/Notes/TestHelper.hs b/test/HStratus/Notes/TestHelper.hs --- a/test/HStratus/Notes/TestHelper.hs +++ b/test/HStratus/Notes/TestHelper.hs @@ -7,7 +7,7 @@ SPDX-License-Identifier: BSD-3-Clause Programmatic proto\/gzip fixture builders for 'ProtoSpec' and 'DecodeSpec': -encodes domain values with @proto3-wire@ and compresses with @zlib@, avoiding +encodes domain values with @protobuf@ and compresses with @zlib@, avoiding hand-crafted byte literals. -} module HStratus.Notes.TestHelper @@ -16,7 +16,8 @@ , mkNoteZlib , mkEmptyGzip , runWith - , runFields + , plainRun + , strikethroughRun , psStyleType , psIndentAmount , psChecklist @@ -34,37 +35,54 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LBS import Data.Int (Int32) +import Data.ProtocolBuffers (encodeMessage, putField) +import Data.Serialize (runPut) import Data.Text (Text) -import qualified Data.Text.Lazy as TL import Network.HStratus.Internal.Notes.Note ( NoteRun (..) , NoteStyle (..) , NoteText (..) ) -import Network.HStratus.Internal.Notes.Proto (ProtoParagraphStyle (..)) -import qualified Proto3.Wire.Encode as Encode +import Network.HStratus.Internal.Notes.Proto + ( ProtoParagraphStyle (..) + , WireAttachmentInfo (..) + , WireAttributeRun (..) + , WireChecklist (..) + , WireDocument (..) + , WireNote (..) + , WireNoteStoreProto (..) + , WireParagraphStyle (..) + ) {- | Encode a NoteStoreProto with the given note text and attribute runs. Returns raw (uncompressed) proto bytes. -} -mkNote :: Text -> [Encode.MessageBuilder] -> ByteString +mkNote :: Text -> [WireAttributeRun] -> ByteString mkNote noteText runs = - LBS.toStrict . Encode.toLazyByteString $ - Encode.embedded 2 $ - Encode.embedded 3 $ - Encode.text 2 (TL.fromStrict noteText) - <> foldMap (Encode.embedded 5) runs + runPut . encodeMessage $ + WireNoteStoreProto + { wnspDocument = + putField . Just $ + WireDocument + { wdNote = + putField . Just $ + WireNote + { wnNoteText = putField (Just noteText) + , wnAttributeRuns = putField runs + } + } + } -- | Like 'mkNote' but gzip-compressed, suitable for 'decodeNoteBody'. -mkNoteGzip :: Text -> [Encode.MessageBuilder] -> ByteString +mkNoteGzip :: Text -> [WireAttributeRun] -> ByteString mkNoteGzip noteText runs = LBS.toStrict . GZip.compress . LBS.fromStrict $ mkNote noteText runs -- | Like 'mkNote' but zlib-compressed, suitable for 'decodeNoteBody'. -mkNoteZlib :: Text -> [Encode.MessageBuilder] -> ByteString +mkNoteZlib :: Text -> [WireAttributeRun] -> ByteString mkNoteZlib noteText runs = LBS.toStrict . Zlib.compress . LBS.fromStrict $ mkNote noteText runs @@ -76,63 +94,112 @@ mkEmptyGzip = LBS.toStrict (GZip.compress LBS.empty) --- | An AttributeRun with the given length and a ParagraphStyle sub-message. -runWith :: Int32 -> Encode.MessageBuilder -> Encode.MessageBuilder -runWith len style = Encode.int32 1 len <> Encode.embedded 2 style +-- | An 'WireAttributeRun' with the given length and a 'WireParagraphStyle' sub-message. +runWith :: Int32 -> WireParagraphStyle -> WireAttributeRun +runWith len style = + WireAttributeRun + { warLength = putField (Just len) + , warParagraphStyle = putField (Just style) + , warFontWeight = putField Nothing + , warUnderlined = putField Nothing + , warStrikethrough = putField Nothing + , warLink = putField Nothing + , warAttachmentInfo = putField Nothing + } -{- | An AttributeRun with the given length and a list of (fieldNumber, value) -pairs for inline fields (font_weight, underlined, strikethrough, etc.). +{- | A 'WireAttributeRun' with the given length and all other fields absent. +Use record-update syntax to set individual scalar fields for targeted tests. -} -runFields :: Int32 -> [(Int32, Int32)] -> Encode.MessageBuilder -runFields len fields = - Encode.int32 1 len - <> foldMap (\(fn, v) -> Encode.int32 (fromIntegral fn) v) fields +plainRun :: Int32 -> WireAttributeRun +plainRun len = + WireAttributeRun + { warLength = putField (Just len) + , warParagraphStyle = putField Nothing + , warFontWeight = putField Nothing + , warUnderlined = putField Nothing + , warStrikethrough = putField Nothing + , warLink = putField Nothing + , warAttachmentInfo = putField Nothing + } --- ParagraphStyle field builders ------------------------------------------- +-- | A 'WireAttributeRun' of the given length with the strikethrough field set. +strikethroughRun :: Int32 -> WireAttributeRun +strikethroughRun len = (plainRun len){warStrikethrough = putField (Just 1)} -psStyleType :: Int32 -> Encode.MessageBuilder -psStyleType = Encode.int32 1 +-- ParagraphStyle constructors and modifiers ----------------------------------- -psIndentAmount :: Int32 -> Encode.MessageBuilder -psIndentAmount = Encode.int32 4 +-- | A 'WireParagraphStyle' with only the @style_type@ field set. +psStyleType :: Int32 -> WireParagraphStyle +psStyleType n = + WireParagraphStyle + { wpsStyleType = putField (Just n) + , wpsIndentAmount = putField Nothing + , wpsChecklist = putField Nothing + , wpsListStart = putField Nothing + , wpsBlockQuote = putField Nothing + } --- | Encode a Checklist sub-message (field 5) with the given done state. -psChecklist :: Bool -> Encode.MessageBuilder -psChecklist done = - Encode.embedded 5 (Encode.int32 2 (if done then 1 else 0)) +-- | Set the @indent_amount@ field on a 'WireParagraphStyle'. +psIndentAmount :: Int32 -> WireParagraphStyle -> WireParagraphStyle +psIndentAmount n ps = ps{wpsIndentAmount = putField (Just n)} -psListStart :: Int32 -> Encode.MessageBuilder -psListStart = Encode.int32 7 +-- | Set the @checklist@ sub-message on a 'WireParagraphStyle'. +psChecklist :: Bool -> WireParagraphStyle -> WireParagraphStyle +psChecklist done ps = + ps + { wpsChecklist = + putField . Just $ + WireChecklist{wclDone = putField (Just (if done then 1 else 0))} + } -psBlockQuote :: Encode.MessageBuilder -psBlockQuote = Encode.int32 8 1 +-- | Set the @starting_list_item_number@ field on a 'WireParagraphStyle'. +psListStart :: Int32 -> WireParagraphStyle -> WireParagraphStyle +psListStart n ps = ps{wpsListStart = putField (Just n)} --- Encoder functions ------------------------------------------------------- +-- | A 'WireParagraphStyle' with only the @block_quote@ field set. +psBlockQuote :: WireParagraphStyle +psBlockQuote = + WireParagraphStyle + { wpsStyleType = putField Nothing + , wpsIndentAmount = putField Nothing + , wpsChecklist = putField Nothing + , wpsListStart = putField Nothing + , wpsBlockQuote = putField (Just 1) + } -{- | Encode a 'ProtoParagraphStyle' back to wire bytes, reusing the ps* helpers. + +-- Encoder functions ----------------------------------------------------------- + +{- | Encode a 'ProtoParagraphStyle' as a 'WireParagraphStyle'. Proto3 default values (0 / False / Nothing) are omitted to match wire convention. -} -encodeParagraphStyle :: ProtoParagraphStyle -> Encode.MessageBuilder +encodeParagraphStyle :: ProtoParagraphStyle -> WireParagraphStyle encodeParagraphStyle ProtoParagraphStyle{ppsStyleType, ppsIndent, ppsChecked, ppsListStart, ppsBlockQuote} = - (if ppsStyleType /= 0 then psStyleType ppsStyleType else mempty) - <> (if ppsIndent /= 0 then psIndentAmount ppsIndent else mempty) - <> maybe mempty psChecklist ppsChecked - <> maybe mempty psListStart ppsListStart - <> (if ppsBlockQuote then psBlockQuote else mempty) + WireParagraphStyle + { wpsStyleType = putField (if ppsStyleType /= 0 then Just ppsStyleType else Nothing) + , wpsIndentAmount = putField (if ppsIndent /= 0 then Just ppsIndent else Nothing) + , wpsChecklist = + putField $ + fmap + (\c -> WireChecklist{wclDone = putField (Just (if c then 1 else 0))}) + ppsChecked + , wpsListStart = putField ppsListStart + , wpsBlockQuote = putField (if ppsBlockQuote then Just 1 else Nothing) + } -{- | Encode a 'NoteStyle' as a paragraph_style sub-message. +{- | Encode a 'NoteStyle' as a 'WireParagraphStyle'. Inverse of 'toNoteStyle'; 'StyleBody False' is not in the image of 'toNoteStyle' and should not appear in generated test data. -} -encodeNoteStyle :: NoteStyle -> Encode.MessageBuilder +encodeNoteStyle :: NoteStyle -> WireParagraphStyle encodeNoteStyle style = encodeParagraphStyle $ case style of StyleTitle -> ProtoParagraphStyle 0 0 Nothing Nothing False StyleHeading -> ProtoParagraphStyle 1 0 Nothing Nothing False @@ -145,18 +212,18 @@ StyleChecklist i c -> ProtoParagraphStyle 103 (fromIntegral i) (Just c) Nothing False -{- | Encode a 'NoteRun' as an AttributeRun sub-message. -'nrLink' is always 'Nothing' in generated runs (deferred). --} -encodeNoteRun :: NoteRun -> Encode.MessageBuilder +-- | Encode a 'NoteRun' as a 'WireAttributeRun'. +encodeNoteRun :: NoteRun -> WireAttributeRun encodeNoteRun NoteRun{nrLength, nrStyle, nrBold, nrItalic, nrUnderline, nrStrikethrough, nrAttachmentId, nrLink} = - Encode.int32 1 nrLength - <> maybe mempty (Encode.embedded 2 . encodeNoteStyle) nrStyle - <> (if fw /= 0 then Encode.int32 5 fw else mempty) - <> (if nrUnderline then Encode.int32 6 1 else mempty) - <> (if nrStrikethrough then Encode.int32 7 1 else mempty) - <> maybe mempty (\t -> Encode.embedded 12 (Encode.text 1 (TL.fromStrict t))) nrAttachmentId - <> maybe mempty (Encode.text 9 . TL.fromStrict) nrLink + WireAttributeRun + { warLength = putField (Just nrLength) + , warParagraphStyle = putField (fmap encodeNoteStyle nrStyle) + , warFontWeight = putField (if fw /= 0 then Just fw else Nothing) + , warUnderlined = putField (if nrUnderline then Just 1 else Nothing) + , warStrikethrough = putField (if nrStrikethrough then Just 1 else Nothing) + , warLink = putField nrLink + , warAttachmentInfo = putField (fmap mkAttachmentInfo nrAttachmentId) + } where fw :: Int32 fw = case (nrBold, nrItalic) of @@ -164,6 +231,7 @@ (True, False) -> 1 (False, True) -> 2 (False, False) -> 0 + mkAttachmentInfo t = WireAttachmentInfo{waiAttachmentId = putField (Just t)} -- | Encode a 'NoteText' to gzip-compressed proto bytes, suitable for 'decodeNoteBody'.