module Rakka.Resource.Users
    ( resUsers
    )
    where

import           Control.Monad
import           Control.Monad.Trans
import           Data.Maybe
import           Network.HTTP.Lucu
import           Network.URI hiding (path)
import           Rakka.Authorization
import           Rakka.Environment
import           Rakka.Resource
import           Rakka.SystemConfig
import           System.FilePath
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]
  <rdf:RDF>
    <rdf:Description rdf:about="http://.../users">
      <users>
        <rdf:Bag>
          <rdf:li rdf:resource="http://.../users/foo" />
	  <rdf:li rdf:resource="http://.../users/bar" />
    	  ...
	</rdf:Bag>
      </users>
    </rdf:Description>
  </rdf:RDF>

  [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 BaseURI baseURI <- getSysConf (envSysConf env)
	     users           <- liftIO $ getUserList $ envAuthDB env
	     runIdempotentA' $ proc ()
		 -> do tree <- ( eelem "/"
				 += ( eelem "rdf:RDF"
				      += sattr "xmlns"     "http://cielonegro.org/terms/"
				      += sattr "xmlns:rdf" "http://www.w3.org/1999/02/22-rdf-syntax-ns#"
				      += ( eelem "rdf:Description"
					   += sattr "rdf:about" (uriToString id (mkUserURI baseURI Nothing) "")
					   += ( eelem "users"
						+= ( eelem "rdf:Bag"
						     += ( constL users
							  >>>
							  ( eelem "rdf:li"
							    += attr "rdf:resource" ( arr ( \ name ->
											   uriToString
											   id
											   (mkUserURI baseURI $ Just name)
											   ""
											 )
										     >>>
										     mkText
										   )
							  )
							)
						   )
					      )
					 )
				    )
			       ) -< ()
		       returnA -< outputXml tree

    mkUserURI :: URI -> Maybe String -> URI
    mkUserURI baseURI Nothing  = baseURI { uriPath = uriPath baseURI </> "users" }
    mkUserURI baseURI (Just x) = baseURI { uriPath = uriPath baseURI </> "users" </> x }

    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