{-# Language MultiWayIf #-}

module HBS2.CLI.Run.MetaData (metaDataEntries) where

import HBS2.CLI.Prelude
import HBS2.CLI.Run.Internal
import HBS2.CLI.Run.Internal.GroupKey
import HBS2.CLI.Run.Internal.Merkle

import HBS2.Data.Types.Refs
import HBS2.Merkle
import HBS2.System.Logger.Simple.ANSI as All
import HBS2.System.Dir
import HBS2.Storage
import HBS2.Storage.Operations.ByteString
import HBS2.Peer.CLI.Detect
import HBS2.Peer.RPC.Client.Unix
import HBS2.Peer.RPC.API.Storage
import HBS2.Peer.RPC.Client.StorageClient
import HBS2.KeyMan.Keys.Direct

import HBS2.Net.Auth.Schema()

import Codec.Serialise
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Cont
import Data.ByteString.Lazy qualified as LBS
import Data.Either
import Data.Set qualified as Set
import Data.HashMap.Strict qualified as HM
import Data.Maybe
import Data.Text.Encoding qualified as TE
import Data.Text qualified as Text

import Magic.Data
import Magic.Init       (magicLoadDefault,magicOpen)
import Magic.Operations (magicFile)

{- HLINT ignore "Functor law" -}

data CreateMetaDataOpt =
    Auto
  | Stdin
  | Encrypted String
  | MetaDataEntry Id String
  | MetaDataFile FilePath
  deriving stock (Eq,Ord,Show,Data,Generic)

txt :: Pretty  a => a -> Text
txt a = Text.pack (show $ pretty a)

metaFromSyntax :: [Syntax c] -> HashMap Text Text
metaFromSyntax syn =
  HM.fromList [ (t k, t v) | (ListVal [ k, v ]) <- syn ]
  where
    t x = Text.pack (show $ pretty x)


metaDataEntries :: forall c m . (c ~ C, IsContext c, MonadUnliftIO m) => MakeDictM c m ()
metaDataEntries = do

  entry $ bindMatch "hbs2:tree:metadata:get" $ \case
    [ SymbolVal how, StringLike hash ] -> do

      -- FIXME: put-to-the-state
      so <- detectRPC `orDie` "hbs2-peer not found"

      r <- withRPC2 @StorageAPI  @UNIX so $ \caller -> do
        let sto = AnyStorage (StorageClient caller)

        runMaybeT do

          headBlock <- getBlock sto (fromString hash)
                         >>= toMPlus
                         <&> deserialiseOrFail @(MTreeAnn [HashRef])
                         >>= toMPlus

          case headBlock of
            MTreeAnn { _mtaMeta = ShortMetadata s } -> do
              pure $ mkStr s

            MTreeAnn { _mtaMeta = AnnHashRef h } -> do
              getBlock sto h
                 >>= toMPlus
                 <&> LBS.toStrict
                 <&> TE.decodeUtf8
                 <&> mkStr

            _ -> mzero

      case (how, r) of
        ("parsed", Just (LitStrVal r0)) -> do


          let xs = parseTop r0
                     & fromRight mempty

          pure $ mkForm  "dict" xs

        _ -> pure $ fromMaybe nil r

    _ -> throwIO (BadFormException @c nil)

  entry $ bindMatch "hbs2:tree:metadata:create" $ \syn -> do

    case syn of

      args -> do
        opts' <- for args $ \case
          SymbolVal "stdin"     -> pure [Stdin]

          SymbolVal "auto"      -> pure [Auto]

          ListVal (SymbolVal "dict" : [ListVal [SymbolVal "encrypted", StringLike key]])
            -> do
              pure [Encrypted key]

          ListVal (SymbolVal "dict" : w)  -> do
            pure [MetaDataEntry x y | ListVal [SymbolVal x, StringLike y] <- w ]

          StringLike rest  -> do
            pure [MetaDataFile rest]

          _ -> pure mempty

        let opts = mconcat opts' & Set.fromList
        let inFile = headMay [ x | MetaDataFile x <- universeBi opts ]

        lbs <- case (Set.member Stdin opts, inFile) of
                 (True, _) -> liftIO LBS.getContents
                 (False, Just fn) -> liftIO (LBS.readFile fn)
                 (_, Nothing) -> liftIO LBS.getContents

        meta0 <- if not (Set.member Auto opts) || isNothing inFile then
                   pure (mempty :: HashMap Text Text)
                 else liftIO do
                    let fn = fromJust inFile
                    magic <- magicOpen [MagicMimeType,MagicMime,MagicMimeEncoding]
                    magicLoadDefault magic
                    mime <- magicFile magic fn
                    pure $ HM.fromList [ ("file-name", Text.pack (takeFileName fn))
                                       , ("mime-type", Text.pack mime)
                                       ]

        let meta1  = HM.fromList [  (txt n, txt e) | MetaDataEntry n e <- universeBi opts ]

        let enc = headMay [ e | x@(Encrypted e) <- universeBi opts ]

        gk <- runMaybeT do
                s <- toMPlus enc
                g <- lift $ loadGroupKey (fromString s)
                toMPlus g

        when (isJust enc && isNothing gk) do
          error $ show $  "Can't load group key" <+> pretty enc

        flip runContT pure do

          sto <- ContT withPeerStorage

          href <- lift (createTreeWithMetadata sto  gk (meta0 <> meta1) lbs)
                    `orDie` "encryption error"

          pure $ mkStr (show $ pretty href)

  entry $ bindMatch "cbor:base58" $ \case
    [ LitStrVal x ] -> do
      pure $ mkForm "cbor:base58" [mkStr x]

    _ -> throwIO (BadFormException @c nil)