module Rakka.Resource.Users
    ( resUsers
    )
    where

import           Control.Monad
import           Control.Monad.Trans
import           Data.Maybe
import           Network.HTTP.Lucu
import           Rakka.Authorization
import           Rakka.Environment
import           Rakka.Resource
import           Text.XML.HXT.Arrow hiding (when)


resUsers :: Environment -> ResourceDef
resUsers env
    = ResourceDef {
		   resUsesNativeThread = False
		  , resIsGreedy        = True
		  , resGet             = Just $ handleGet env
		  , resHead            = Nothing
		  , resPost            = Nothing
		  , resPut             = Just $ handlePut env
		  , resDelete          = Just $ handleDelete env
		  }


{-
  [GET /users]
  <users>
    <user id="foo" />
    <user id="bar" />
    ...
  </users>

  [GET /users/foo]
  204 No Content

  [GET /users/nonexistent]
  404 Not Found
-}
handleGet :: Environment -> Resource ()
handleGet env
    = do userID <- getUserID env
	 when (isNothing userID)
		  $ abort Forbidden [] Nothing

	 path <- getPathInfo
	 case path of
		   []     -> returnUserList
		   [name] -> returnUser name
		   _      -> foundNoEntity Nothing
    where
    returnUserList :: Resource ()
    returnUserList
	= do users <- liftIO $ getUserList $ envAuthDB env
	     runIdempotentA' $ proc ()
		 -> do tree <- ( eelem "/"
				 += ( eelem "users"
				      += ( constL users
					   >>>
					   ( eelem "user"
					     += attr "id" mkText
					   )
					 )
				    )
			       ) -< ()
		       returnA -< outputXml tree

    returnUser :: String -> Resource ()
    returnUser name
	= do users <- liftIO $ getUserList $ envAuthDB env
	     if any (== name) users
		then setStatus NoContent
		else foundNoEntity Nothing


{-
  > PUT /users/foo HTTP/1.1
  > Content-Type: text/plain
  >
  > password

  < HTTP/1.1 201 Created
-}
handlePut :: Environment -> Resource ()
handlePut env
    = do userID <- getUserID env
	 when (isNothing userID)
		  $ abort Forbidden [] Nothing

	 path <- getPathInfo
	 case path of
		   [name] -> do mimeType <- getContentType
				case mimeType of
					      Nothing
						  -> abort BadRequest [] (Just "Missing Content-Type")
					      Just (MIMEType "text" "plain" _)
						  -> do pass <- input defaultLimit
							addUser (envAuthDB env) name pass
					      Just t
						  -> abort UnsupportedMediaType [] (Just $ "Unsupported media type: " ++ show t)
				setStatus Created
		   _      -> abort BadRequest [] (Just "Invalid URI")


handleDelete :: Environment -> Resource ()
handleDelete env
    = do userID <- getUserID env
	 when (isNothing userID)
		  $ abort Forbidden [] Nothing

	 path <- getPathInfo
	 case path of
		   [name] -> delUser (envAuthDB env) name
		   _      -> abort BadRequest [] (Just "Invalid URI")
	 setStatus NoContent