Add protobuf parsing (et. al)
This commit is contained in:
parent
a3fbcea843
commit
99422b1f0a
GPG Key ID:
A12F2C2FFDC3D847
|
|
@ -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;
|
||||
}
|
||||
11
spago.dhall
11
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" ]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
Loading…
Reference in New Issue