module Aviary.Logic where

import Prelude
import AviaryFormat.Format (Format(..), Image, Index, parseIndex) as Format
import Aviary.FFI (arrayBufferToBlob, nonce)
import Aviary.Model (formatToMime, GalleryError(..), Image, ImageData(..), ImageError(..), Model(..))

import Control.Monad.Error.Class (try)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
import Fetch (fetch)
import Data.Array (head)
import Data.Base64 (decodeBase64, fromString)
import Data.Either (Either(..), note)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.ArrayBuffer.ArrayBuffer (byteLength)
import Data.ArrayBuffer.Builder (DataBuff, execPut, putDataBuff)
import Data.ArrayBuffer.DataView (whole)
import Data.ArrayBuffer.Types (ArrayBuffer)
import Data.Filterable (partitionMap)
import Data.String (drop)
import Parsing (runParserT)
import Web.File.Url (createObjectURL)
import Web.HTML (window) as HTML
import Web.HTML.Window (location)
import Web.HTML.Location (hash, origin, pathname) as Location

import Crypto.Subtle.Constants.AES (aesGCM, t128)
import Crypto.Subtle.Encrypt (aesGCM, decrypt) as Alg
import Crypto.Subtle.Key.Import (aes)
import Crypto.Subtle.Key.Import (importKey) as SC
import Crypto.Subtle.Key.Types (CryptoKey, decrypt, raw)

databuffToBuffer :: DataBuff -> Effect ArrayBuffer
databuffToBuffer = execPut <<< putDataBuff

decodeKey :: String -> Maybe ArrayBuffer
decodeKey key = decodeBase64 <$> fromString key

importKey :: ArrayBuffer -> Aff CryptoKey
importKey key =
    SC.importKey raw key (aes aesGCM) false [decrypt]

decryptBlob :: CryptoKey -> ArrayBuffer -> ArrayBuffer -> Aff ArrayBuffer
decryptBlob key cyphertext nonce =
    Alg.decrypt (Alg.aesGCM nonce Nothing (Just t128)) key cyphertext

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
    thumbUrl <- note (IndexMissingField "images[].thumb_url") protoimage'.thumb_url
    blurhash <- note (IndexMissingField "images[].blurhash") protoimage'.blurhash
    format <- note (IndexMissingField "images[].format") protoimage'.format
    let key = importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey)
    let thumb = Unloaded thumbUrl
    let full = Unloaded fullUrl
    pure { key, blurhash, format, thumb, full }

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 -> GLoaded
            { title: protoindex'.title
            , desc: protoindex'.desc
            , images
            , focus: Nothing
            }
        Just err -> GError err

parseIndex :: ArrayBuffer -> Effect Model
parseIndex rawData = do
    parseResult <- runParserT (whole rawData) (Format.parseIndex (byteLength rawData))
    pure case parseResult of
        Left _ -> GError StrangeIndex
        Right index -> convertIndexFromProtobuf index

fetchImageAsBlobUrl :: ArrayBuffer -> Format.Format -> CryptoKey -> String -> Aff ImageData
fetchImageAsBlobUrl nonce format key fileID = do
    { status, arrayBuffer } <- fetch (fileID <> ".bin") {}
    case status of
        200 -> do
            encryptedImage <- arrayBuffer
            decryptedImage <- try $ decryptBlob key encryptedImage nonce
            case decryptedImage of
                Left _ -> pure $ IError ImageDecryptFailed
                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

_fetchImg :: ImageData -> Format.Format -> Aff CryptoKey -> Aff ImageData
_fetchImg imgdata format cryptokey = case imgdata of
    Unloaded fileID -> do
        key <- cryptokey
        fetchImageAsBlobUrl nonce format key fileID
    loadedOrError -> pure loadedOrError

fetchThumb :: Image -> Aff ImageData
fetchThumb image = _fetchImg image.thumb Format.Format_WEBP image.key

fetchFull :: Image -> Aff ImageData
fetchFull image = _fetchImg image.full image.format image.key

fetch_gallery_from_page_info :: Aff Model
fetch_gallery_from_page_info = do
    urlInfo <- liftEffect do
        window <- HTML.window
        location <- location window
        keyB64 <- drop 1 <$> Location.hash location
        server <- Location.origin location
        fileId <- drop 1 <$> Location.pathname location
        pure {keyB64, server, fileId}
    case decodeKey urlInfo.keyB64 of
        Nothing -> pure $ GError MalformedKey
        Just keyBuffer -> do
            cryptoKey <- importKey keyBuffer
            { status, arrayBuffer } <- fetch (urlInfo.server <> "/" <> urlInfo.fileId <> ".bin") {}
            case status of
                200 -> 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