{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}

module SessionID (
	SessionID,
	mkSessionID,
	sessionLogFile,
	withSessionID,
	sessionIDUrl,
) where

import Serialization

import System.FilePath
import System.IO
import System.Directory
import Network.Wai.Handler.Warp (Port)
import Network.WebSockets hiding (Message)
import qualified Data.Aeson
import Data.Maybe
import Data.List
import Data.UUID
import Data.UUID.V4
import Control.Concurrent.STM
import Control.Exception

-- | A SessionID is the base name of the log file to use,
-- and may not contain any path information.
newtype SessionID = SessionID FilePath
	deriving (Show, Eq, Ord, Generic)

instance ToJSON SessionID
instance FromJSON SessionID

instance WebSocketsData SessionID where
	-- fromDataMessage = fromLazyByteString . fromDataMessage
	fromLazyByteString b =
		-- Down't trust a legal SessionID to be deserialized;
		-- use smart constructor to verify it's legal.
		let SessionID unverified = fromMaybe (error "bad SessionID serialization") (Data.Aeson.decode b)
		in fromMaybe (error "illegal SessionID") (mkSessionID unverified)
	toLazyByteString = Data.Aeson.encode

-- | Smart constructor that enforces legal SessionID contents.
--
-- The passed String can either be the bare SessionID, or it can be an URL
-- which ends with the SessionID.
mkSessionID :: String -> Maybe SessionID
mkSessionID s
	| "http" `isPrefixOf` s = Just $ SessionID $ takeFileName s
	| takeFileName s == s = Just $ SessionID s
	| otherwise = Nothing

sessionLogFile :: FilePath -> SessionID -> FilePath
sessionLogFile dir (SessionID f) = dir </> "debug-me." ++ f ++ ".log"

-- | Allocate a new SessionID open a Handle to its log file.
--
-- A UUID is used, to avoid ever generating a SessionID that has been used
-- before.
withSessionID :: FilePath -> ((TVar Handle, SessionID) -> IO a) -> IO a
withSessionID dir a = do
	createDirectoryIfMissing False dir
	sid <- SessionID . toString <$> nextRandom
	let f = sessionLogFile dir sid
	-- File should not already exist, but just in case we get
	-- spectacularly unlucky (or the RNG is broken..),
	-- avoid overwriting a log, and try again.
	exists <- doesFileExist f
	if exists
		then withSessionID dir a
		else bracket (setup f) cleanup (go sid)
  where
	setup f = do
		h <- openFile f WriteMode
		hv <- newTVarIO h
		return hv
	cleanup hv = hClose =<< atomically (readTVar hv)
	go sid hv = a (hv, sid)

type UrlString = String

sessionIDUrl :: SessionID -> String -> Port -> UrlString
sessionIDUrl (SessionID f) host port = "http://" ++ host ++ ":" ++ show port ++ "/" ++ f