From c434b195158848eaab7dcf603c659695eabebae5 Mon Sep 17 00:00:00 2001
From: Emi Simpson <emi@alchemi.dev>
Date: Mon, 7 Nov 2022 16:16:47 -0500
Subject: [PATCH] Added handling for network errors

---
 spago.dhall    |  1 +
 src/Logic.purs | 30 ++++++++++++++++++++----------
 src/Model.purs |  8 ++++++++
 3 files changed, 29 insertions(+), 10 deletions(-)

diff --git a/spago.dhall b/spago.dhall
index 60fddc9..3b57475 100644
--- a/spago.dhall
+++ b/spago.dhall
@@ -21,6 +21,7 @@ to generate this file without the comments in this block.
   , "console"
   , "effect"
   , "either"
+  , "exceptions"
   , "fetch"
   , "filterable"
   , "halogen"
diff --git a/src/Logic.purs b/src/Logic.purs
index d17f45a..66d01e9 100644
--- a/src/Logic.purs
+++ b/src/Logic.purs
@@ -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
diff --git a/src/Model.purs b/src/Model.purs
index b641102..5df7c2f 100644
--- a/src/Model.purs
+++ b/src/Model.purs
@@ -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 "