From c12ceba49669d79133998a13d6139e1bf680ffe4 Mon Sep 17 00:00:00 2001 From: Emi Simpson Date: Sat, 5 Nov 2022 14:47:35 -0400 Subject: [PATCH] Add image decryption --- spago.dhall | 2 ++ src/Main.purs | 58 ++++++++++++++++++++++++++++++++++++++++++--------- 2 files changed, 50 insertions(+), 10 deletions(-) diff --git a/spago.dhall b/spago.dhall index b9a67ed..df0019a 100644 --- a/spago.dhall +++ b/spago.dhall @@ -27,12 +27,14 @@ to generate this file without the comments in this block. , "foldable-traversable" , "maybe" , "newtype" + , "parallel" , "parsing" , "prelude" , "protobuf" , "strings" , "subtlecrypto" , "transformers" + , "web-file" , "web-html" ] , packages = ./packages.dhall diff --git a/src/Main.purs b/src/Main.purs index 71e7e13..5893f6e 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -1,9 +1,11 @@ module Main where import Prelude -import AviaryFormat.Format (Format, Image, Index, parseIndex) as Format +import AviaryFormat.Format (Format(..), Image, Index, parseIndex) as Format +import Aviary.FFI (arrayBufferToBlob) import Control.Monad.Error.Class (try) +import Control.Parallel (parTraverse) import Effect (Effect) import Effect.Aff (Aff, launchAff) import Effect.Class (liftEffect) @@ -16,15 +18,15 @@ import Data.Either (Either(..), hush, note) import Data.Maybe (Maybe(..)) 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.Builder (DataBuff, execPut, putDataBuff, putInt8) +import Data.ArrayBuffer.DataView (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.File.Url (createObjectURL) import Web.HTML (window) as HTML import Web.HTML.Window (location) import Web.HTML.Location (hash, origin, pathname) as Location @@ -38,12 +40,19 @@ import Crypto.Subtle.Key.Types (CryptoKey, decrypt, raw) nonceE :: Effect ArrayBuffer nonceE = execPut $ traverse_ putInt8 [0xd0, 0xc3, 0x75, 0x56, 0x58, 0xc1, 0x7e, 0x5f, 0xd6, 0xcc, 0xb6, 0x76] +databuffToBuffer :: DataBuff -> Effect ArrayBuffer +databuffToBuffer = execPut <<< putDataBuff + data AviaryError - = MalformedKey + = ServerError + | UnexpectedStatusCode Int + | MalformedKey | MalformedUrl | DecryptFailed + | ImageDecryptFailed | StrangeIndex | IndexMissingField String + | ImageNotFound type Image = { key :: Aff CryptoKey @@ -60,11 +69,15 @@ type Index = } instance showAviaryError :: Show AviaryError where + show ServerError = "The server encountered an error" 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 ImageDecryptFailed = "The decryption of the album's index succeeded, but it contained a reference to an image whose decryption failed. This likely indicates expiration" 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." + show ImageNotFound = "The image was not found, likely indicating that it expired" + show (UnexpectedStatusCode status) = "Server returned an unexpected status code: " <> (show status) type UrlInfo = { server :: String @@ -72,6 +85,13 @@ type UrlInfo = , key :: String } +formatToMime :: Format.Format -> String +formatToMime Format.Format_WEBP = "image/webp" +formatToMime Format.Format_AVIF = "image/avif" +formatToMime Format.Format_JPG = "image/jpeg" +formatToMime Format.Format_PNG = "image/png" +formatToMime Format.Format_GIF = "image/gif" + parseUrl :: String -> Either AviaryError UrlInfo parseUrl url = note MalformedUrl do slashIndex <- indexOf' (Pattern "/") 8 url @@ -99,7 +119,7 @@ convertImageFromProtobuf protoimage = let protoimage' = unwrap protoimage in do 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] + let key = importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey) pure { key, fullUrl, thumbUrl, blurhash, format } convertIndexFromProtobuf :: Format.Index -> Either AviaryError Index @@ -119,8 +139,25 @@ convertIndexFromProtobuf protoindex = parseIndex :: ArrayBuffer -> Effect (Either AviaryError Index) parseIndex rawData = do parseResult <- runParserT (whole rawData) (Format.parseIndex (byteLength rawData)) + _ <- liftEffect $ log $ show (parseResult) pure $ convertIndexFromProtobuf =<< (note StrangeIndex $ hush parseResult) +fetchImageAsBlobUrl :: ArrayBuffer -> Image -> Aff (Either AviaryError String) +fetchImageAsBlobUrl nonce image = do + cryptoKey <- image.key + { status, arrayBuffer } <- fetch (image.fullUrl <> ".bin") {} + case status of + 200 -> do + encryptedImage <- arrayBuffer + decryptedImage <- try $ decryptBlob cryptoKey encryptedImage nonce + case decryptedImage of + Left _ -> pure $ Left ImageDecryptFailed + Right rawImage -> do + url <- liftEffect $ createObjectURL $ (arrayBufferToBlob $ formatToMime image.format) rawImage + pure $ Right url + 404 -> pure $ Left ImageNotFound + s -> pure $ Left $ if s / 100 == 5 then ServerError else UnexpectedStatusCode s + main_aff :: Aff Unit main_aff = do urlInfo <- liftEffect do @@ -143,10 +180,11 @@ main_aff = 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 + liftEffect $ parseIndex serializedIndex' + maybeUrls <- case maybeIndex of + Left err -> pure $ Left err + Right index -> Right <$> parTraverse (fetchImageAsBlobUrl urlInfo.nonce) index.images + liftEffect $ log $ show maybeUrls main :: Effect Unit main = launchAff main_aff $> unit