From 612fe976a02f07189ff326c8f9545350816ceb1c Mon Sep 17 00:00:00 2001 From: Emi Simpson Date: Mon, 7 Nov 2022 17:49:20 -0500 Subject: [PATCH] Add handling for possible key import errors --- src/Logic.purs | 77 ++++++++++++++++++++++++++++++-------------------- src/Main.purs | 9 ++++-- src/Model.purs | 12 +++++++- 3 files changed, 65 insertions(+), 33 deletions(-) diff --git a/src/Logic.purs b/src/Logic.purs index 66d01e9..3125294 100644 --- a/src/Logic.purs +++ b/src/Logic.purs @@ -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 diff --git a/src/Main.purs b/src/Main.purs index 3eb5522..e328dc5 100644 --- a/src/Main.purs +++ b/src/Main.purs @@ -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 diff --git a/src/Model.purs b/src/Model.purs index 5df7c2f..b301782 100644 --- a/src/Model.purs +++ b/src/Model.purs @@ -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"