Added handling for network errors

This commit is contained in:
Emi Simpson 2022-11-07 16:16:47 -05:00
parent 52bbf8379b
commit c434b19515
Signed by: Emi
GPG Key ID: A12F2C2FFDC3D847
3 changed files with 29 additions and 10 deletions

View File

@ -21,6 +21,7 @@ to generate this file without the comments in this block.
, "console" , "console"
, "effect" , "effect"
, "either" , "either"
, "exceptions"
, "fetch" , "fetch"
, "filterable" , "filterable"
, "halogen" , "halogen"

View File

@ -9,6 +9,7 @@ import Control.Monad.Error.Class (try)
import Effect (Effect) import Effect (Effect)
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Effect.Exception (message)
import Fetch (fetch) import Fetch (fetch)
import Data.Array (head) import Data.Array (head)
import Data.Base64 (decodeBase64, fromString) import Data.Base64 (decodeBase64, fromString)
@ -82,9 +83,9 @@ parseIndex rawData = do
fetchImageAsBlobUrl :: ArrayBuffer -> Format.Format -> CryptoKey -> String -> Aff ImageData fetchImageAsBlobUrl :: ArrayBuffer -> Format.Format -> CryptoKey -> String -> Aff ImageData
fetchImageAsBlobUrl nonce format key fileID = do fetchImageAsBlobUrl nonce format key fileID = do
{ status, arrayBuffer } <- fetch (fileID <> ".bin") {} result <- try $ fetch (fileID <> ".bin") {}
case status of case result of
200 -> do Right {status: 200, arrayBuffer} -> do
encryptedImage <- arrayBuffer encryptedImage <- arrayBuffer
decryptedImage <- try $ decryptBlob key encryptedImage nonce decryptedImage <- try $ decryptBlob key encryptedImage nonce
case decryptedImage of case decryptedImage of
@ -92,8 +93,12 @@ fetchImageAsBlobUrl nonce format key fileID = do
Right rawImage -> do Right rawImage -> do
url <- liftEffect $ createObjectURL $ (arrayBufferToBlob $ formatToMime format) rawImage url <- liftEffect $ createObjectURL $ (arrayBufferToBlob $ formatToMime format) rawImage
pure $ ILoaded url pure $ ILoaded url
404 -> pure $ IError ImageNotFound Right {status: 404} -> pure $ IError ImageNotFound
s -> pure $ IError $ if s / 100 == 5 then MinorServerError else UnknownStatusCodeForImage s Right {status} -> pure $ IError $
if status / 100 == 5
then MinorServerError
else UnknownStatusCodeForImage status
Left e -> pure $ IError $ NetworkError $ message e
_fetchImg :: ImageData -> Format.Format -> Aff CryptoKey -> Aff ImageData _fetchImg :: ImageData -> Format.Format -> Aff CryptoKey -> Aff ImageData
_fetchImg imgdata format cryptokey = case imgdata of _fetchImg imgdata format cryptokey = case imgdata of
@ -121,14 +126,19 @@ fetch_gallery_from_page_info = do
Nothing -> pure $ GError MalformedKey Nothing -> pure $ GError MalformedKey
Just keyBuffer -> do Just keyBuffer -> do
cryptoKey <- importKey keyBuffer cryptoKey <- importKey keyBuffer
{ status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {} result <- try $ fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {}
case status of case result of
200 -> do Right {status: 200, arrayBuffer} -> do
encryptedIndex <- arrayBuffer encryptedIndex <- arrayBuffer
serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex nonce serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex nonce
case serializedIndex of case serializedIndex of
Left _ -> pure $ GError DecryptFailed Left _ -> pure $ GError DecryptFailed
Right serializedIndex' -> do Right serializedIndex' -> do
liftEffect $ parseIndex serializedIndex' liftEffect $ parseIndex serializedIndex'
404 -> pure $ GError NotFound Right {status: 404} -> pure $ GError NotFound
s -> pure $ GError $ if s / 100 == 5 then ServerError else UnknownStatusCodeForIndex s Right {status} ->
pure $ GError $
if status / 100 == 5
then ServerError
else UnknownStatusCodeForIndex status
Left _ -> pure $ GError $ TotalNetworkError

View File

@ -17,12 +17,14 @@ data GalleryError
| StrangeIndex | StrangeIndex
| IndexMissingField String | IndexMissingField String
| UnknownStatusCodeForIndex Int | UnknownStatusCodeForIndex Int
| TotalNetworkError
data ImageError data ImageError
= MinorServerError = MinorServerError
| ImageNotFound | ImageNotFound
| BadIndexData | BadIndexData
| ImageDecryptFailed | ImageDecryptFailed
| NetworkError String
| UnknownStatusCodeForImage Int | UnknownStatusCodeForImage Int
data ImageData data ImageData
@ -88,6 +90,10 @@ instance showGalleryError :: Show GalleryError where
"Huh! The server returned a status code that I don't know the meaning of. " "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 " <> "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) <> "and be more helpful next time. The unknown code was: " <> (show code)
show TotalNetworkError =
"We weren't able to download this gallery because some network error occured. " <>
"Check that you are connected to the internet and then try again. It's " <>
"also possible that the server is down at the minute."
instance showImageError :: Show ImageError where instance showImageError :: Show ImageError where
show MinorServerError = show MinorServerError =
@ -101,6 +107,8 @@ instance showImageError :: Show ImageError where
<> "to load this image because of it." <> "to load this image because of it."
show ImageDecryptFailed = show ImageDecryptFailed =
"This image seems to have expired" "This image seems to have expired"
show (NetworkError msg) =
"A network error occured while trying to download this image - " <> msg
show (UnknownStatusCodeForImage code) = show (UnknownStatusCodeForImage code) =
"Huh! The server returned a status code that I don't know the meaning of. " "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 " <> "Please consider opening an issue on our issue tracker so that I can improve "