servant-auth-docs (empty) → 0.1.0.0

raw patch · 6 files changed

+236/−0 lines, 6 filesdep +Globdep +QuickCheckdep +basesetup-changed

Dependencies added: Glob, QuickCheck, base, doctest, hspec, lens, servant, servant-auth, servant-auth-docs, servant-docs, text, yaml

Files

LICENSE +31/−0
Setup.hs +2/−0
servant-auth-docs.cabal +79/−0
src/Servant/Auth/Docs.hs +97/−0
test/Doctest.hs +26/−0
test/Spec.hs +1/−0

+ LICENSE view

@@ -0,0 +1,31 @@+Copyright Julian K. Arni (c) 2015++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Julian K. Arni nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.+

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ servant-auth-docs.cabal view

@@ -0,0 +1,79 @@+-- This file has been generated from package.yaml by hpack version 0.14.0.+--+-- see: https://github.com/sol/hpack++name:           servant-auth-docs+version:        0.1.0.0+description:    Please see README.md+homepage:       http://github.com/jkarni/servant-auth-docs#readme+bug-reports:    https://github.com/jkarni/servant-auth-docs/issues+author:         Julian K. Arni+maintainer:     jkarni@gmail.com+copyright:      (c) Julian K. Arni+license:        BSD3+license-file:   LICENSE+tested-with:    GHC == 7.10.2, GHC == 8.0.1+build-type:     Simple+cabal-version:  >= 1.10++source-repository head+  type: git+  location: https://github.com/jkarni/servant-auth-docs++library+  hs-source-dirs:+      src+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , text+    , servant-docs+    , servant+    , servant-auth+    , lens+  exposed-modules:+      Servant.Auth.Docs+  default-language: Haskell2010++test-suite doctest+  type: exitcode-stdio-1.0+  main-is: Doctest.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , text+    , servant-docs+    , servant+    , servant-auth+    , lens+    , doctest >= 0.9 && < 0.12+    , Glob >= 0.7 && < 0.8+    , yaml == 0.8.*+  other-modules:+      Spec+  default-language: Haskell2010++test-suite spec+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  hs-source-dirs:+      test+  default-extensions: AutoDeriveTypeable ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators+  ghc-options: -Wall+  build-depends:+      base >= 4.7 && < 4.10+    , text+    , servant-docs+    , servant+    , servant-auth+    , lens+    , servant-auth-docs+    , hspec > 2 && < 3+    , QuickCheck >= 2.8 && < 2.9+  other-modules:+      Doctest+  default-language: Haskell2010

+ src/Servant/Auth/Docs.hs view

@@ -0,0 +1,97 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Servant.Auth.Docs+  (+  -- | The purpose of this package is provide the instance for 'servant-auth'+  -- combinators needed for 'servant-docs' documentation generation.+  --+  -- >>> type API = Auth '[JWT, Cookie, BasicAuth] Int :> Get '[JSON] Int+  -- >>> putStr $ markdown $ docs (Proxy :: Proxy API)+  -- ## GET /+  -- ...+  -- #### Authentication+  -- ...+  -- This part of the API is protected by the following authentication mechanisms:+  -- ...+  --  * JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))+  --  * [Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)+  --  * [Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)+  -- ...+  -- ...+  -- Clients must supply the following data+  -- ...+  -- One of the following:+  -- ...+  --  * A JWT Token signed with this server's key+  --  * Cookies automatically set by browsers, plus a header+  --  * Cookies automatically set by browsers, plus a header+  -- ...++  -- * Re-export+    JWT+  , BasicAuth+  , Cookie+  , Auth+  ) where++import Control.Lens          ((%~), (&), (|>))+import Data.List             (intercalate)+import Data.Monoid+import Data.Proxy            (Proxy (Proxy))+import Servant.API           hiding (BasicAuth)+import Servant.Auth+import Servant.Docs          hiding (pretty)+import Servant.Docs.Internal (DocAuthentication (..), authInfo)++instance (AllDocs auths, HasDocs api) => HasDocs (Auth auths r :> api) where+  docsFor _ (endpoint, action) =+    docsFor (Proxy :: Proxy api) (endpoint, action & authInfo %~ (|> info))+    where+      (intro, reqData) = pretty $ allDocs (Proxy :: Proxy auths)+      info = DocAuthentication intro reqData+++pretty :: [(String, String)] -> (String, String)+pretty [] = error "shouldn't happen"+pretty [(i, d)] =+  ( "This part of the API is protected by " <> i+  , d+  )+pretty rs =+  ( "This part of the API is protected by the following authentication mechanisms:\n\n"+  ++  " * " <> intercalate "\n * " (fst <$> rs)+  , "\nOne of the following:\n\n"+  ++  " * " <> intercalate "\n * " (snd <$> rs)+  )+++class AllDocs (x :: [*]) where+  allDocs :: proxy x+              -- intro, req+          -> [(String, String)]++instance (OneDoc a, AllDocs as) => AllDocs (a ': as) where+  allDocs _ = oneDoc (Proxy :: Proxy a) : allDocs (Proxy :: Proxy as)++instance AllDocs '[] where+  allDocs _ = []++class OneDoc a where+  oneDoc :: proxy a -> (String, String)++instance OneDoc JWT where+  oneDoc _ =+    ("JSON Web Tokens ([JWTs](https://en.wikipedia.org/wiki/JSON_Web_Token))"+     , "A JWT Token signed with this server's key")++instance OneDoc Cookie where+  oneDoc _ =+    ("[Cookies](https://en.wikipedia.org/wiki/HTTP_cookie)"+    , "Cookies automatically set by browsers, plus a header")++instance OneDoc BasicAuth where+  oneDoc _ =+    ( "[Basic Authentication](https://en.wikipedia.org/wiki/Basic_access_authentication)"+    , "Cookies automatically set by browsers, plus a header")++-- $setup+-- >>> instance ToSample Int where toSamples _ = singleSample 1729

+ test/Doctest.hs view

@@ -0,0 +1,26 @@+module Main (main) where++-- Runs doctest on all files in "src" dir. Assumes:+--   (a) You are using hpack+--   (b) The top-level "default-extensions" are the only extensions besides the+--   ones in the files.++import System.FilePath.Glob (glob)+import Test.DocTest (doctest)+import Data.Yaml++newtype Exts = Exts { getExts :: [String] }+  deriving (Eq, Show, Read)++instance FromJSON Exts where+  parseJSON (Object v) = Exts <$> v .: "default-extensions"+  parseJSON _ = fail "expecting object"++main :: IO ()+main = do+  hpack' <- decodeFile "package.yaml"+  hpack <- case hpack' of+    Nothing -> return $ Exts []+    Just v  -> return v+  files <- glob "src/**/*.hs"+  doctest $ files ++ fmap ("-X" ++) (getExts hpack)

+ test/Spec.hs view

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}