module Model.Types.File
  ( FileContentChunkReference(..), FileContentReference(..)
  , File(..), _fileTitle, _fileContent, _fileModified
  , PureFile, toPureFile, fromPureFile, pureFileToFileReference, _pureFileContent
  , transFile
  , minioFileReference
  , FileReference(..), _fileReferenceTitle, _fileReferenceContent, _fileReferenceModified
  , HasFileReference(..), IsFileReference(..), FileReferenceResidual(FileReferenceResidual, FileReferenceResidualEither, unFileReferenceResidualEither, FileReferenceResidualEntity, fileReferenceResidualEntityKey, fileReferenceResidualEntityResidual, unPureFileResidual)
  ) where

import Import.NoModel
   
import Database.Persist.Sql (PersistFieldSql)
import Web.HttpApiData (ToHttpApiData, FromHttpApiData)
import Data.ByteArray (ByteArrayAccess)

import qualified Data.ByteString.Base64.URL as Base64
import qualified Data.ByteArray as ByteArray
import qualified Network.Minio as Minio (Object)
import qualified Crypto.Hash as Crypto (digestFromByteString)
import qualified Crypto.Hash.Conduit as Crypto (sinkHash)

import Utils.Lens.TH

import qualified Data.Conduit.Combinators as C

import Text.Show



newtype FileContentChunkReference = FileContentChunkReference (Digest SHA3_512)
  deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
  deriving newtype ( PersistField, PersistFieldSql
                   , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
                   , Hashable, NFData
                   , ByteArrayAccess
                   )

makeWrapped ''FileContentChunkReference

newtype FileContentReference = FileContentReference (Digest SHA3_512)
  deriving (Eq, Ord, Read, Show, Lift, Generic, Typeable)
  deriving newtype ( PersistField, PersistFieldSql
                   , PathPiece, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON
                   , Hashable, NFData
                   , ByteArrayAccess
                   )

makeWrapped ''FileContentReference


minioFileReference :: Prism' Minio.Object FileContentReference
minioFileReference = prism' toObjectName fromObjectName
  where toObjectName = decodeUtf8 . Base64.encodeUnpadded . ByteArray.convert
        fromObjectName = fmap (review _Wrapped) . Crypto.digestFromByteString <=< preview _Right . Base64.decodeUnpadded . encodeUtf8
  

data File m = File
  { fileTitle    :: FilePath
  , fileContent  :: Maybe (ConduitT () ByteString m ())
  , fileModified :: UTCTime
  } deriving (Generic, Typeable)

makeLenses_ ''File

type PureFile = File Identity

_pureFileContent :: forall bs.
                    ( IsSequence bs
                    , Element bs ~ Word8
                    )
                 => Lens' PureFile (Maybe bs)
_pureFileContent = lens getPureFileContent setPureFileContent
  where
    getPureFileContent = fmap (repack . runIdentity . runConduit . (.| C.fold)) . fileContent
    setPureFileContent f bs = f { fileContent = yield . repack <$> bs }

toPureFile :: Monad m => File m -> m PureFile
toPureFile File{..} = do
  c <- for fileContent $ runConduit . (.| C.fold)
  return File
    { fileContent = fmap yield c
    , ..
    }

fromPureFile :: Monad m => PureFile -> File m
fromPureFile = transFile generalize

pureFileToFileReference :: PureFile -> FileReference
pureFileToFileReference File{..} = FileReference
  { fileReferenceTitle    = fileTitle
  , fileReferenceContent  = review _Wrapped . runIdentity . runConduit . (.| Crypto.sinkHash) <$> fileContent
  , fileReferenceModified = fileModified
  }

instance Eq PureFile where
  a == b = all (\f -> f a b)
    [ (==) `on` fileTitle
    , (==) `on` fileModified
    , (==) `on` (view _pureFileContent :: PureFile -> Maybe ByteString)
    ]
instance Ord PureFile where
  compare = mconcat
    [ comparing fileTitle
    , comparing (view _pureFileContent :: PureFile -> Maybe ByteString)
    , comparing fileModified
    ]
instance Show PureFile where
  showsPrec _ f@File{..}
    = showString "File{"
    . showString "fileTitle = "
    . shows fileTitle
    . showString ", "
    . showString "fileContent = "
    . (case f ^. _pureFileContent of
          Nothing -> showString "Nothing"
          Just c  -> showString "Just $ yield " . showsPrec 11 (c :: ByteString)
      )
    . showString ", "
    . showString "fileModified = "
    . shows fileModified
    . showString "}"

transFile :: Monad m => (forall a. m a -> n a) -> (File m -> File n)
transFile l File{..} = File{ fileContent = transPipe l <$> fileContent, .. }

data FileReference = FileReference
  { fileReferenceTitle    :: FilePath
  , fileReferenceContent  :: Maybe FileContentReference
  , fileReferenceModified :: UTCTime
  } deriving (Eq, Ord, Read, Show, Generic, Typeable)

makeLenses_ ''FileReference


class HasFileReference record where
  data FileReferenceResidual record :: Type

  _FileReference :: Iso' record (FileReference, FileReferenceResidual record)

instance HasFileReference FileReference where
  data FileReferenceResidual FileReference = FileReferenceResidual
  _FileReference = iso (, FileReferenceResidual) $ view _1

instance HasFileReference PureFile where
  newtype FileReferenceResidual PureFile = PureFileResidual { unPureFileResidual :: Maybe ByteString }
    deriving (Eq, Ord, Read, Show, Generic, Typeable)

  _FileReference = iso toFileReference fromFileReference
    where
      toFileReference File{..} = (FileReference{..}, PureFileResidual{..})
        where
          fileReferenceTitle = fileTitle
          (fileReferenceContent, unPureFileResidual) = ((,) <$> preview (_Just . _1) <*> preview (_Just . _2)) $
            over _1 (review _Wrapped) . runIdentity . runConduit . (.| getZipConduit ((,) <$> ZipConduit Crypto.sinkHash <*> ZipConduit C.fold)) <$> fileContent
          fileReferenceModified = fileModified
      fromFileReference (FileReference{..}, PureFileResidual{..}) = File
        { fileTitle = fileReferenceTitle
        , fileContent = yield <$> unPureFileResidual
        , fileModified = fileReferenceModified
        }

instance (HasFileReference a, HasFileReference b) => HasFileReference (Either a b) where
  newtype FileReferenceResidual (Either a b) = FileReferenceResidualEither { unFileReferenceResidualEither :: Either (FileReferenceResidual a) (FileReferenceResidual b) }
  _FileReference = iso doSplit doJoin
    where doSplit (Right r) = over _2 (FileReferenceResidualEither . Right) $ r ^. _FileReference
          doSplit (Left  r) = over _2 (FileReferenceResidualEither . Left ) $ r ^. _FileReference
          doJoin (fRef, FileReferenceResidualEither (Right res)) = Right $ _FileReference # (fRef, res)
          doJoin (fRef, FileReferenceResidualEither (Left  res)) = Left  $ _FileReference # (fRef, res)

instance HasFileReference record => HasFileReference (Entity record) where
  data FileReferenceResidual (Entity record) = FileReferenceResidualEntity
    { fileReferenceResidualEntityKey :: Key record
    , fileReferenceResidualEntityResidual :: FileReferenceResidual record
    }
  _FileReference = iso doSplit doJoin
    where doSplit Entity{..} = (fRef, FileReferenceResidualEntity entityKey res)
            where (fRef, res) = entityVal ^. _FileReference
          doJoin (fRef, FileReferenceResidualEntity entityKey res) = Entity{ entityVal = _FileReference # (fRef, res), .. }

class (PersistEntity record, HasFileReference record) => IsFileReference record where
  fileReferenceTitleField    :: EntityField record FilePath
  fileReferenceContentField  :: EntityField record (Maybe FileContentReference)
  fileReferenceModifiedField :: EntityField record UTCTime
