{-

Copyright © Jon Kristensen, 2010-2011.

This file is part of Pontarius Media Server.

Pontarius Media Server is free software: you can redistribute it and/or modify
it under the terms of the GNU Affero General Public License as published by the
Free Software Foundation, either version 3 of the License, or (at your option)
any later version.

Pontarius Media Server is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License along
with Pontarius Media Server. If not, see <http://www.gnu.org/licenses/>.

-}


-- | Module:      $Header$
--   Description: Utilities for managing media objects
--   Copyright:   Copyright © 2010-2011 Jon Kristensen
--   License:     AGPL-3
--   
--   Maintainer:  info@pontarius.org
--   Stability:   unstable
--   Portability: portable

-- | An 'Object' is either an 'Item' or a 'Container'. 'Item's and 'Container's
--   both have 'ObjectAttributes'. 'Additionally, Item's have 'ItemAttributes'.
--   
--   A 'PersistedObject' represents an 'Object' which has been stored in the
--   database (thus having an identifier and perhaps also a parent). This
--   identifier cannot be changed.

-- Parts of this module are not very thoroughly done as we are considering
-- moving to HaskellDB.

-- Example for specific meta-data (log table not tested):
--
-- run c "CREATE TABLE metadata_1 (id INTEGER PRIMARY KEY NOT NULL, object_i" ++
--       "d INTEGER NOT NULL, dummy_value INTEGER, FOREIGN KEY(object_id) RE" ++
--       "FERENCES objects(id))" [] -- x in metadata_x is the types value
-- run c "CREATE TABLE metadata_1_log (id INTEGER PRIMARY KEY NOT NULL, meta" ++
--       "data_id INTEGER NOT NULL, object_id TEXT NOT NULL, dummy_value INT" ++
--       "EGER, FOREIGN KEY(object_id) REFERENCES objects(id), FOREIGN KEY(m" ++
--       "etadata_id) REFERENCES metadata_1(id))" []

module Media.XPMN.Server.Object ( Object
                                , ObjectID
                                , PersistedObject
                                , connectToDatabase
                                , initializeDatabase
                                , objectID
                                , parentID
                                , object
                                , container
                                , item
                                , persist
                                , update
                                , getRoot
                                , getChildren
                                , getObject
                                , insertDummyData -- TODO: Remove
                                ) where

import Database.HDBC
import Database.HDBC.Sqlite3

import Data.XML.Types

import Network.XMPP

import qualified Data.ByteString.Char8 as DB

data ObjectEvent = OEObjectPersisted

-- An object cannot have its objectID modified.
-- TODO: Add date and time information?

type ObjectID = String -- TODO: Use UUID

data Object = Item { itemObjectAttributes :: ObjectAttributes
                   , itemAttributes :: ItemAttributes } |
              Container ObjectAttributes deriving (Show)

data ObjectAttributes = ObjectAttributes { objectName :: Maybe String
                                         , objectType :: Maybe Integer
                                         , objectExtraMetadata :: Maybe Element } deriving (Show)

data ItemAttributes = ItemAttributes { objectHash :: Maybe String -- TODO
                                     , objectSize :: Maybe Integer } deriving (Show)

data PersistedObject = PO (ObjectID, Maybe ObjectID, Object) deriving (Show)


-- | Connects to the local database (the provided string appended by ".db).

connectToDatabase :: String -> IO Connection
connectToDatabase s = connectSqlite3 (s ++ ".db")


disconnectFromDatabase :: IConnection c => c -> IO ()
disconnectFromDatabase l = disconnect l


objectAttributes :: Object -> ObjectAttributes
objectAttributes (Item { itemObjectAttributes = oa }) = oa
objectAttributes (Container oa) = oa


-- | Creates the necessary tables.

-- TODO: Use withTransaction?

initializeDatabase :: IConnection conn => conn -> IO ()

initializeDatabase c = do
  -- Create the object data and log table
  run c "CREATE TABLE objects (id TEXT PRIMARY KEY NOT NULL, parent_id TEXT, name TEXT, type INTEGER, extra_metadata TEXT, is_container INTEGER NOT NULL, hash TEXT, size INTEGER)" [] -- , CHECK ((is_container = 0 and (hash isnull) and (size isnull)) or (is_container != 0 and (not (hash isnull)) and (not (size isnull)))))
  run c "CREATE TABLE objects_log (id INTEGER PRIMARY KEY NOT NULL, object_id TEXT NOT NULL, parent_id TEXT, name TEXT, type INTEGER, extra_metadata TEXT, is_container INTEGER NOT NULL, hash TEXT, size INTEGER, FOREIGN KEY(object_id) REFERENCES objects(id))" [] -- , CHECK ((is_container = 0 and (hash isnull) and (size isnull)) or (is_container != 0 and (not (hash isnull)) and (not (size isnull))))
  
  commit c
  
  return ()


-- | Returns the 'ObjectID' of a 'PersistedObject'.

objectID :: PersistedObject -> ObjectID
objectID (PO (i, _, _)) = i


-- | Returns the potential 'ObjectID' of the parent of a 'PersistedObject'.

parentID :: PersistedObject -> Maybe ObjectID
parentID (PO (_, p, _)) = p


-- | Returns the 'Object' of a 'PersistedObject'.

object :: PersistedObject -> Object
object (PO (_, _, o)) = o


-- | Creates a 'Container' 'Object'.

container :: Maybe Integer -> Maybe Element -> Object
container t m = Container $ ObjectAttributes { objectName = Nothing
                                             , objectType = t
                                             , objectExtraMetadata = m }


-- | Creates a 'Item' 'Object'.

item :: Maybe Integer -> Maybe Element -> Maybe String -> Maybe Integer -> Object
item t m h s = Item { itemObjectAttributes = ObjectAttributes { objectName = Nothing
                                                              , objectType = t
                                                              , objectExtraMetadata = m }
                    , itemAttributes = ItemAttributes { objectHash = h
                                                      , objectSize = s } }


-- | Persists an object (with or without a parent) in the database.

persist :: (IConnection c) => c -> Object -> Maybe ObjectID -> IO PersistedObject

persist c (Item { itemObjectAttributes = oa, itemAttributes = ia }) i =
  do let hash' = case objectHash ia of -- TODO: itemHash in record...
           Just x -> toSql x
           Nothing -> SqlNull
         size' = case objectSize ia of
           Just x -> toSql x
           Nothing -> SqlNull
     id <- randomUUID
     run c "INSERT INTO objects (id, parent_id, name, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', name', type', extra', toSql "0", hash', size']
     commit c
     run c "INSERT INTO objects_log (object_id, parent_id, name, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', name', type', extra', toSql "0", hash', size']
     commit c
     return $ PO (id, i, Item { itemObjectAttributes = oa, itemAttributes = ia } )
    where
      parent_id' :: SqlValue
      parent_id' = case i of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      name' :: SqlValue
      name' = case objectName oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      type' :: SqlValue
      type' = case objectType oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      extra' :: SqlValue
      extra' = case objectExtraMetadata oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull

persist c (Container oa) i =
  do id <- randomUUID
     run c "INSERT INTO objects (id, parent_id, name, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', name', type', extra', toSql "1", SqlNull, SqlNull]
     commit c
     run c "INSERT INTO objects_log (object_id, parent_id, name, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?, ?)" [toSql id, parent_id', name', type', extra', toSql "1", SqlNull, SqlNull]
     commit c
     return $ PO (id, i, Container oa)
    where -- TODO: Duplicate
      parent_id' :: SqlValue
      parent_id' = case i of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      name' :: SqlValue
      name' = case objectName oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      type' :: SqlValue
      type' = case objectType oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      extra' :: SqlValue
      extra' = case objectExtraMetadata oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull


-- | Update the properties and/or change the parent of a 'PersistedObject'.

update :: (IConnection c) => c -> ObjectID -> Maybe ObjectID -> Object -> IO PersistedObject
update c i p o = -- TODO: hash and size
  do run c ("UPDATE objects SET parent_id=" ++ parent_id'' ++ ", name=" ++ name'' ++ ", type=" ++ type'' ++ ", extra_metadata=" ++ extra'' ++ ", is_container='" ++ (container' o) ++ "' WHERE id='" ++ i ++ "'") [] -- TODO: Secure it
     commit c
     run c "INSERT INTO objects_log (object_id, parent_id, name, type, extra_metadata, is_container, hash, size) VALUES (?, ?, ?, ?, ?, ?, ?, ?)" [toSql i, parent_id', name', type', extra', toSql "1", SqlNull, SqlNull]
     commit c
     return $ PO (i, p, o)
    where -- TODO: Duplicate
      oa = objectAttributes o
      parent_id'' :: String
      parent_id'' = case p of
        Nothing -> "NULL"
        Just x -> "'" ++ x ++ "'"
      parent_id' :: SqlValue
      parent_id' = case p of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      name' :: SqlValue
      name' = case objectName oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      name'' :: String
      name'' = case objectName oa of
        Just x -> "'" ++ show x ++ "'"
        Nothing -> "NULL"
      type' :: SqlValue
      type' = case objectType oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      type'' :: String
      type'' = case objectType oa of
        Just x -> "'" ++ (show x) ++ "'"
        Nothing -> "NULL"
      extra' :: SqlValue
      extra' = case objectExtraMetadata oa of
        Just x -> toSql (show x)
        Nothing -> SqlNull
      extra'' :: String
      extra'' = case objectExtraMetadata oa of
        Just x -> "'" ++ (show x) ++ "'"
        Nothing -> "NULL"
      container' :: Object -> String
      container' (Container _) = "1"
      container' (Item _ _) = "0"


-- | Get the elements that are in the root (does not have a parent).

getRoot :: IConnection c => c -> IO [PersistedObject]
getRoot c =
  do result <- quickQuery' c "SELECT * FROM objects WHERE parent_id isnull" []
     return $ map resultToObject result


-- | Get the elements with the given parent.

getChildren :: IConnection c => c -> ObjectID -> IO [PersistedObject]
getChildren c o =
  do result <- quickQuery' c ("SELECT * FROM objects WHERE parent_id='" ++ o ++
               "'") []
     return $ map resultToObject result


-- | Get the object with the given 'ObjectID'.

getObject :: IConnection c => c -> ObjectID -> IO (Maybe PersistedObject)
getObject c o =
  do result <- quickQuery' c ("SELECT * FROM objects WHERE id = '" ++ o ++ "'")
               []
     case length result of
       0 -> return Nothing
       1 -> return $ Just (resultToObject $ head result)


-- Inserts two "empty" objects, one container and one item, in the database.

insertDummyData :: IConnection conn => conn -> IO ()

insertDummyData c =
  do let o0 = container Nothing Nothing
     let o1 = item Nothing Nothing Nothing Nothing
     
     p0 <- persist c o0 Nothing
     p1 <- persist c o1 Nothing
     
     return ()


-- Function to convert a query result to a PersistedObject.

-- resultToObject :: [SqlValue, SqlValue, SqlValue, SqlValue, SqlValue, SqlValue, SqlValue] -> PersistedObject

resultToObject [i, p, n, t, e, c, h, s]
  | isContainer = persistedObject (Container objectAttributes)
  | otherwise   = persistedObject (Item { itemObjectAttributes = objectAttributes, itemAttributes = ItemAttributes { objectHash = Nothing, objectSize = Nothing } }) -- TODO
    where
      id = let SqlByteString i' = i in DB.unpack i'
      isContainer = c == SqlString "1"
      objectAttributes = ObjectAttributes { objectName = Nothing
                                          , objectType = Nothing
                                          , objectExtraMetadata = Nothing}
      parent = case p of
        SqlNull -> Nothing
        SqlString s -> Just s
      persistedObject o = PO (id, parent, o)

randomUUID :: IO String
randomUUID = do
  f0 <- getID_ 8
  f1 <- getID_ 4
  f2 <- getID_ 4
  f3 <- getID_ 4
  f4 <- getID_ 12
  return $ f0 ++ "-" ++ f1 ++ "-" ++ f2 ++ "-" ++ f3 ++ "-" ++ f4