Restructure code to use a more sound model

spago.dhall

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

src/Main.purs

@@ -1,20 +1,19 @@
 module Main where
 
 import Prelude
-import AviaryFormat.Format (Format(..), Image, Index, parseIndex) as Format
+import AviaryFormat.Format (Format, Image, Index, parseIndex) as Format
 import Aviary.FFI (arrayBufferToBlob)
+import Aviary.Model (formatToMime, GalleryError(..), Image, ImageData(..), ImageError(..), Model(..))
 
 import Control.Monad.Error.Class (try)
-import Control.Parallel (parTraverse)
 import Effect (Effect)
 import Effect.Aff (Aff, launchAff)
 import Effect.Class (liftEffect)
 import Effect.Console (log)
-import Effect.Exception (message)
 import Fetch (fetch)
 import Data.Array (head)
 import Data.Base64 (decodeBase64, fromString)
-import Data.Either (Either(..), hush, note)
+import Data.Either (Either(..), note)
 import Data.Maybe (Maybe(..))
 import Data.Newtype (unwrap)
 import Data.ArrayBuffer.ArrayBuffer (byteLength)
@@ -23,8 +22,7 @@ import Data.ArrayBuffer.DataView (whole)
 import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Filterable (partitionMap)
 import Data.Foldable (traverse_)
-import Data.String (drop, indexOf', indexOf, splitAt)
+import Data.String (drop)
-import Data.String.Pattern (Pattern(..))
 import Parsing (runParserT)
 import Web.File.Url (createObjectURL)
 import Web.HTML (window) as HTML
@@ -43,67 +41,8 @@ nonceE = execPut $ traverse_ putInt8 [0xd0, 0xc3, 0x75, 0x56, 0x58, 0xc1, 0x7e,
 databuffToBuffer :: DataBuff -> Effect ArrayBuffer
 databuffToBuffer = execPut <<< putDataBuff
 
-data AviaryError
+decodeKey :: String -> Maybe ArrayBuffer
-    = ServerError
+decodeKey key = decodeBase64 <$> fromString key
-    | UnexpectedStatusCode Int
-    | MalformedKey
-    | MalformedUrl
-    | DecryptFailed
-    | ImageDecryptFailed
-    | StrangeIndex
-    | IndexMissingField String
-    | ImageNotFound
-    | IndexNotFound
-
-type Image =
-    { key :: Aff CryptoKey
-    , fullUrl :: String
-    , thumbUrl :: String
-    , blurhash :: String
-    , format :: Format.Format
-    }
-
-type Index =
-    { images :: Array Image
-    , title :: Maybe String
-    , desc :: Maybe String
-    }
-
-instance showAviaryError :: Show AviaryError where
-    show ServerError = "The server encountered an error"
-    show MalformedKey = "Malformed key!!"
-    show MalformedUrl = "Malformed url!!"
-    show DecryptFailed = "Either the data provided by the server was bad, or valid but incorrect key.  Expiration likely."
-    show ImageDecryptFailed = "The decryption of the album's index succeeded, but it contained a reference to an image whose decryption failed.  This likely indicates expiration"
-    show StrangeIndex = "The gallery index matched with the provided key, but was in a strange format.  This could indicate a severe version mismatch, or that the gallery was created by a malfunctioning client."
-    show (IndexMissingField f) = "The gallery index was missing the crucial field " <> f <> ".  This is almost certainly the result of a version mismatch or that the creator's client was not fully up-to-spec."
-    show ImageNotFound = "The image was not found, likely indicating that it expired"
-    show IndexNotFound = "The index was not found, likely indicating that the gallery never existed or expired"
-    show (UnexpectedStatusCode status) = "Server returned an unexpected status code: " <> (show status)
-
-type UrlInfo =
-    { server :: String
-    , fileId :: String
-    , key :: String
-    }
-
-formatToMime :: Format.Format -> String
-formatToMime Format.Format_WEBP = "image/webp"
-formatToMime Format.Format_AVIF = "image/avif"
-formatToMime Format.Format_JPG = "image/jpeg"
-formatToMime Format.Format_PNG = "image/png"
-formatToMime Format.Format_GIF = "image/gif"
-
-parseUrl :: String -> Either AviaryError UrlInfo
-parseUrl url = note MalformedUrl do
-    slashIndex <- indexOf' (Pattern "/") 8 url
-    let { after, before: server } = splitAt (1 + slashIndex) url
-    poundIndex <- indexOf (Pattern "#") after
-    let { after: key, before: fileId } = splitAt poundIndex after
-    Just { server, fileId, key: drop 1 key }
-
-decodeKey :: String -> Either AviaryError ArrayBuffer
-decodeKey key = note MalformedKey $ decodeBase64 <$> fromString key
 
 importKey :: ArrayBuffer -> Aff CryptoKey
 importKey key =
@@ -114,7 +53,7 @@ decryptBlob key cyphertext nonce =
     -- nonce <- makeAff (\_ -> nonceE)
     Alg.decrypt (Alg.aesGCM nonce Nothing (Just t128)) key cyphertext
 
-convertImageFromProtobuf :: Format.Image -> Either AviaryError Image
+convertImageFromProtobuf :: Format.Image -> Either GalleryError Image
 convertImageFromProtobuf protoimage = let protoimage' = unwrap protoimage in do
     rawKey <- note (IndexMissingField "images[].key") protoimage'.key
     fullUrl <- note (IndexMissingField "images[].full_url") protoimage'.full_url
@@ -122,43 +61,40 @@ convertImageFromProtobuf protoimage = let protoimage' = unwrap protoimage in do
     blurhash <- note (IndexMissingField "images[].blurhash") protoimage'.blurhash
     format <- note (IndexMissingField "images[].format") protoimage'.format
     let key = importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey)
-    pure { key, fullUrl, thumbUrl, blurhash, format }
+    let thumb = Unloaded thumbUrl
+    let full = Unloaded fullUrl
+    pure { key, blurhash, format, thumb, full }
 
-convertIndexFromProtobuf :: Format.Index -> Either AviaryError Index
+convertIndexFromProtobuf :: Format.Index -> Model
 convertIndexFromProtobuf protoindex =
     let protoindex' = unwrap protoindex in
     let {right: images, left: imagesErrors} = partitionMap convertImageFromProtobuf protoindex'.images
     in
     case head imagesErrors of
-        Nothing ->
+        Nothing -> GLoaded protoindex'.title protoindex'.desc images
-            Right
+        Just err -> GError err
-                { images
-                , title: protoindex'.title
-                , desc: protoindex'.desc
-                }
-        Just err -> Left err
 
-parseIndex :: ArrayBuffer -> Effect (Either AviaryError Index)
+parseIndex :: ArrayBuffer -> Effect Model
 parseIndex rawData = do
     parseResult <- runParserT (whole rawData) (Format.parseIndex (byteLength rawData))
-    _ <- liftEffect $ log $ show (parseResult)
+    pure case parseResult of
-    pure $ convertIndexFromProtobuf =<< (note StrangeIndex $ hush parseResult)
+        Left _ -> GError StrangeIndex
+        Right index -> convertIndexFromProtobuf index
 
-fetchImageAsBlobUrl :: ArrayBuffer -> Image -> Aff (Either AviaryError String)
+fetchImageAsBlobUrl :: ArrayBuffer -> Format.Format -> CryptoKey -> String -> Aff ImageData
-fetchImageAsBlobUrl nonce image = do
+fetchImageAsBlobUrl nonce format key fileID = do
-    cryptoKey <- image.key
+    { status, arrayBuffer } <- fetch (fileID <> ".bin") {}
-    { status, arrayBuffer } <- fetch (image.fullUrl <> ".bin") {}
     case status of
         200 -> do
             encryptedImage <- arrayBuffer
-            decryptedImage <- try $ decryptBlob cryptoKey encryptedImage nonce
+            decryptedImage <- try $ decryptBlob key encryptedImage nonce
             case decryptedImage of
-                Left _ -> pure $ Left ImageDecryptFailed
+                Left _ -> pure $ IError ImageDecryptFailed
                 Right rawImage -> do
-                    url <- liftEffect $ createObjectURL $ (arrayBufferToBlob $ formatToMime image.format) rawImage
+                    url <- liftEffect $ createObjectURL $ (arrayBufferToBlob $ formatToMime format) rawImage
-                    pure $ Right url
+                    pure $ ILoaded url
-        404 -> pure $ Left ImageNotFound
+        404 -> pure $ IError ImageNotFound
-        s -> pure $ Left $ if s / 100 == 5 then ServerError else UnexpectedStatusCode s
+        s -> pure $ IError $ if s / 100 == 5 then MinorServerError else UnknownStatusCodeForImage s
 
 main_aff :: Aff Unit
 main_aff = do
@@ -170,9 +106,9 @@ main_aff = do
         fileId <- drop 1 <$> Location.pathname location
         nonce <- nonceE
         pure {keyB64, server, fileId, nonce}
-    maybeIndex <- case decodeKey urlInfo.keyB64 of
+    gallery <- case decodeKey urlInfo.keyB64 of
-        Left err -> pure $ Left err
+        Nothing -> pure $ GError MalformedKey
-        Right keyBuffer -> do
+        Just keyBuffer -> do
             cryptoKey <- importKey keyBuffer
             { status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {}
             case status of
@@ -180,17 +116,12 @@ main_aff = do
                     encryptedIndex <- arrayBuffer
                     serializedIndex <- try $ decryptBlob cryptoKey encryptedIndex urlInfo.nonce
                     case serializedIndex of
-                        Left err -> do
+                        Left _ -> pure $ GError DecryptFailed
-                            _ <- liftEffect $ log $ message err
-                            pure $ Left $ DecryptFailed
                         Right serializedIndex' -> do
                             liftEffect $ parseIndex serializedIndex'
-                404 -> pure $ Left ImageNotFound
+                404 -> pure $ GError NotFound
-                s -> pure $ Left $ if s / 100 == 5 then ServerError else UnexpectedStatusCode s
+                s -> pure $ GError $ if s / 100 == 5 then ServerError else UnknownStatusCodeForIndex s
-    maybeUrls <- case maybeIndex of
+    liftEffect $ log "Gallery info loaded or error.  No I won't tell you which one."
-        Left err -> pure $ Left err
-        Right index -> Right <$> parTraverse (fetchImageAsBlobUrl urlInfo.nonce) index.images
-    liftEffect $ log $ show maybeUrls
 
 main :: Effect Unit
 main = launchAff main_aff $> unit

src/Model.purs

@@ -0,0 +1,100 @@
+module Aviary.Model where
+
+import Prelude
+
+import AviaryFormat.Format (Format(..)) as Format
+
+import Crypto.Subtle.Key.Types (CryptoKey)
+import Data.Maybe (Maybe(..))
+import Effect.Aff (Aff)
+
+data GalleryError
+    = ServerError
+    | NotFound
+    | MalformedKey
+    | DecryptFailed
+    | StrangeIndex
+    | IndexMissingField String
+    | UnknownStatusCodeForIndex Int
+
+data ImageError
+    = MinorServerError
+    | ImageNotFound
+    | BadIndexData
+    | ImageDecryptFailed
+    | UnknownStatusCodeForImage Int
+
+data ImageData
+    = Unloaded String -- file ID of encrypted data
+    | ILoaded String -- blob url of decrypted image
+    | IError ImageError
+
+type Image =
+    { key :: Aff CryptoKey
+    , blurhash :: String
+    , format :: Format.Format
+    , thumb :: ImageData
+    , full :: ImageData
+    }
+
+data Model
+    = GError GalleryError
+    | GLoaded
+        (Maybe String) -- Title
+        (Maybe String) -- Description
+        (Array Image) -- Images
+
+instance showGalleryError :: Show GalleryError where
+    show ServerError =
+        "The server is experiencing issues at the minute.  Please try again later, or if "
+        <> "it keeps up, make a report to the server owner."
+    show NotFound =
+        "Either this gallery never existed, or it has already expired.  Either way, "
+        <> "there's nothing here now."
+    show MalformedKey =
+        "Hmm, something about the decryption key in your URL doesn't seem quite right.  "
+        <> "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 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 "
+        <> "that used to be here has expired."
+    show StrangeIndex =
+        "Hmm, something is strange here.  I was able to decrypt the data for this "
+        <> "gallery, but I couldn't make any sense of it.  It's possible that this "
+        <> "gallery was created with an incompatible protocol, or the client used to "
+        <> "create this gallery was malfunctioning.  Specifically, the gallery index was "
+        <> "successfully decrypted, but isn't valid protobuf data."
+    show (IndexMissingField field) =
+        "Uh oh!  This gallery's index was missing crucial information.  This probably "
+        <> "means that it was created with an older version of Aviary that is no longer "
+        <> "supported.  The field that was missing is: " <> field
+    show (UnknownStatusCodeForIndex 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 "
+        <> "and be more helpful next time.  The unknown code was:  " <> (show code)
+
+instance showImageError :: Show ImageError where
+    show MinorServerError =
+        "Oops!  The server is experiencing issues at the minute, and wasn't able to send "
+        <> "this image.  Please try reloading the page after a few minutes, and if the "
+        <> "issue keeps up, try contacting the server admin."
+    show ImageNotFound =
+        "This image has expired, and isn't available anymore"
+    show BadIndexData =
+        "Uh oh!  This gallery had some corrupted-seeming data in it, and I wasn't able "
+        <> "to load this image because of it."
+    show ImageDecryptFailed =
+        "This image seems to have expired"
+    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 "
+        <> "and be more helpful next time.  The unknown code was:  " <> (show code)
+
+formatToMime :: Format.Format -> String
+formatToMime Format.Format_WEBP = "image/webp"
+formatToMime Format.Format_AVIF = "image/avif"
+formatToMime Format.Format_JPG = "image/jpeg"
+formatToMime Format.Format_PNG = "image/png"
+formatToMime Format.Format_GIF = "image/gif"