module HPasteAdmin (adminSubsystem, loadAccounts, Accounts()) where

import Control.Exception
import Control.Monad.State
import qualified Data.Map as M
import Text.XHtml.Strict
import Prelude hiding (catch)

import PasteState

import HAppS

type RedirResult = PEv (Either Request (String,String))

newtype Accounts = Accounts (M.Map String String)

loadAccounts :: IO Accounts
loadAccounts = liftM Accounts $
  handle (const . return $ M.empty) $ do
  ls <- liftM lines $ readFile "accounts.txt"
  return $ M.fromList [(a,b) | [a,b] <- map words ls]
  
---------------------------------------------------------------------

adminSubsystem :: Monad m
               => Accounts
               -> ServerPart (Ev PasteState Request) Request m Result
adminSubsystem (Accounts accounts)
  =multi -- multiIf "/admin/?" ()
      [h "/admin/" () $ basicAuth "Admins Only" accounts
      ,h "/admin/delete" GET  $ ok       plain_xml handleGetDelete
      ,h "/admin/delete" POST $ seeOther plain_xml handlePostDelete
      ,h "/admin/?$"     ()   $ ok       plain_xml handleAdminIndex
      ,h ()              ()   $ notFound plain_xml $ val "404 not found"
      ]

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

handleAdminIndex :: () -> () -> Paste
handleAdminIndex = val $ showHtml $
  header << thetitle << "Admin Functions" +++
  body
  << (h1 << "Admin Functions" +++
      unordList [hotlink "/admin/delete" << "Delete an entry by ID"]
     )

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

handlePostDelete :: () -> Request -> RedirResult
handlePostDelete () rq = do
  pasteId <- lookMb readM rq "pasteId"
  boundId <- currentId
  if pasteId < boundId && pasteId > 0
    then do
      deleteEntry pasteId
      respond ("/admin/delete?result=Deleted%20paste%20" ++ show pasteId,"")
    else
      respond ("/admin/delete?result=Bad%20Paste%20ID","")

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

handleGetDelete :: () -> Request -> Paste
handleGetDelete () rq = 
  let result = lookS 200 rq "result"
  in respond $ showHtml $
  header << thetitle << "Deletion Form" +++
  body
  << (h1 << "Admin Section - Delete" +++
      p << hotlink "/admin/" << "Back to Admin Functions" +++
      p << result +++
      gui "/admin/delete"
      << (label ! [thefor "pasteId"]
          << ("Entry Id: " +++
              textfield "pasteId"
             ) +++
          submit "Delete" "Delete"
        )
     )

