564a053 · typeable/servant-reflex

git.iko.soy/typeable/servant-reflex

on master help sign in

Support servant-auth using JWT in cookies

564a0533noch9 years ago

servant-reflex.cabal+1

compare with master

unifiedsplit

@@ -42,6 +42,7 @@ library

42 reflex-dom == 0.4 && < 0.5,

43 safe >= 0.3.9 && < 0.4,

44 servant >= 0.8 && < 0.11,

45+ servant-auth >= 0.2.7 && < 0.2.8,

45 string-conversions >= 0.4 && < 0.5,

46 string-conversions >= 0.4 && < 0.5,

46 text >= 1.2 && < 1.3,

47 text >= 1.2 && < 1.3,

47 transformers >= 0.4 && < 0.6

48 transformers >= 0.4 && < 0.6

src/Servant/Reflex.hs+48−21

@@ -1,24 +1,22 @@

1−{-# LANGUAGE AllowAmbiguousTypes #-}

1+{-# LANGUAGE AllowAmbiguousTypes #-}

2−{-# LANGUAGE CPP #-}

2+{-# LANGUAGE CPP #-}

3−{-# LANGUAGE DataKinds #-}

3+{-# LANGUAGE DataKinds #-}

4−{-# LANGUAGE FlexibleContexts #-}

4+{-# LANGUAGE FlexibleContexts #-}

5−{-# LANGUAGE FlexibleInstances #-}

5+{-# LANGUAGE FlexibleInstances #-}

6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6−{-# LANGUAGE InstanceSigs #-}

7+{-# LANGUAGE InstanceSigs #-}

7−{-# LANGUAGE OverloadedStrings #-}

8−{-# LANGUAGE PolyKinds #-}

9−{-# LANGUAGE ScopedTypeVariables #-}

10−{-# LANGUAGE TupleSections #-}

11−{-# LANGUAGE TypeFamilies #-}

12−{-# LANGUAGE TypeOperators #-}

13−{-# LANGUAGE UndecidableInstances #-}

14−{-# LANGUAGE MultiParamTypeClasses #-}

8+{-# LANGUAGE MultiParamTypeClasses #-}

15−{-# LANGUAGE OverloadedStrings #-}

9+{-# LANGUAGE OverloadedStrings #-}

16−{-# LANGUAGE PolyKinds #-}

10+{-# LANGUAGE PolyKinds #-}

17−{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE ScopedTypeVariables #-}

18−{-# LANGUAGE TupleSections #-}

12+{-# LANGUAGE TupleSections #-}

19−{-# LANGUAGE TypeFamilies #-}

13+{-# LANGUAGE TypeFamilies #-}

20−{-# LANGUAGE TypeOperators #-}

14+{-# LANGUAGE TypeOperators #-}

21−{-# LANGUAGE UndecidableInstances #-}

15+{-# LANGUAGE UndecidableInstances #-}

16+

17+#if MIN_VERSION_base(4,9,0)

18+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

19+#endif

23-- #include "overlapping-compat.h"

21-- #include "overlapping-compat.h"

24-- | This module provides 'client' which can automatically generate

22-- | This module provides 'client' which can automatically generate

@@ -44,6 +42,7 @@ import Data.Proxy (Proxy (..))

44import qualified Data.Map as Map

42import qualified Data.Map as Map

45import Data.Text (Text)

43import Data.Text (Text)

46import qualified Data.Text as T

44import qualified Data.Text as T

45+import GHC.Exts (Constraint)

47import GHC.TypeLits (KnownSymbol, symbolVal)

46import GHC.TypeLits (KnownSymbol, symbolVal)

48import Servant.API ((:<|>)(..),(:>), BasicAuth,

47import Servant.API ((:<|>)(..),(:>), BasicAuth,

49 BasicAuthData, BuildHeadersTo(..),

48 BasicAuthData, BuildHeadersTo(..),

@@ -54,6 +53,7 @@ import Servant.API ((:<|>)(..),(:>), BasicAuth,

54 QueryParams, Raw, ReflectMethod(..),

53 QueryParams, Raw, ReflectMethod(..),

55 RemoteHost, ReqBody,

54 RemoteHost, ReqBody,

56 ToHttpApiData(..), Vault, Verb)

55 ToHttpApiData(..), Vault, Verb)

56+import qualified Servant.Auth as Auth

58import Reflex.Dom (Dynamic, Event, Reflex,

59 XhrRequest(..),

@@ -524,3 +524,30 @@ non-empty lists, but is otherwise more specific, no instance will be overall

524more specific. This in turn generally means adding yet another instance (one

525for empty and one for non-empty lists).

526-}

527+

528+

529+-- SUPPORT FOR servant-auth --

530+

531+-- For JavaScript clients we should be sending/storing JSON web tokens in a

532+-- way that is inaccessible to JavaScript.

533+--

534+-- For @servant-auth@ this is done with HTTP-only cookies. In a Reflex-DOM

535+-- app this means the @servant-auth@ client should only verify that the API

536+-- supports Cookie-based authentication but do nothing with the token

537+-- directly.

538+

539+-- @HasCookieAuth auths@ is nominally a redundant constraint, but ensures

540+-- we're not trying to rely on cookies when the API does not use them.

541+instance (HasCookieAuth auths, HasClient t m api tag) => HasClient t m (Auth.Auth auths a :> api) tag where

542+

543+ type Client t m (Auth.Auth auths a :> api) tag = Client t m api tag

544+ clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy api)

545+

546+

547+type family HasCookieAuth xs :: Constraint where

548+ HasCookieAuth (Auth.Cookie ': xs) = ()

549+ HasCookieAuth (x ': xs) = HasCookieAuth xs

550+ HasCookieAuth '[] = CookieAuthNotEnabled

551+

552+class CookieAuthNotEnabled

553+