Add protobuf parsing (et. al)

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;
+}

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" ]

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" {}
+    urlInfo <- liftEffect do
-    responseText <- text
+        window <- HTML.window
-    liftEffect $ log responseText
+        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

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
+