{-# OPTIONS -fglasgow-exts -fth #-}
import HAppS
import qualified Data.Map as Map
import Control.Monad.State (get, put)


instance StartState (Map.Map String String) where
    startStateM = return $ Map.fromList
        [ ("mike", "south")
        , ("dino", "morelli")
        , ("trevor","little")
        ]
 

instance Serialize (Map.Map String String) where
    encodeStringM = defaultEncodeStringM
    decodeStringM = defaultDecodeStringM
  

lookup_user () rq = do
    state <- get
    let result = case (Map.lookup user state) of
            Nothing            -> "no such user"
            Just real_password ->
                case (real_password == attempted_password) of
                        True  -> "success"
                        False -> "user exists, but wrong password"
    respond $ concat
        [ "lookup for <b>", user, "</b> resulted in <b>", result, "</b>" ]

    where 
        user = lookS 50 rq "user"
        attempted_password = lookS 50 rq "password"


add_user () rq = do
    state <- get
    put $ Map.insert user password state
    respond $ concat
        [ "<account>\n<user_name>", user
        , "</user_name>\n<pass>", password, "</pass>\n</account>\n"
        ]
    where 
        user = lookS 50 rq "user"
        password = lookS 50 rq "password"


list_users () () = do
    state <- get
    respond $ unlines $ map packIntoXml $ Map.toList state

    where
        packIntoXml (u, p) = concat
            [ "<account>\n<user_name>", u, "</user_name>\n<pass>"
            , p, "</pass>\n</account>\n"
            ]


main :: IO ()
main = stdHTTP
   [ debugFilter
   , h ["favicon.ico"] GET $ ok $ \() ()-> do respond ""
   , h ["lookup"] POST $ ok $ lookup_user
   , h ["add_user"] POST $ ok $ add_user
   , h ["users"] GET $ ok $ list_users
   ]