Add image decryption
This commit is contained in:
parent
99422b1f0a
commit
c12ceba496
GPG key ID:
A12F2C2FFDC3D847
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue