working toward getting developer mode connection to server working

1 files changed, 39 insertions, 7 deletions

diff --git a/SessionID.hs b/SessionID.hs
index a47de8f..71f2150 100644
--- a/SessionID.hs
+++ b/SessionID.hs
@@ -1,21 +1,48 @@
-module SessionID (SessionID, mkSessionID, sessionLogFile, withSessionID) where
+{-# 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)
+	deriving (Show, Eq, Ord, Generic)
+
+instance ToJSON SessionID
+instance FromJSON SessionID
 
--- | Smart constructor that enforces security requirements.
+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 f = unpack t
-	in if takeFileName f == f
-		then Just (SessionID f)
-		else Nothing
+	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"
@@ -26,3 +53,8 @@ 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