Cleans and adds haddock comments

src/PostgREST/Auth.hs

@@ -1,3 +1,15 @@
+{-|
+Module      : PostgREST.Auth
+Description : PostgREST authorization functions.
+
+This module provides functions to deal with the JWT authorization (http://jwt.io).
+It also can be used to define other authorization functions,
+in the future Oauth, LDAP and similar integrations can be coded here.
+
+Authentication should always be implemented in an external service.
+In the test suite there is an example of simple login function that can be used for a
+very simple authentication system inside the PostgreSQL database.
+-}
 {-# LANGUAGE FlexibleContexts #-}
 module PostgREST.Auth (
   setRole
@@ -5,40 +17,45 @@ module PostgREST.Auth (
   , tokenJWT
   ) where
 
-import           Control.Applicative
-import           Data.Aeson
-import           Data.Aeson.Types (emptyObject, emptyArray)
-import           Data.Vector as V (null, head)
-import           Data.Map as M (fromList, toList)
-import           Data.Monoid
+import           Data.Aeson              (Value (..), Object)
+import           Data.Aeson.Types        (emptyObject, emptyArray)
+import           Data.Vector             as V (null, head)
+import           Data.Map                as M (fromList, toList)
+import           Data.Monoid             ((<>))
 import           Data.String.Conversions (cs)
-import           Data.Text (Text)
+import           Data.Text               (Text)
 import           PostgREST.PgQuery       (pgFmtLit, pgFmtIdent, unquoted)
-import           Prelude
 import qualified Web.JWT                 as JWT
 import qualified Data.HashMap.Lazy       as H
 
+{-|
+  Receives the JWT secret (from config) and a JWT and
+  returns a list of PostgreSQL statements to set the claims
+  as user defined GUCs.
+  Except if we have a claim called role, this one is mapped to
+  a SET ROLE statement.
+  In case there is any problem decoding the JWT it returns Nothing.
+-}
 setJWTEnv :: Text -> Text -> Maybe [Text]
-setJWTEnv secret input = setDBEnv $ jwtClaims secret input
-
-setDBEnv :: Maybe JWT.ClaimsMap -> Maybe [Text]
-setDBEnv maybeClaims =
-  (map setVar . toList) <$> maybeClaims
+setJWTEnv secret input = setDBEnv jwtClaims
   where
+    setDBEnv maybeClaims = (map setVar . toList) <$> maybeClaims
     setVar ("role", String val) = setRole val
     setVar (k, val) = "set local postgrest.claims." <> pgFmtIdent k <>
-                  " = " <> valueToVariable val <> ";"
+                      " = " <> valueToVariable val <> ";"
     valueToVariable = pgFmtLit . unquoted
+    jwtClaims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
+    decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
+-- | Receives the name of a role and returns a SET ROLE statement
 setRole :: Text -> Text
 setRole role = "set local role " <> cs (pgFmtLit role) <> ";"
 
-jwtClaims :: Text -> Text -> Maybe JWT.ClaimsMap
-jwtClaims secret input = claims
-  where
-    claims = JWT.unregisteredClaims <$> JWT.claims <$> decoded
-    decoded = JWT.decodeAndVerifySignature (JWT.secret secret) input
 
+{-|
+  Receives the JWT secret (from config) and a JWT and a JSON value
+  and returns a signed JWT.
+-}
 tokenJWT :: Text -> Value -> Text
 tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
                                JWT.def { JWT.unregisteredClaims = fromHashMap o }
@@ -47,4 +64,3 @@ tokenJWT secret (Array a) = JWT.encodeSigned JWT.HS256 (JWT.secret secret)
                             fromHashMap :: Object -> JWT.ClaimsMap
                             fromHashMap = M.fromList . H.toList
 tokenJWT secret _          = tokenJWT secret emptyArray
-

test/SpecHelper.hs

@@ -20,7 +20,6 @@ import Network.HTTP.Types.Header (Header, ByteRange, renderByteRange,
 import Codec.Binary.Base64.String (encode)
 import Data.CaseInsensitive (CI(..))
 import Data.Maybe (fromMaybe)
-import Data.Functor.Identity
 import Text.Regex.TDFA ((=~))
 import qualified Data.ByteString.Char8 as BS
 import System.Process (readProcess)
@@ -55,10 +54,6 @@ withApp perform = do
   pool :: H.Pool P.Postgres
     <- H.acquirePool pgSettings testPoolOpts
 
-  Right authenticator <- H.session pool $ do
-    Identity (role :: Text) <- H.tx Nothing $ H.singleEx [H.stmt|SELECT SESSION_USER|]
-    return role
-
   let txSettings = Just (H.ReadCommitted, Just True)
   metadata <- H.session pool $ H.tx txSettings $ do
     tabs <- allTables