summaryrefslogtreecommitdiffhomepage
path: root/SessionID.hs
blob: 71f2150be9a2a61dd8d64014f8c5e7b3b45debed (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
{-# LANGUAGE OverloadedStrings, DeriveGeneric #-}

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

import Serialization

import System.FilePath
import Data.Text
import System.IO
import Network.Wai.Handler.Warp (Port)
import Network.WebSockets hiding (Message)
import qualified Data.Aeson
import Data.Maybe

-- | 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 = fromMaybe (error "bad SessionID") . Data.Aeson.decode
	toLazyByteString = Data.Aeson.encode

-- | Smart constructor that enforces legal SessionID contents.
--
-- The passed Text can either be the bare SessionID, or it can be an URL
-- which ends with the SessionID.
mkSessionID :: Text -> Maybe SessionID
mkSessionID t = 
	let s = unpack t
	in if "http" `isPrefixOf` t
		then Just $ SessionID $ takeFileName s
		else if takeFileName s == s
			then Just $ SessionID s
			else 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.
withSessionID :: FilePath -> ((Handle, SessionID) -> IO a) -> IO a
withSessionID dir a = do
	-- TODO find an unused log file and open it
	let sid = SessionID "1"
	withFile "debug-me-server.log" WriteMode $ \h -> a (h, sid)

type UrlString = String

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