[WIP] State in OAuth2 callback should be short-livedstate

2 files changed, 32 insertions, 31 deletions

diff --git a/src/Sproxy/Application/Cookie.hs b/src/Sproxy/Application/Cookie.hs
index a86f42a..5bd15ef 100644
--- a/src/Sproxy/Application/Cookie.hs
+++ b/src/Sproxy/Application/Cookie.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Sproxy.Application.Cookie (
-  AuthCookie(..)
-, AuthUser
+  AuthUser
 , cookieDecode
 , cookieEncode
 , getEmail
@@ -16,7 +15,7 @@ module Sproxy.Application.Cookie (
 import Data.ByteString (ByteString)
 import Data.Text (Text, toLower, strip)
 import Data.Text.Encoding (decodeUtf8, encodeUtf8)
-import Foreign.C.Types (CTime(..))
+import Foreign.C.Types (CTime)
 import qualified Data.Serialize as DS
 
 import qualified Sproxy.Application.State as State
@@ -27,28 +26,20 @@ data AuthUser = AuthUser {
 , auFamilyName :: ByteString
 }
 
-data AuthCookie = AuthCookie {
-  acUser   :: AuthUser
-, acExpiry :: CTime
-}
-
-instance DS.Serialize AuthCookie where
-  put c = DS.put (auEmail u, auGivenName u, auFamilyName u, x)
-          where u = acUser c
-                x = (\(CTime i) -> i) $ acExpiry c
+instance DS.Serialize AuthUser where
+  put u = DS.put (auEmail u, auGivenName u, auFamilyName u)
   get = do
-    (e, n, f, x) <- DS.get
-    return AuthCookie {
-        acUser = AuthUser { auEmail = e, auGivenName = n, auFamilyName = f }
-      , acExpiry = CTime x
-      }
+    (e, n, f) <- DS.get
+    return AuthUser { auEmail = e, auGivenName = n, auFamilyName = f }
 
 
-cookieDecode :: ByteString -> ByteString -> Either String AuthCookie
-cookieDecode key d = State.decode key d >>= DS.decode
+cookieDecode :: ByteString -> ByteString -> IO (Either String AuthUser)
+cookieDecode key d = do
+  c <- State.decode key d
+  return $ c >>= DS.decode
 
-cookieEncode :: ByteString -> AuthCookie -> ByteString
-cookieEncode key = State.encode key . DS.encode
+cookieEncode :: ByteString -> Int -> AuthUser -> IO (ByteString, CTime)
+cookieEncode key shelflife = State.encode key (fromIntegral shelflife) . DS.encode
 
 
 getEmail :: AuthUser -> Text
diff --git a/src/Sproxy/Application/State.hs b/src/Sproxy/Application/State.hs
index 29d9252..8ddbedf 100644
--- a/src/Sproxy/Application/State.hs
+++ b/src/Sproxy/Application/State.hs
@@ -6,6 +6,8 @@ module Sproxy.Application.State (
 import Data.ByteString (ByteString)
 import Data.ByteString.Lazy (fromStrict, toStrict)
 import Data.Digest.Pure.SHA (hmacSha1, bytestringDigest)
+import Foreign.C.Types (CTime(..))
+import System.Posix.Time (epochTime)
 import qualified Data.ByteString.Base64 as Base64
 import qualified Data.Serialize as DS
 
@@ -13,16 +15,24 @@ import qualified Data.Serialize as DS
 -- FIXME: Compress / decompress ?
 
 
-encode :: ByteString -> ByteString -> ByteString
-encode key payload = Base64.encode . DS.encode $ (payload, digest key payload)
-
-
-decode :: ByteString -> ByteString -> Either String ByteString
-decode key d = do
-  (payload, dgst) <- DS.decode =<< Base64.decode d
-  if dgst /= digest key payload
-  then Left "junk"
-  else Right payload
+encode :: ByteString -> Int -> ByteString -> IO (ByteString, CTime)
+encode key shelflife payload = do
+  now <- epochTime
+  let expiry = now + (CTime . fromIntegral $ shelflife)
+      d = DS.encode (payload, (\(CTime i64) -> i64) expiry)
+  return (Base64.encode . DS.encode $ (d, digest key d), expiry)
+
+
+decode :: ByteString -> ByteString -> IO (Either String ByteString)
+decode key raw = do
+  (CTime now) <- epochTime
+  return $ do
+      (d, dgst) <- DS.decode =<< Base64.decode raw
+      if dgst /= digest key d then Left "junk"
+      else do
+        (payload, expiry) <- DS.decode d
+        if expiry < now then Left "expired"
+                        else Right payload
   
 
 digest :: ByteString -> ByteString -> ByteString