module Aviary.Logic where

import Prelude
import AviaryFormat.Format (Format(..), Image, Index, parseIndex) as Format
import Aviary.FFI (arrayBufferToBlob, nonce_a, nonce_b, decodeBlurhash32)
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 Effect.Exception (message)
import Fetch (fetch)
import Data.Array (head)
import Data.Base64 (decodeBase64, fromString)
import Data.Either (Either(..), hush, 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, 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 (Either GalleryError CryptoKey)
importKey key = do
    maybeImportedKey <- try $ SC.importKey raw key (aes aesGCM) false [decrypt]
    pure case maybeImportedKey of
        Right importedKey -> Right importedKey
        Left _ -> Left if byteLength key == 0
            then MissingKey
            else MalformedKey

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 blurhashUrl = decodeBlurhash32 blurhash
    let key = hush <$> (importKey =<< liftEffect (databuffToBuffer $ unwrap rawKey))
    let thumb = Unloaded thumbUrl
    let full = Unloaded fullUrl
    pure { key, blurhashUrl, 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
    result <- try $ fetch (fileID <> ".bin") {}
    case result of
        Right {status: 200, arrayBuffer} -> 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
        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 :: ArrayBuffer -> ImageData -> Format.Format -> Aff (Maybe CryptoKey) -> Aff ImageData
_fetchImg nonce imgdata format cryptokey = case imgdata of
    Unloaded fileID -> do
        key' <- cryptokey
        case key' of
            Nothing -> pure $ IError BadKey
            Just key -> fetchImageAsBlobUrl nonce format key fileID
    loadedOrError -> pure loadedOrError

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

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

type Parameters =
    { fileId :: String
    , key :: CryptoKey
    }

get_parameters :: Aff (Either GalleryError Parameters)
get_parameters = do
    urlInfo <- liftEffect do
        window <- HTML.window
        location <- location window
        keyB64 <- drop 1 <$> Location.hash location
        fileId <- drop 1 <$> Location.pathname location
        pure {keyB64, fileId}
    case decodeKey urlInfo.keyB64 of
        Nothing -> pure $ Left MalformedKey
        Just keyBuffer -> do
            cryptoKey <- importKey keyBuffer
            case cryptoKey of
                Left e -> pure $ Left e
                Right cryptoKey' -> pure $ Right {fileId: urlInfo.fileId, key: cryptoKey'}

fetch_and_decrypt_gallery :: Parameters -> Aff Model
fetch_and_decrypt_gallery params = do
    result <- try $ fetch (params.fileId <> ".bin") {}
    case result of
        Right {status: 200, arrayBuffer} -> do
            encryptedIndex <- arrayBuffer
            serializedIndex <- try $ decryptBlob params.key encryptedIndex nonce_a
            case serializedIndex of
                Left _ -> pure $ GError DecryptFailed
                Right serializedIndex' -> do
                    liftEffect $ parseIndex serializedIndex'
        Right {status: 404} -> pure $ GError NotFound
        Right {status} ->
            pure $ GError $
                if status / 100 == 5
                    then ServerError
                    else UnknownStatusCodeForIndex status
        Left _ -> pure $ GError $ TotalNetworkError