hpaste-0.3: PasteState.hs

-----------------------------------------------------------------------------
-- |
-- Module      : PasteState
-- Copyright   : (c) Eric Mertens 2007
-- License     : BSD3-style (see LICENSE)
-- 
-- Maintainer  : emertens@gmail.com
-- Stability   : unstable
-- Portability : portable
--
-----------------------------------------------------------------------------
--
-- The basic state of the paste server
--

module PasteState (
      currentId
    , PasteState
    , Entry
    , entryNick
    , entryTitle
    , entryContent
    , entryTime
    , getEntries
    , storeEntry
    , storeAnnotation
    , allEntries
    , newEntry

    , TimeStamp

    , gzip
    , gunzip
  ) where

import HAppS    (StartState(..), Serialize(..))

import qualified Data.Sequence as S
import qualified Data.Foldable as F
import Data.Int
import Data.List
import Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8  as L
import Control.Monad

import Data.Binary
import Codec.Compression.GZip

------------------------------------------------------------------------

newtype GZBytestring = GZ B.ByteString

-- | The PasteState, the state of our system
data PasteState = PasteState !(S.Seq [Entry])

-- | An individual paste
data Entry = MkEntry2
    { entryNick, entryTitle :: !String
    , entryContentGz        :: !GZBytestring -- a compressed in-memory bytestring
    , entryTime             :: !Int64 }

-- | Uncompress a content field on the fly
entryContent :: Entry -> B.ByteString
entryContent e = gunzip gz
    where GZ gz = entryContentGz e

--
-- Fast serialisation using Data.Binary
--
instance Binary PasteState where
    put (PasteState xs) = put xs
    get = liftM PasteState get

instance Binary Entry where
    put (MkEntry2 nk ti cn tm) = put nk >> put ti >> put cn >> put tm
    get = liftM4 MkEntry2 get get get get

-- | Write out a raw compressed bytestring
instance Binary GZBytestring where
    put (GZ b) = put b
    get        = liftM GZ get
-- migration:
--  get        = do b <- get ; return (GZ (gzip b))

------------------------------------------------------------------------

-- | Compress a strict ByteString
gzip   :: B.ByteString -> B.ByteString
gzip   = B.concat . L.toChunks . compress . L.fromChunks . (:[])

-- | Uncompress a strict ByteString
gunzip :: B.ByteString -> B.ByteString
gunzip = B.concat . L.toChunks . decompress . L.fromChunks . (:[])

------------------------------------------------------------------------

-- | Serialisation of the server state
instance StartState PasteState where
        startStateM = return $ PasteState $ S.empty

instance Serialize PasteState where
        typeString _  = "PasteState_0"

        -- Compress everything. Currently has to go via String :( 
        encodeFPS     a = return . L.toChunks . compress . encode $ a
        encodeStringM a = return . L.unpack . compress . encode $ a
        decodeStringM s = L.length ps `seq` return (decode (decompress ps), "")
            where ps = L.pack s

------------------------------------------------------------------------

-- | A convenient alias for time
type TimeStamp = Int64

------------------------------------------------------------------------

-- | Build a new entry. Shallow wrapper over the Entry constructor
-- Compreses the input bytestring using gzip.
newEntry :: String -> String -> ByteString -> TimeStamp -> Entry
newEntry nick title content t = MkEntry2 nick title (GZ contentgz) t
    where contentgz = gzip . B.filter (/='\r') $ content

-- | The current user id (this is a unique supply..)
currentId :: PasteState -> Int
currentId (PasteState s) = fromIntegral $ S.length s

allEntries :: PasteState -> [(Int, [Entry])]
allEntries (PasteState s) = Prelude.zip [n,n-1..] $ F.toList $ S.reverse s
  where n = S.length s - 1

getEntries :: Int -> PasteState -> [Entry]
getEntries n (PasteState s) = S.index s n

storeEntry :: Entry -> PasteState -> PasteState
storeEntry e (PasteState s) = PasteState $ (S.|>) s [e]

storeAnnotation :: Int -> Entry -> PasteState -> PasteState
storeAnnotation n e (PasteState s)
 = PasteState $ S.update n (S.index s n ++ [e]) s