From 99422b1f0ac840e8341b592cc64340296a342aef Mon Sep 17 00:00:00 2001 From: Emi Simpson Date: Fri, 4 Nov 2022 14:05:02 -0400 Subject: [PATCH] Add protobuf parsing (et. al) --- format.proto | 25 +++++ spago.dhall | 11 ++- src/Main.purs | 93 ++++++++++++++++-- src/format.AviaryFormat.purs | 185 +++++++++++++++++++++++++++++++++++ 4 files changed, 307 insertions(+), 7 deletions(-) create mode 100644 format.proto create mode 100644 src/format.AviaryFormat.purs diff --git a/format.proto b/format.proto new file mode 100644 index 0000000..4ffbce2 --- /dev/null +++ b/format.proto @@ -0,0 +1,25 @@ +syntax = "proto3"; + +package AviaryFormat; + +enum Format { + WEBP = 0; + AVIF = 1; + JPG = 2; + PNG = 3; + GIF = 4; +} + +message Image { + bytes key = 1; + string full_url = 2; + string thumb_url = 3; + string blurhash = 4; + Format format = 5; +} + +message Index { + repeated Image images = 1; + optional string title = 2; + optional string desc = 3; +} diff --git a/spago.dhall b/spago.dhall index 9e4d1ba..b9a67ed 100644 --- a/spago.dhall +++ b/spago.dhall @@ -13,18 +13,27 @@ to generate this file without the comments in this block. { name = "my-project" , dependencies = [ "aff" - , "arraybuffer-types" + , "arraybuffer" , "arraybuffer-builder" + , "arraybuffer-types" + , "arrays" , "base64-codec" , "console" , "effect" , "either" + , "exceptions" , "fetch" + , "filterable" , "foldable-traversable" , "maybe" + , "newtype" + , "parsing" , "prelude" + , "protobuf" , "strings" , "subtlecrypto" + , "transformers" + , "web-html" ] , packages = ./packages.dhall , sources = [ "src/**/*.purs", "test/**/*.purs" ] diff --git a/src/Main.purs b/src/Main.purs index 678b082..71e7e13 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -1,20 +1,33 @@ module Main where import Prelude +import AviaryFormat.Format (Format, Image, Index, parseIndex) as Format +import Control.Monad.Error.Class (try) import Effect (Effect) import Effect.Aff (Aff, launchAff) import Effect.Class (liftEffect) import Effect.Console (log) +import Effect.Exception (message) import Fetch (fetch) +import Data.Array (head) import Data.Base64 (decodeBase64, fromString) -import Data.Either (Either, note) +import Data.Either (Either(..), hush, note) import Data.Maybe (Maybe(..)) -import Data.ArrayBuffer.Builder (execPut, putInt32be) +import Data.Newtype (unwrap) +import Data.ArrayBuffer.ArrayBuffer (byteLength) +import Data.ArrayBuffer.Builder (execPut, putInt8) +import Data.ArrayBuffer.Builder.Internal (toView) +import Data.ArrayBuffer.DataView (buffer, whole) import Data.ArrayBuffer.Types (ArrayBuffer) +import Data.Filterable (partitionMap) import Data.Foldable (traverse_) import Data.String (drop, indexOf', indexOf, splitAt) import Data.String.Pattern (Pattern(..)) +import Parsing (runParserT) +import Web.HTML (window) as HTML +import Web.HTML.Window (location) +import Web.HTML.Location (hash, origin, pathname) as Location import Crypto.Subtle.Constants.AES (aesGCM, t128) import Crypto.Subtle.Encrypt (aesGCM, decrypt) as Alg @@ -23,17 +36,35 @@ import Crypto.Subtle.Key.Import (importKey) as SC import Crypto.Subtle.Key.Types (CryptoKey, decrypt, raw) nonceE :: Effect ArrayBuffer -nonceE = execPut $ traverse_ putInt32be [0xd0, 0xc3, 0x75, 0x56, 0x58, 0xc1, 0x7e, 0x5f, 0xd6, 0xcc, 0xb6, 0x76] +nonceE = execPut $ traverse_ putInt8 [0xd0, 0xc3, 0x75, 0x56, 0x58, 0xc1, 0x7e, 0x5f, 0xd6, 0xcc, 0xb6, 0x76] data AviaryError = MalformedKey | MalformedUrl | DecryptFailed + | StrangeIndex + | IndexMissingField String + +type Image = + { key :: Aff CryptoKey + , fullUrl :: String + , thumbUrl :: String + , blurhash :: String + , format :: Format.Format + } + +type Index = + { images :: Array Image + , title :: Maybe String + , desc :: Maybe String + } instance showAviaryError :: Show AviaryError where show MalformedKey = "Malformed key!!" show MalformedUrl = "Malformed url!!" show DecryptFailed = "Either the data provided by the server was bad, or valid but incorrect key. Expiration likely." + show StrangeIndex = "The gallery index matched with the provided key, but was in a strange format. This could indicate a severe version mismatch, or that the gallery was created by a malfunctioning client." + show (IndexMissingField f) = "The gallery index was missing the crucial field " <> f <> ". This is almost certainly the result of a version mismatch or that the creator's client was not fully up-to-spec." type UrlInfo = { server :: String @@ -61,11 +92,61 @@ decryptBlob key cyphertext nonce = -- nonce <- makeAff (\_ -> nonceE) Alg.decrypt (Alg.aesGCM nonce Nothing (Just t128)) key cyphertext +convertImageFromProtobuf :: Format.Image -> Either AviaryError Image +convertImageFromProtobuf protoimage = let protoimage' = unwrap protoimage in do + rawKey <- note (IndexMissingField "images[].key") protoimage'.key + fullUrl <- note (IndexMissingField "images[].full_url") protoimage'.full_url + thumbUrl <- note (IndexMissingField "images[].thumb_url") protoimage'.thumb_url + blurhash <- note (IndexMissingField "images[].blurhash") protoimage'.blurhash + format <- note (IndexMissingField "images[].format") protoimage'.format + let key = SC.importKey raw (buffer $ toView $ unwrap rawKey) (aes aesGCM) false [decrypt] + pure { key, fullUrl, thumbUrl, blurhash, format } + +convertIndexFromProtobuf :: Format.Index -> Either AviaryError Index +convertIndexFromProtobuf protoindex = + let protoindex' = unwrap protoindex in + let {right: images, left: imagesErrors} = partitionMap convertImageFromProtobuf protoindex'.images + in + case head imagesErrors of + Nothing -> + Right + { images + , title: protoindex'.title + , desc: protoindex'.desc + } + Just err -> Left err + +parseIndex :: ArrayBuffer -> Effect (Either AviaryError Index) +parseIndex rawData = do + parseResult <- runParserT (whole rawData) (Format.parseIndex (byteLength rawData)) + pure $ convertIndexFromProtobuf =<< (note StrangeIndex $ hush parseResult) + main_aff :: Aff Unit main_aff = do - { status, text } <- fetch "https://envs.sh/Q_V.txt" {} - responseText <- text - liftEffect $ log responseText + urlInfo <- liftEffect do + window <- HTML.window + location <- location window + keyB64 <- drop 1 <$> Location.hash location + server <- Location.origin location + fileId <- drop 1 <$> Location.pathname location + nonce <- nonceE + pure {keyB64, server, fileId, nonce} + maybeIndex <- case decodeKey urlInfo.keyB64 of + Left err -> pure $ Left err + Right keyBuffer -> do + cryptoKey <- importKey keyBuffer + { status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {} + encryptedIndex <- arrayBuffer + serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex urlInfo.nonce + case serializedIndex of + Left err -> do + _ <- liftEffect $ log $ message err + pure $ Left $ DecryptFailed + Right serializedIndex' -> do + _ <- liftEffect $ log "BBBBBBBBB!" + maybeIndex <- liftEffect $ parseIndex serializedIndex' + pure ((\i -> i.title) <$> maybeIndex) + liftEffect $ log $ show maybeIndex main :: Effect Unit main = launchAff main_aff $> unit diff --git a/src/format.AviaryFormat.purs b/src/format.AviaryFormat.purs new file mode 100644 index 0000000..fac5c13 --- /dev/null +++ b/src/format.AviaryFormat.purs @@ -0,0 +1,185 @@ +-- | Generated by __purescript-protobuf__ from file `format.proto` +module AviaryFormat.Format +( Image(..), ImageRow, ImageR, parseImage, putImage, defaultImage, mkImage, mergeImage +, Index(..), IndexRow, IndexR, parseIndex, putIndex, defaultIndex, mkIndex, mergeIndex +, Format(..) +) +where +import Protobuf.Internal.Prelude +import Protobuf.Internal.Prelude as Prelude + + + + +-- ---------- Message Image ---------- +newtype Image = Image ImageR +type ImageRow = + ( key :: Prelude.Maybe Prelude.Bytes + , full_url :: Prelude.Maybe String + , thumb_url :: Prelude.Maybe String + , blurhash :: Prelude.Maybe String + , format :: Prelude.Maybe Format + , __unknown_fields :: Array Prelude.UnknownField + ) +type ImageR = Record ImageRow +derive instance genericImage :: Prelude.Generic Image _ +derive instance newtypeImage :: Prelude.Newtype Image _ +derive instance eqImage :: Prelude.Eq Image +instance showImage :: Prelude.Show Image where show x = Prelude.genericShow x + +putImage :: forall m. Prelude.MonadEffect m => Image -> Prelude.PutM m Prelude.Unit +putImage (Image r) = do + Prelude.putOptional 1 r.key Prelude.isDefault Prelude.encodeBytesField + Prelude.putOptional 2 r.full_url Prelude.isDefault Prelude.encodeStringField + Prelude.putOptional 3 r.thumb_url Prelude.isDefault Prelude.encodeStringField + Prelude.putOptional 4 r.blurhash Prelude.isDefault Prelude.encodeStringField + Prelude.putOptional 5 r.format Prelude.isDefault Prelude.putEnumField + Prelude.traverse_ Prelude.putFieldUnknown r.__unknown_fields + +parseImage :: forall m. Prelude.MonadEffect m => Prelude.MonadRec m => Prelude.ByteLength -> Prelude.ParserT Prelude.DataView m Image +parseImage length = Prelude.label "Image / " $ + Prelude.parseMessage Image defaultImage parseField length + where + parseField + :: Prelude.FieldNumberInt + -> Prelude.WireType + -> Prelude.ParserT Prelude.DataView m (Prelude.Builder ImageR ImageR) + parseField 1 Prelude.LenDel = Prelude.label "key / " $ do + x <- Prelude.decodeBytes + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "key") $ \_ -> Prelude.Just x + parseField 2 Prelude.LenDel = Prelude.label "full_url / " $ do + x <- Prelude.decodeString + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "full_url") $ \_ -> Prelude.Just x + parseField 3 Prelude.LenDel = Prelude.label "thumb_url / " $ do + x <- Prelude.decodeString + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "thumb_url") $ \_ -> Prelude.Just x + parseField 4 Prelude.LenDel = Prelude.label "blurhash / " $ do + x <- Prelude.decodeString + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "blurhash") $ \_ -> Prelude.Just x + parseField 5 Prelude.VarInt = Prelude.label "format / " $ do + x <- Prelude.parseEnum + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "format") $ \_ -> Prelude.Just x + parseField fieldNumber wireType = Prelude.parseFieldUnknown fieldNumber wireType + +defaultImage :: ImageR +defaultImage = + { key: Prelude.Nothing + , full_url: Prelude.Nothing + , thumb_url: Prelude.Nothing + , blurhash: Prelude.Nothing + , format: Prelude.Nothing + , __unknown_fields: [] + } + +mkImage :: forall r1 r3. Prelude.Union r1 ImageRow r3 => Prelude.Nub r3 ImageRow => Record r1 -> Image +mkImage r = Image $ Prelude.merge r defaultImage + +mergeImage :: Image -> Image -> Image +mergeImage (Image l) (Image r) = Image + { key: Prelude.alt l.key r.key + , full_url: Prelude.alt l.full_url r.full_url + , thumb_url: Prelude.alt l.thumb_url r.thumb_url + , blurhash: Prelude.alt l.blurhash r.blurhash + , format: Prelude.alt l.format r.format + , __unknown_fields: r.__unknown_fields <> l.__unknown_fields + } + + +-- ---------- Message Index ---------- +newtype Index = Index IndexR +type IndexRow = + ( images :: Array Image + , title :: Prelude.Maybe String + , desc :: Prelude.Maybe String + , __unknown_fields :: Array Prelude.UnknownField + ) +type IndexR = Record IndexRow +derive instance genericIndex :: Prelude.Generic Index _ +derive instance newtypeIndex :: Prelude.Newtype Index _ +derive instance eqIndex :: Prelude.Eq Index +instance showIndex :: Prelude.Show Index where show x = Prelude.genericShow x + +putIndex :: forall m. Prelude.MonadEffect m => Index -> Prelude.PutM m Prelude.Unit +putIndex (Index r) = do + Prelude.putRepeated 1 r.images $ Prelude.putLenDel putImage + Prelude.putOptional 2 r.title (\_ -> false) Prelude.encodeStringField + Prelude.putOptional 3 r.desc (\_ -> false) Prelude.encodeStringField + Prelude.traverse_ Prelude.putFieldUnknown r.__unknown_fields + +parseIndex :: forall m. Prelude.MonadEffect m => Prelude.MonadRec m => Prelude.ByteLength -> Prelude.ParserT Prelude.DataView m Index +parseIndex length = Prelude.label "Index / " $ + Prelude.parseMessage Index defaultIndex parseField length + where + parseField + :: Prelude.FieldNumberInt + -> Prelude.WireType + -> Prelude.ParserT Prelude.DataView m (Prelude.Builder IndexR IndexR) + parseField 1 Prelude.LenDel = Prelude.label "images / " $ do + x <- Prelude.parseLenDel parseImage + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "images") $ Prelude.flip Prelude.snoc x + parseField 2 Prelude.LenDel = Prelude.label "title / " $ do + x <- Prelude.decodeString + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "title") $ \_ -> Prelude.Just x + parseField 3 Prelude.LenDel = Prelude.label "desc / " $ do + x <- Prelude.decodeString + pure $ Prelude.modify (Prelude.Proxy :: Prelude.Proxy "desc") $ \_ -> Prelude.Just x + parseField fieldNumber wireType = Prelude.parseFieldUnknown fieldNumber wireType + +defaultIndex :: IndexR +defaultIndex = + { images: [] + , title: Prelude.Nothing + , desc: Prelude.Nothing + , __unknown_fields: [] + } + +mkIndex :: forall r1 r3. Prelude.Union r1 IndexRow r3 => Prelude.Nub r3 IndexRow => Record r1 -> Index +mkIndex r = Index $ Prelude.merge r defaultIndex + +mergeIndex :: Index -> Index -> Index +mergeIndex (Index l) (Index r) = Index + { images: r.images <> l.images + , title: Prelude.alt l.title r.title + , desc: Prelude.alt l.desc r.desc + , __unknown_fields: r.__unknown_fields <> l.__unknown_fields + } + + +-- ---------- Enum Format ---------- +data Format + = Format_WEBP + | Format_AVIF + | Format_JPG + | Format_PNG + | Format_GIF +derive instance genericFormat :: Prelude.Generic Format _ +derive instance eqFormat :: Prelude.Eq Format +instance showFormat :: Prelude.Show Format where show = Prelude.genericShow +instance ordFormat :: Prelude.Ord Format where compare = Prelude.genericCompare +instance boundedFormat :: Prelude.Bounded Format + where + bottom = Prelude.genericBottom + top = Prelude.genericTop +instance enumFormat :: Prelude.Enum Format + where + succ = Prelude.genericSucc + pred = Prelude.genericPred +instance boundedenumFormat :: Prelude.BoundedEnum Format + where + cardinality = Prelude.genericCardinality + toEnum (0) = Prelude.Just Format_WEBP + toEnum (1) = Prelude.Just Format_AVIF + toEnum (2) = Prelude.Just Format_JPG + toEnum (3) = Prelude.Just Format_PNG + toEnum (4) = Prelude.Just Format_GIF + toEnum _ = Prelude.Nothing + fromEnum Format_WEBP = (0) + fromEnum Format_AVIF = (1) + fromEnum Format_JPG = (2) + fromEnum Format_PNG = (3) + fromEnum Format_GIF = (4) +instance defaultFormat :: Prelude.Default Format + where + default = Format_WEBP + isDefault = eq Format_WEBP +