Skip to content

Commit 6d51082

Browse files
stepcutstepcut
committed
remove use of JWT in the client side code. The client should never be able to access the token via javascript
1 parent 6bd99d6 commit 6d51082

8 files changed

Lines changed: 169 additions & 1263 deletions

File tree

‎happstack-authenticate-client/HappstackAuthenticateClient.hs‎

Lines changed: 0 additions & 983 deletions
Large diffs are not rendered by default.

‎happstack-authenticate.cabal‎

Lines changed: 6 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
Cabal-version: 2.2
22
Name: happstack-authenticate
3-
Version: 3.0.0
3+
Version: 3.1.0
44
Synopsis: Happstack Authentication Library
5-
Description: A themeable authentication library with support for username+password and OpenId.
5+
Description: A themeable authentication library with support for username+password
66
Homepage: http://www.happstack.com/
77
License: BSD-3-Clause
88
License-file: LICENSE
@@ -34,10 +34,9 @@ common shared-properties
3434
common shared-ghcjs-properties
3535
default-language: Haskell2010
3636
if impl(ghcjs)
37-
build-depends: base,
38-
base64-bytestring >= 1.0 && < 1.3,
39-
chili >= 0.4.2,
40-
jwt >= 0.3 && < 0.12
37+
build-depends: base
38+
, base64-bytestring >= 1.0 && < 1.3
39+
, chili >= 0.4.2
4140
, aeson
4241
, bytestring
4342
, containers
@@ -95,7 +94,6 @@ Library
9594
boomerang >= 1.4 && < 1.5,
9695
containers >= 0.4 && < 0.7,
9796
ixset-typed >= 0.3 && < 0.6,
98-
jwt >= 0.3 && < 0.12,
9997
lens >= 4.2 && < 5.2,
10098
mtl >= 2.0 && < 2.3,
10199
pwstore-purehaskell == 2.1.*,
@@ -116,6 +114,7 @@ Library
116114
filepath >= 1.3 && < 1.5,
117115
hsx2hs >= 0.13 && < 0.15,
118116
jmacro >= 0.6.11 && < 0.7,
117+
jwt >= 0.3 && < 0.12,
119118
happstack-jmacro >= 7.0 && < 7.1,
120119
happstack-server >= 6.0 && < 7.9,
121120
happstack-hsp >= 7.3 && < 7.4,

‎src/Happstack/Authenticate/Client.hs‎

Lines changed: 65 additions & 145 deletions
Large diffs are not rendered by default.

‎src/Happstack/Authenticate/Core.hs‎

Lines changed: 29 additions & 64 deletions
Original file line numberDiff line numberDiff line change
@@ -130,62 +130,30 @@ import Control.Category ((.), id)
130130
import Control.Exception (SomeException)
131131
import qualified Control.Exception as E
132132
import Control.Lens ((?=), (.=), (^.), (.~), makeLenses, view, set)
133-
-- import Control.Lens.At (IxValue(..), Ixed(..), Index(..), At(at))
134-
-- import Control.Monad.Trans (MonadIO(liftIO))
135-
-- import Control.Monad.Reader (ask)
136-
-- import Control.Monad.State (get, put, modify)
137133
import Data.Aeson (FromJSON(..), ToJSON(..), Result(..), fromJSON)
138134
import qualified Data.Aeson as A
139135
import Data.Aeson.Types (Options(fieldLabelModifier), defaultOptions, genericToJSON, genericParseJSON)
140-
-- import Data.Acid (AcidState, Update, Query, makeAcidic)
141-
-- import Data.Acid.Advanced (update', query')
142-
-- import Data.ByteString.Base64 (encode)
143-
-- import qualified Data.ByteString.Char8 as B
144136
import Data.Data (Data, Typeable)
145-
-- import Data.Default (def)
146137
import Data.Map (Map)
147138
import qualified Data.Map as Map
148139
import Data.Maybe (fromMaybe, maybeToList)
149140
import Data.Monoid ((<>), mconcat, mempty)
150141
import Data.SafeCopy (SafeCopy, Migrate(..), base, deriveSafeCopy, extension)
151142
import Data.IxSet.Typed
152143
import qualified Data.IxSet.Typed as IxSet
153-
-- import Data.Set (Set)
154-
-- import qualified Data.Set as Set
155144
import Data.Text (Text)
156145
import qualified Data.Text as Text
157146
import qualified Data.Text.Encoding as Text
158-
-- import Data.Time (UTCTime, addUTCTime, diffUTCTime, getCurrentTime)
159-
-- import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
160147
import Data.UserId (UserId(..), rUserId, succUserId, unUserId)
161148
import GHC.Generics (Generic)
162-
-- import Happstack.Server (Cookie(secure), CookieLife(Session, MaxAge), Happstack, ServerPartT, Request(rqSecure), Response, addCookie, askRq, expireCookie, getHeaderM, lookCookie, lookCookieValue, mkCookie, notFound, toResponseBS)
163-
-- import Happstack.Server.Internal.Clock (getApproximateUTCTime)
164-
-- import Language.Javascript.JMacro
165149
import Prelude hiding ((.), id, exp)
166150
import System.IO (IOMode(ReadMode), withFile)
167-
-- import System.Random (randomRIO)
168151
import Text.Boomerang.TH (makeBoomerangs)
169152
import Text.Shakespeare.I18N (RenderMessage(renderMessage), mkMessageFor)
170-
import Web.JWT (Algorithm(HS256), JWT, VerifiedJWT, JWTClaimsSet(..), encodeSigned, claims, decode, decodeAndVerifySignature, secondsSinceEpoch, intDate, verify)
171-
import qualified Web.JWT as JWT
172-
#if MIN_VERSION_jwt(0,8,0)
173-
import Web.JWT (ClaimsMap(..), hmacSecret)
174-
#else
175-
import Web.JWT (secret)
176-
#endif
177-
178153
import Web.Routes (RouteT, PathInfo(..), nestURL)
179154
import Web.Routes.Boomerang
180-
-- import Web.Routes.Happstack ()
181155
import Web.Routes.TH (derivePathInfo)
182156

183-
#if MIN_VERSION_jwt(0,8,0)
184-
#else
185-
unClaimsMap = id
186-
#endif
187-
188-
189157
-- | when creating JSON field names, drop the first character. Since
190158
-- we are using lens, the leading character should always be _.
191159
jsonOptions :: Options
@@ -214,38 +182,14 @@ data CoreError
214182
deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
215183
instance ToJSON CoreError where toJSON = genericToJSON jsonOptions
216184
instance FromJSON CoreError where parseJSON = genericParseJSON jsonOptions
217-
{-
218-
instance ToJExpr CoreError where
219-
toJExpr = toJExpr . toJSON
220-
-}
185+
221186
deriveSafeCopy 0 'base ''CoreError
222187

223188
mkMessageFor "HappstackAuthenticateI18N" "CoreError" "messages/core" ("en")
224189

225190
------------------------------------------------------------------------------
226191

227-
------------------------------------------------------------------------------
228-
-- UserId
229-
------------------------------------------------------------------------------
230-
{-
231-
-- | a 'UserId' uniquely identifies a user.
232-
newtype UserId = UserId { _unUserId :: Integer }
233-
deriving (Eq, Ord, Enum, Read, Show, Data, Typeable, Generic)
234-
deriveSafeCopy 1 'base ''UserId
235-
makeLenses ''UserId
236-
makeBoomerangs ''UserId
237-
238-
instance ToJSON UserId where toJSON (UserId i) = toJSON i
239-
instance FromJSON UserId where parseJSON v = UserId <$> parseJSON v
240-
241-
instance PathInfo UserId where
242-
toPathSegments (UserId i) = toPathSegments i
243-
fromPathSegments = UserId <$> fromPathSegments
244-
245-
-- | get the next `UserId`
246-
succUserId :: UserId -> UserId
247-
succUserId (UserId i) = UserId (succ i)
248-
-}
192+
249193
------------------------------------------------------------------------------
250194
-- Username
251195
------------------------------------------------------------------------------
@@ -346,7 +290,8 @@ data AuthenticateURL
346290
AuthenticationMethods (Maybe (AuthenticationMethod, [Text]))
347291
| HappstackAuthenticateClient
348292
| Logout
349-
-- | AmAuthenticated
293+
| AmAuthenticated
294+
| InitClient
350295
deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
351296

352297
makeBoomerangs ''AuthenticateURL
@@ -358,7 +303,8 @@ authenticateURL =
358303
"authentication-methods" </> ( rAuthenticationMethods . rMaybe authenticationMethod)
359304
<> "happstack-authenticate-client" . rHappstackAuthenticateClient
360305
<> "logout" . rLogout
361-
-- <> "am-authenticated" . rAmAuthenticated
306+
<> "am-authenticated" . rAmAuthenticated
307+
<> "init-client" . rInitClient
362308
)
363309
where
364310
userId = rUserId . integer
@@ -377,20 +323,39 @@ nestAuthenticationMethod :: (PathInfo methodURL) =>
377323
nestAuthenticationMethod authenticationMethod =
378324
nestURL $ \methodURL -> AuthenticationMethods $ Just (authenticationMethod, toPathSegments methodURL)
379325

326+
------------------------------------------------------------------------------
327+
-- ClientInitData
328+
------------------------------------------------------------------------------
329+
330+
-- | The `Token` type represents the data used to identify a user. The
331+
-- name used to make more sense and it should probably be renamed.
332+
data ClientInitData = ClientInitData
333+
{ _cidUser :: Maybe User
334+
, _cidPostLoginRedirectURL :: Maybe Text
335+
, _cidPostSignupRedirectURL :: Maybe Text
336+
}
337+
deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
338+
makeLenses ''ClientInitData
339+
instance ToJSON ClientInitData where toJSON = genericToJSON jsonOptions
340+
instance FromJSON ClientInitData where parseJSON = genericParseJSON jsonOptions
341+
342+
------------------------------------------------------------------------------
343+
-- Token
344+
------------------------------------------------------------------------------
380345

381-
-- | The `Token` type represents the encrypted data used to identify a
382-
-- user.
346+
-- | The `Token` type represents the data used to identify a user. The
347+
-- name used to make more sense and it should probably be renamed.
383348
data Token = Token
384349
{ _tokenUser :: User
385-
, _tokenIsAuthAdmin :: Bool
386350
}
387351
deriving (Eq, Ord, Read, Show, Data, Typeable, Generic)
388352
makeLenses ''Token
389353
instance ToJSON Token where toJSON = genericToJSON jsonOptions
390354
instance FromJSON Token where parseJSON = genericParseJSON jsonOptions
391355

356+
392357
------------------------------------------------------------------------------
393-
-- Token / TokenText
358+
-- TokenText
394359
------------------------------------------------------------------------------
395360

396361
-- | `TokenText` is the encrypted form of the `Token` which is passed

‎src/Happstack/Authenticate/Handlers.hs‎

Lines changed: 51 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -12,12 +12,16 @@ import Control.Monad.Reader (ask)
1212
import Control.Monad.State (get, put, modify)
1313
import Data.Acid (AcidState, Update, Query, makeAcidic)
1414
import Data.Acid.Advanced (update', query')
15-
import Data.Aeson (FromJSON(..), ToJSON(..), Result(..), fromJSON)
15+
import Data.Aeson (FromJSON(..), Object(..), ToJSON(..), Result(..), Value(..), fromJSON)
1616
import qualified Data.Aeson as A
1717
import Data.Aeson.Types (Options(fieldLabelModifier), defaultOptions, genericToJSON, genericParseJSON)
18+
#if MIN_VERSION_aeson(2,0,0)
19+
import qualified Data.Aeson.KeyMap as KM
20+
#endif
1821
import Data.ByteString.Base64 (encode)
1922
import qualified Data.ByteString.Char8 as B
2023
import Data.Data (Data, Typeable)
24+
import qualified Data.HashMap.Strict as HashMap
2125
import Data.Map (Map)
2226
import qualified Data.Map as Map
2327
import Data.SafeCopy (SafeCopy, Migrate(..), base, deriveSafeCopy, extension)
@@ -32,7 +36,7 @@ import Data.Time (UTCTime, addUTCTime, diffUTCTime, getCur
3236
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds, posixSecondsToUTCTime)
3337
import Data.UserId (UserId(..), rUserId, succUserId, unUserId)
3438
import Happstack.Authenticate.Core
35-
import Happstack.Server (Cookie(httpOnly, sameSite, secure), CookieLife(Session, MaxAge), Happstack, SameSite(SameSiteStrict), ServerPartT, Request(rqSecure), Response, addCookie, askRq, expireCookie, getHeaderM, lookCookie, lookCookieValue, mkCookie, notFound, toResponseBS)
39+
import Happstack.Server (Cookie(httpOnly, sameSite, secure), CookieLife(Session, MaxAge), Happstack, Method(GET, HEAD), SameSite(SameSiteStrict), ServerPartT, Request(rqSecure), Response, addCookie, askRq, expireCookie, getHeaderM, lookCookie, lookCookieValue, method, mkCookie, notFound, resp, toResponseBS)
3640
import GHC.Generics (Generic)
3741
import Prelude hiding ((.), id, exp)
3842
import System.IO (IOMode(ReadMode), withFile)
@@ -348,12 +352,11 @@ getOrGenSharedSecret authenticateState uid =
348352
-- Token Functions
349353
------------------------------------------------------------------------------
350354

351-
-- | create a `Token` for `User`
355+
-- | create a `TokenText` for `User`
352356
--
353-
-- The @isAuthAdmin@ paramater is a function which will be called to
354-
-- determine if `UserId` is a user who should be given Administrator
355-
-- privileges. This includes the ability to things such as set the
356-
-- `OpenId` realm, change the registeration mode, etc.
357+
-- NOTE: the `TokenText` is all that is needed to impersonate a
358+
-- user. It should not be stored in `LocalStorage` or other places
359+
-- which are accessibly by 3rd party javascript
357360
issueToken :: (MonadIO m) =>
358361
AcidState AuthenticateState
359362
-> AuthenticateConfig
@@ -376,9 +379,6 @@ issueToken authenticateState authenticateConfig user =
376379
ClaimsMap $
377380
#endif
378381
Map.fromList [ ("user" , toJSON user)
379-
, ("authAdmin" , toJSON admin)
380-
, ("postLoginRedirectURL" , toJSON (_postLoginRedirect authenticateConfig))
381-
, ("postSignupRedirectURL", toJSON (_postSignupRedirect authenticateConfig))
382382
]
383383
}
384384
#if MIN_VERSION_jwt(0,10,0)
@@ -431,12 +431,7 @@ decodeAndVerifyToken authenticateState now token =
431431
(Just exp') ->
432432
if (utcTimeToPOSIXSeconds now) > (secondsSinceEpoch exp')
433433
then return Nothing
434-
else case Map.lookup "authAdmin" (unClaimsMap (unregisteredClaims (claims verified))) of
435-
Nothing -> return (Just (Token u False, verified))
436-
(Just a) ->
437-
case fromJSON a of
438-
(Error _) -> return (Just (Token u False, verified))
439-
(Success b) -> return (Just (Token u b, verified))
434+
else return (Just (Token u, verified))
440435

441436
------------------------------------------------------------------------------
442437
-- Token in a Cookie
@@ -453,13 +448,12 @@ addTokenCookie :: (Happstack m) =>
453448
AcidState AuthenticateState
454449
-> AuthenticateConfig
455450
-> User
456-
-> m TokenText
451+
-> m ()
457452
addTokenCookie authenticateState authenticateConfig user =
458453
do token <- issueToken authenticateState authenticateConfig user
459454
s <- rqSecure <$> askRq -- FIXME: this isn't that accurate in the face of proxies
460455
addCookie (MaxAge (60*60*24*30)) ((mkCookie authCookieName (Text.unpack token)) { sameSite = SameSiteStrict, secure = s, httpOnly = True })
461-
-- addCookie (MaxAge 60) ((mkCookie authCookieName (Text.unpack token)) { secure = s })
462-
return token
456+
return ()
463457

464458
-- | delete the `Token` `Cookie`
465459
deleteTokenCookie :: (Happstack m) =>
@@ -559,3 +553,41 @@ toJSONError e = toResponseBS "application/json" (A.encode (JSONResponse NotOk (A
559553
type AuthenticationHandler = [Text] -> RouteT AuthenticateURL (ServerPartT IO) Response
560554

561555
type AuthenticationHandlers = Map AuthenticationMethod AuthenticationHandler
556+
557+
558+
------------------------------------------------------------------------------
559+
-- amAuthenticated
560+
------------------------------------------------------------------------------
561+
562+
amAuthenticated :: (Happstack m) =>
563+
AcidState AuthenticateState
564+
-> m Response
565+
amAuthenticated authenticateState =
566+
do method [GET, HEAD]
567+
mt <- getTokenCookie authenticateState
568+
case mt of
569+
Nothing -> resp 401 $ toJSONError AuthorizationRequired
570+
(Just (token, jwt)) ->
571+
#if MIN_VERSION_aeson(2,0,0)
572+
resp 200 $ toJSONSuccess (Object $ KM.fromList [("token", toJSON token)])
573+
#else
574+
resp 200 $ toJSONSuccess (Object $ HashMap.fromList [("token", toJSON token)])
575+
#endif
576+
577+
578+
clientInit :: (Happstack m) =>
579+
AuthenticateConfig
580+
-> AcidState AuthenticateState
581+
-> m Response
582+
clientInit authenticateConfig authenticateState =
583+
do method [GET, HEAD]
584+
mt <- getTokenCookie authenticateState
585+
let mUser =
586+
case mt of
587+
Nothing -> Nothing
588+
Just ((Token user), _) -> Just user
589+
cid = ClientInitData { _cidUser = mUser
590+
, _cidPostLoginRedirectURL = _postLoginRedirect authenticateConfig
591+
, _cidPostSignupRedirectURL = _postSignupRedirect authenticateConfig
592+
}
593+
resp 200 $ toJSONSuccess (toJSON cid)

‎src/Happstack/Authenticate/Password/Core.hs‎

Lines changed: 2 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -43,20 +43,11 @@ import Happstack.Authenticate.Password.URL (AccountURL(..))
4343
-- import System.FilePath (combine)
4444
-- import qualified Text.Email.Validate as Email
4545
import Text.Shakespeare.I18N (RenderMessage(..), Lang, mkMessageFor)
46-
import qualified Web.JWT as JWT
47-
import Web.JWT (Algorithm(HS256), JWT, VerifiedJWT, JWTClaimsSet(..), encodeSigned, claims, decode, decodeAndVerifySignature, intDate, secondsSinceEpoch, verify)
48-
#if MIN_VERSION_jwt(0,8,0)
49-
import Web.JWT (ClaimsMap(..), hmacSecret)
50-
#else
51-
import Web.JWT (secret)
52-
#endif
46+
47+
5348
import Web.Routes
5449
import Web.Routes.TH
5550

56-
#if MIN_VERSION_jwt(0,8,0)
57-
#else
58-
unClaimsMap = id
59-
#endif
6051

6152
------------------------------------------------------------------------------
6253
-- PasswordError

0 commit comments

Comments
 (0)