aboutsummaryrefslogtreecommitdiff
path: root/src/Sproxy/Application
diff options
context:
space:
mode:
authorIgor Pashev <pashev.igor@gmail.com>2017-07-26 21:09:57 +0300
committerIgor Pashev <pashev.igor@gmail.com>2017-07-26 21:09:57 +0300
commitbb31be8f6072e4dd72c8630c019f7ab5e0bc9fa9 (patch)
treed7b4194f8b6b5e7af76cf59b4130a08153ae44da /src/Sproxy/Application
parent1123c543bdd438ad40428e7814325a53c819cee2 (diff)
downloadsproxy2-bb31be8f6072e4dd72c8630c019f7ab5e0bc9fa9.tar.gz
[WIP] State in OAuth2 callback should be short-livedstate
Diffstat (limited to 'src/Sproxy/Application')
-rw-r--r--src/Sproxy/Application/Cookie.hs33
-rw-r--r--src/Sproxy/Application/State.hs30
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