Emi/aviary-ps
1
0
Fork 0
Code Issues Pull requests Releases Activity

Add handling for possible key import errors

Browse source
This commit is contained in:
Emi Simpson 2022-11-07 17:49:20 -05:00
parent c434b19515
commit 612fe976a0
Signed by: Emi
GPG key ID: A12F2C2FFDC3D847
3 changed files with 65 additions and 33 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

77
src/Logic.purs
View file

@ -13,7 +13,7 @@ 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.Newtype (unwrap)
import Data.ArrayBuffer.ArrayBuffer (byteLength)
@ -26,7 +26,7 @@ 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
import Web.HTML.Location (hash, pathname) as Location
import Crypto.Subtle.Constants.AES (aesGCM, t128)
import Crypto.Subtle.Encrypt (aesGCM, decrypt) as Alg
@ -40,9 +40,14 @@ databuffToBuffer = execPut <<< putDataBuff
decodeKey :: String -> Maybe ArrayBuffer
decodeKey key = decodeBase64 <$> fromString key
importKey :: ArrayBuffer -> Aff CryptoKey
importKey key =
SC.importKey raw key (aes aesGCM) false [decrypt]
importKey :: ArrayBuffer -> Aff (Either GalleryError CryptoKey)
importKey key = do
maybeImportedKey <- try $ SC.importKey raw key (aes aesGCM) false [decrypt]
pure case maybeImportedKey of
Right importedKey -> Right importedKey
Left _ -> Left if byteLength key == 0
then MissingKey
else MalformedKey
decryptBlob :: CryptoKey -> ArrayBuffer -> ArrayBuffer -> Aff ArrayBuffer
decryptBlob key cyphertext nonce =
@ -55,7 +60,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 = importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey)
let key = hush <$> (importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey))
let thumb = Unloaded thumbUrl
let full = Unloaded fullUrl
pure { key, blurhash, format, thumb, full }
@ -100,11 +105,13 @@ fetchImageAsBlobUrl nonce format key fileID = do
else UnknownStatusCodeForImage status
Left e -> pure $ IError $ NetworkError $ message e
_fetchImg :: ImageData -> Format.Format -> Aff CryptoKey -> Aff ImageData
_fetchImg :: ImageData -> Format.Format -> Aff (Maybe CryptoKey) -> Aff ImageData
_fetchImg imgdata format cryptokey = case imgdata of
Unloaded fileID -> do
key <- cryptokey
fetchImageAsBlobUrl nonce format key fileID
key' <- cryptokey
case key' of
Nothing -> pure $ IError BadKey
Just key -> fetchImageAsBlobUrl nonce format key fileID
loadedOrError -> pure loadedOrError
fetchThumb :: Image -> Aff ImageData
@ -113,32 +120,42 @@ fetchThumb image = _fetchImg image.thumb Format.Format_WEBP image.key
fetchFull :: Image -> Aff ImageData
fetchFull image = _fetchImg image.full image.format image.key
fetch_gallery_from_page_info :: Aff Model
fetch_gallery_from_page_info = do
type Parameters =
{ fileId :: String
, key :: CryptoKey
}
get_parameters :: Aff (Either GalleryError Parameters)
get_parameters = do
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
pure {keyB64, server, fileId}
pure {keyB64, fileId}
case decodeKey urlInfo.keyB64 of
Nothing -> pure $ GError MalformedKey
Nothing -> pure $ Left MalformedKey
Just keyBuffer -> do
cryptoKey <- importKey keyBuffer
result <- try $ fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {}
case result of
Right {status: 200, arrayBuffer} -> do
encryptedIndex <- arrayBuffer
serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex nonce
case serializedIndex of
Left _ -> pure $ GError DecryptFailed
Right serializedIndex' -> do
liftEffect $ parseIndex serializedIndex'
Right {status: 404} -> pure $ GError NotFound
Right {status} ->
pure $ GError $
if status / 100 == 5
then ServerError
else UnknownStatusCodeForIndex status
Left _ -> pure $ GError $ TotalNetworkError
case cryptoKey of
Left e -> pure $ Left e
Right cryptoKey' -> pure $ Right {fileId: urlInfo.fileId, key: cryptoKey'}
fetch_and_decrypt_gallery :: Parameters -> Aff Model
fetch_and_decrypt_gallery params = do
result <- try $ fetch (params.fileId <> ".bin") {}
case result of
Right {status: 200, arrayBuffer} -> do
encryptedIndex <- arrayBuffer
serializedIndex <- try $ decryptBlob params.key encryptedIndex nonce
case serializedIndex of
Left _ -> pure $ GError DecryptFailed
Right serializedIndex' -> do
liftEffect $ parseIndex serializedIndex'
Right {status: 404} -> pure $ GError NotFound
Right {status} ->
pure $ GError $
if status / 100 == 5
then ServerError
else UnknownStatusCodeForIndex status
Left _ -> pure $ GError $ TotalNetworkError

9
src/Main.purs
View file

@ -2,8 +2,10 @@ module Main where
import Prelude
import Aviary.UI (component)
import Aviary.Logic (fetch_gallery_from_page_info)
import Aviary.Logic (fetch_and_decrypt_gallery, get_parameters)
import Aviary.Model (Model(..))
import Data.Either (Either(..))
import Effect (Effect)
import Effect.Aff (Aff, launchAff)
import Halogen.Aff (awaitBody)
@ -12,7 +14,10 @@ import Halogen.VDom.Driver (runUI)
main_aff :: Aff Unit
main_aff = do
body <- awaitBody
gallery <- fetch_gallery_from_page_info
parameters <- get_parameters
gallery <- case parameters of
Left e -> pure $ GError e
Right parameters' -> fetch_and_decrypt_gallery parameters'
_ <- runUI (component gallery) unit body
pure unit

12
src/Model.purs
View file

@ -13,6 +13,7 @@ data GalleryError
| ServerError
| NotFound
| MalformedKey
| MissingKey
| DecryptFailed
| StrangeIndex
| IndexMissingField String
@ -26,6 +27,7 @@ data ImageError
| ImageDecryptFailed
| NetworkError String
| UnknownStatusCodeForImage Int
| BadKey
data ImageData
= Unloaded String -- file ID of encrypted data
@ -38,7 +40,7 @@ instance showImageData :: Show ImageData where
show (IError e) = "error loading image: " <> (show e)
type Image =
{ key :: Aff CryptoKey
{ key :: Aff (Maybe CryptoKey)
, blurhash :: String
, format :: Format.Format
, thumb :: ImageData
@ -72,6 +74,12 @@ instance showGalleryError :: Show GalleryError where
<> "Please double check that you entered the correct URL, the whole URL, and "
<> "nothing but the URL (especially the numbers and letters at the end). If so, "
<> "the person who gave you this URL might have sent the wrong one."
show MissingKey =
"This image gallery is encrypted, and you don't have the key! Double check "
<> "you've entered the whole URL, which should include a pound sign (#) in the "
<> "middle. If the URL you were sent doesn't have a pound sign in the middle, "
<> "you were sent a partial URL and won't be able to decrypt this content "
<> "without a key."
show DecryptFailed =
"I wasn't able to decrypt any information about the gallery at this location. "
<> "If you're sure you entered the URL correctly, it's likely that the gallery "
@ -113,6 +121,8 @@ instance showImageError :: Show ImageError where
"Huh! The server returned a status code that I don't know the meaning of. "
<> "Please consider opening an issue on our issue tracker so that I can improve "
<> "and be more helpful next time. The unknown code was: " <> (show code)
show BadKey =
"The key associated with this image is bad, and it cannot be loaded"
formatToMime :: Format.Format -> String
formatToMime Format.Format_WEBP = "image/webp"