aviary-ps/src/Model.purs

module Aviary.Model where

import Prelude

import AviaryFormat.Format (Format(..)) as Format

import Crypto.Subtle.Key.Types (CryptoKey)
import Data.Array (modifyAt)
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)

data GalleryError
    = UnexpectedError String
    | ServerError
    | NotFound
    | MalformedKey
    | MissingKey
    | DecryptFailed
    | StrangeIndex
    | IndexMissingField String
    | UnknownStatusCodeForIndex Int
    | TotalNetworkError

data RecoverableImageError
    = NetworkError String
    | MinorServerError

data PermanentImageError
    = ImageNotFound
    | BadIndexData
    | ImageDecryptFailed
    | UnknownStatusCodeForImage Int
    | BadKey

data ImageData
    = Unloaded String -- file ID of encrypted data
    | Loading
    | Retrying String RecoverableImageError
    | ILoaded String -- blob url of decrypted image
    | IError PermanentImageError

instance showImageData :: Show ImageData where
    show (Unloaded fileID) = "Unloaded Image with fileID " <> fileID
    show Loading = "Image loading..."
    show (Retrying fileID e) = "temporary network error [" <> (show e) <> "] while loading image with fileID " <> fileID
    show (ILoaded url) = "image: " <> url
    show (IError e) = "error loading image: " <> (show e)

type Image =
    { key :: Aff (Maybe CryptoKey)
    , blurhashUrl :: Maybe String
    , format :: Format.Format
    , thumb :: ImageData
    , full :: ImageData
    , width :: Int
    , height :: Int
    }

type Focus =
    { imageIndex :: Int
    , zoom :: Boolean
    }

type LoadedGallery =
    { title :: Maybe String
    , desc :: Maybe String
    , images :: Array Image
    , focus :: Maybe Focus
    }

data Model
    = GError GalleryError
    | GLoaded LoadedGallery

setImage :: (Image -> Image) -> Int -> LoadedGallery -> Model
setImage tranformation pos gallery =
    case modifyAt pos tranformation gallery.images of
        Just newImages -> GLoaded gallery{images = newImages}
        Nothing -> GError $ UnexpectedError "setImage called with an out of bounds index!"

setThumb :: ImageData -> Int -> LoadedGallery -> Model
setThumb newThumb = setImage \i -> i{thumb = newThumb}

setFull :: ImageData -> Int -> LoadedGallery -> Model
setFull newImage = setImage \i -> i{full = newImage}

focusedIndex :: Model -> Maybe Int
focusedIndex (GLoaded { focus: Just { imageIndex } }) = Just imageIndex
focusedIndex _ = Nothing

instance showGalleryError :: Show GalleryError where
    show (UnexpectedError message) =
        "Something that should be impossible just happened!  Please open up a new issue "
        <> "on our issue tracker to let us know, so that we can stop it from happening "
        <> "in the future.  The thing that happened was:  " <> message
    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 MissingKey =
        "This image gallery is encrypted, and you don't have the key!  Double check "
        <> "you've entered the whole URL, which should include a pound sign (#) in the "
        <> "middle.  If the URL you were sent doesn't have a pound sign in the middle, "
        <> "you were sent a partial URL and won't be able to decrypt this content "
        <> "without a key."
    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)
    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 showRecoverableImageError :: Show RecoverableImageError 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 (NetworkError msg) =
        "A network error occured while trying to download this image - " <> msg

instance showPermanentImageError :: Show PermanentImageError where
    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)
    show BadKey =
        "The key associated with this image is bad, and it cannot be loaded"

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"