{-# 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 -- | 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 and return an open Handle to its log file. -- -- A UUID is used, to avoid ever generating a SessionID that has been used -- before. withSessionID :: FilePath -> ((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 withFile f WriteMode $ \h -> a (h, sid) type UrlString = String sessionIDUrl :: SessionID -> String -> Port -> UrlString sessionIDUrl (SessionID f) host port = "http://" ++ host ++ ":" ++ show port ++ "/" ++ f