Add handling for possible key import errors

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 :: ArrayBuffer -> Aff (Either GalleryError CryptoKey)
-importKey key =
+importKey key = do
-    SC.importKey raw key (aes aesGCM) false [decrypt]
+    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
+        key' <- cryptokey
-        fetchImageAsBlobUrl nonce format key fileID
+        case key' of
+            Nothing -> pure $ IError BadKey
+            Just key -> fetchImageAsBlobUrl nonce format key fileID
     loadedOrError -> pure loadedOrError
 
 fetchThumb :: Image -> Aff ImageData
@@ -113,24 +120,34 @@ 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
+type Parameters =
-fetch_gallery_from_page_info = do
+    { 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 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 cryptoKey encryptedIndex nonce
+            serializedIndex <- try $ decryptBlob params.key encryptedIndex nonce
             case serializedIndex of
                 Left _ -> pure $ GError DecryptFailed
                 Right serializedIndex' -> do

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
 

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"