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"
|
, "console"
|
||||||
, "effect"
|
, "effect"
|
||||||
, "either"
|
, "either"
|
||||||
|
, "exceptions"
|
||||||
, "fetch"
|
, "fetch"
|
||||||
, "filterable"
|
, "filterable"
|
||||||
, "halogen"
|
, "halogen"
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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 "
|
||||||
|
|
Loading…
Reference in New Issue