Added handling for network errors
This commit is contained in:
parent
52bbf8379b
commit
c434b19515
|
@ -21,6 +21,7 @@ to generate this file without the comments in this block.
|
|||
, "console"
|
||||
, "effect"
|
||||
, "either"
|
||||
, "exceptions"
|
||||
, "fetch"
|
||||
, "filterable"
|
||||
, "halogen"
|
||||
|
|
|
@ -9,6 +9,7 @@ import Control.Monad.Error.Class (try)
|
|||
import Effect (Effect)
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Exception (message)
|
||||
import Fetch (fetch)
|
||||
import Data.Array (head)
|
||||
import Data.Base64 (decodeBase64, fromString)
|
||||
|
@ -82,9 +83,9 @@ parseIndex rawData = do
|
|||
|
||||
fetchImageAsBlobUrl :: ArrayBuffer -> Format.Format -> CryptoKey -> String -> Aff ImageData
|
||||
fetchImageAsBlobUrl nonce format key fileID = do
|
||||
{ status, arrayBuffer } <- fetch (fileID <> ".bin") {}
|
||||
case status of
|
||||
200 -> do
|
||||
result <- try $ fetch (fileID <> ".bin") {}
|
||||
case result of
|
||||
Right {status: 200, arrayBuffer} -> do
|
||||
encryptedImage <- arrayBuffer
|
||||
decryptedImage <- try $ decryptBlob key encryptedImage nonce
|
||||
case decryptedImage of
|
||||
|
@ -92,8 +93,12 @@ fetchImageAsBlobUrl nonce format key fileID = do
|
|||
Right rawImage -> do
|
||||
url <- liftEffect $ createObjectURL $ (arrayBufferToBlob $ formatToMime format) rawImage
|
||||
pure $ ILoaded url
|
||||
404 -> pure $ IError ImageNotFound
|
||||
s -> pure $ IError $ if s / 100 == 5 then MinorServerError else UnknownStatusCodeForImage s
|
||||
Right {status: 404} -> pure $ IError ImageNotFound
|
||||
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 imgdata format cryptokey = case imgdata of
|
||||
|
@ -121,14 +126,19 @@ fetch_gallery_from_page_info = do
|
|||
Nothing -> pure $ GError MalformedKey
|
||||
Just keyBuffer -> do
|
||||
cryptoKey <- importKey keyBuffer
|
||||
{ status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {}
|
||||
case status of
|
||||
200 -> do
|
||||
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'
|
||||
404 -> pure $ GError NotFound
|
||||
s -> pure $ GError $ if s / 100 == 5 then ServerError else UnknownStatusCodeForIndex s
|
||||
Right {status: 404} -> pure $ GError NotFound
|
||||
Right {status} ->
|
||||
pure $ GError $
|
||||
if status / 100 == 5
|
||||
then ServerError
|
||||
else UnknownStatusCodeForIndex status
|
||||
Left _ -> pure $ GError $ TotalNetworkError
|
||||
|
|
|
@ -17,12 +17,14 @@ data GalleryError
|
|||
| StrangeIndex
|
||||
| IndexMissingField String
|
||||
| UnknownStatusCodeForIndex Int
|
||||
| TotalNetworkError
|
||||
|
||||
data ImageError
|
||||
= MinorServerError
|
||||
| ImageNotFound
|
||||
| BadIndexData
|
||||
| ImageDecryptFailed
|
||||
| NetworkError String
|
||||
| UnknownStatusCodeForImage Int
|
||||
|
||||
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. "
|
||||
<> "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 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
|
||||
show MinorServerError =
|
||||
|
@ -101,6 +107,8 @@ instance showImageError :: Show ImageError where
|
|||
<> "to load this image because of it."
|
||||
show ImageDecryptFailed =
|
||||
"This image seems to have expired"
|
||||
show (NetworkError msg) =
|
||||
"A network error occured while trying to download this image - " <> msg
|
||||
show (UnknownStatusCodeForImage code) =
|
||||
"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 "
|
||||
|
|
Loading…
Reference in New Issue