{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, DeriveGeneric #-}
module Webdriver(serveWebdriver, WDSession(..)) where

import Happstack.Lite
import Happstack.Server.Types (unBody, takeRequestBody)
import Happstack.Server (askRq)
import Control.Concurrent.MVar
import Data.Aeson
import Data.Text (Text)
import GHC.Generics
import Data.ByteString.Lazy (ByteString)

import qualified Data.Map.Strict as M
import Data.UUID
import Data.UUID.V4

import Control.Monad.IO.Class (liftIO)
import Data.Maybe (fromMaybe)

data WDSession = WDSession -- TODO: Add fields

serveWebdriver :: MVar (M.Map UUID WDSession) -> ServerPart Response
serveWebdriver sessions = msum [
    dir "status" serveStatus,
    dir "session" $ postSession sessions
  ]

data Status = Status {ready :: Bool, message :: Text} deriving Generic
instance ToJSON Status
serveStatus = okJSON $ Status True "Always ready to open new sessions"

data NewSession = NewSession {sessionId :: UUID, capabilities :: Value} deriving Generic
instance ToJSON NewSession
postSession sessions = do
    method POST
    caps <- fromMaybe Null <$> getJSON
    -- FIXME: Validate provided capabilities.
    uuid <- liftIO nextRandom
    let session = WDSession
    liftIO $ modifyMVar_ sessions (return . M.insert uuid session)
    okJSON $ NewSession uuid caps

--------
---- Utils
--------
getBody :: ServerPart ByteString
getBody = do
    req  <- askRq 
    body <- liftIO $ takeRequestBody req 
    case body of 
        Just rqbody -> return . unBody $ rqbody 
        Nothing     -> return "" 

getJSON :: FromJSON x => ServerPart (Maybe x)
getJSON = decode <$> getBody

okJSON :: ToJSON x => x -> ServerPart Response
okJSON x = do
    setHeaderM "Content-Type" "application/json"
    ok $ toResponse $ encode x