-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>,Sarah Vaupel <sarah.vaupel@ifi.lmu.de>,Sarah Vaupel <vaupel.sarah@campus.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.CryptoID.Instances
  (
  ) where

import qualified Data.CryptoID as CID
import qualified Data.CryptoID.Poly as CID
import qualified Data.CryptoID.Class.ImplicitNamespace as I

import Text.Blaze (ToMarkup(..))

import ClassyPrelude

import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI

import Web.PathPieces
import Data.Aeson (ToJSON(..), ToJSONKey(..), ToJSONKeyFunction(..))

import qualified Data.Csv as Csv

import Data.Swagger (ToSchema, ToParamSchema)

import Servant.Docs (ToSample(..))

import Control.Monad.Catch.Pure

import Data.Proxy
import Data.Tagged

import System.IO.Unsafe

import Control.Lens ((??))


deriving newtype instance ToParamSchema s => ToParamSchema (CID.CryptoID c s)
deriving newtype instance ToSchema s => ToSchema (CID.CryptoID c s)

sampleKey :: CID.CryptoIDKey
sampleKey = unsafePerformIO CID.genKey
{-# NOINLINE sampleKey #-}

instance (ToSample p, ns ~ I.CryptoIDNamespace c p, CID.HasCryptoID ns c p (ReaderT CID.CryptoIDKey Catch)) => ToSample (Tagged p (CID.CryptoID ns c)) where
  toSamples _ = mapMaybe (\(l, s) -> (l, ) <$> encrypt' s) $ toSamples (Proxy @p)
    where
      encrypt' :: p -> Maybe (Tagged p (CID.CryptoID ns c))
      encrypt' p = either (const Nothing) (Just . Tagged) . runCatch . (runReaderT ?? sampleKey) $ I.encrypt p

instance ToMarkup s => ToMarkup (CID.CryptoID c s) where
  toMarkup = toMarkup . CID.ciphertext

instance {-# OVERLAPS #-} ToMarkup s => ToMarkup (CID.CryptoID c (CI s)) where
  toMarkup = toMarkup . CI.foldedCase . CID.ciphertext

instance {-# OVERLAPS #-} ToJSON s => ToJSON (CID.CryptoID c (CI s)) where
  toJSON = toJSON . CI.foldedCase . CID.ciphertext

instance {-# OVERLAPS #-} (ToJSON s, ToJSONKey s) => ToJSONKey (CID.CryptoID c (CI s)) where
  toJSONKey = case toJSONKey of
    ToJSONKeyText toT toE -> ToJSONKeyText (toT . CI.foldedCase . CID.ciphertext) (toE . CI.foldedCase . CID.ciphertext)
    ToJSONKeyValue toV toE -> ToJSONKeyValue (toV . CI.foldedCase . CID.ciphertext) (toE . CI.foldedCase . CID.ciphertext)

instance {-# OVERLAPS #-} (PathPiece s, CI.FoldCase s) => PathPiece (CID.CryptoID c (CI s)) where
  toPathPiece = toPathPiece . CI.foldedCase . CID.ciphertext
  fromPathPiece = fmap (CID.CryptoID . CI.mk) . fromPathPiece

instance Csv.FromField s => Csv.FromField (CID.CryptoID c s) where
  parseField = fmap CID.CryptoID . Csv.parseField

instance Csv.ToField s => Csv.ToField (CID.CryptoID c s) where
  toField = Csv.toField . CID.ciphertext

instance {-# OVERLAPS #-} Csv.ToField s => Csv.ToField (CID.CryptoID c (CI s)) where
  toField = Csv.toField . CI.foldedCase . CID.ciphertext
