diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -Wall #-} +module Main (main) where + +#ifndef MIN_VERSION_cabal_doctest +#define MIN_VERSION_cabal_doctest(x,y,z) 0 +#endif + +#if MIN_VERSION_cabal_doctest(1,0,0) + +import Distribution.Extra.Doctest ( defaultMainWithDoctests ) +main :: IO () +main = defaultMainWithDoctests "doctests" + +#else + +#ifdef MIN_VERSION_Cabal +-- If the macro is defined, we have new cabal-install, +-- but for some reason we don't have cabal-doctest in package-db +-- +-- Probably we are running cabal sdist, when otherwise using new-build +-- workflow +#warning You are configuring this package without cabal-doctest installed. \ + The doctests test-suite will not work as a result. \ + To fix this, install cabal-doctest before configuring. +#endif + +import Distribution.Simple + +main :: IO () +main = defaultMain + +#endif diff --git a/my-package-testing.cabal b/my-package-testing.cabal new file mode 100644 --- /dev/null +++ b/my-package-testing.cabal @@ -0,0 +1,83 @@ +name: my-package-testing +version: 1.0.6 +synopsis: Nill +description: + . + > + . + /Test/ + . + *Test* +category: Web +homepage: http://github.com/ +bug-reports: https://github.com/ +author: Man Koma +maintainer: mmy009@gmail.com +copyright: (c) Man Koma +license: BSD3 +license-file: LICENSE +tested-with: GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.2 +build-type: Custom +cabal-version: >= 1.10 + +custom-setup + setup-depends: + base, Cabal, cabal-doctest >=1.0.2 && <1.1 + +source-repository head + type: git + location: https://github.com/ +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.8 && < 4.11 + , text + , servant-docs + , servant + , servant-auth == 0.3.* + , lens + exposed-modules: + Servant.Auth.Docs + default-language: Haskell2010 + +test-suite doctests + type: exitcode-stdio-1.0 + main-is: doctests.hs + build-depends: + base, + doctest >= 0.11.3 && <0.14, + servant-auth-docs, + QuickCheck >= 2.8 && <2.12, + template-haskell + ghc-options: -Wall -threaded + hs-source-dirs: test + 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-tool-depends: hspec-discover:hspec-discover + + -- dependencies with bounds inherited from the library stanza + build-depends: + base + , text + , servant-docs + , servant + , servant-auth + , lens + + -- test dependencies + build-depends: + servant-auth-docs + , hspec > 2 && < 3 + , QuickCheck >= 2.8 && < 2.12 + + default-language: Haskell2010 diff --git a/src/Servant/Auth/Docs.hs b/src/Servant/Auth/Docs.hs new file mode 100644 --- /dev/null +++ b/src/Servant/Auth/Docs.hs @@ -0,0 +1,96 @@ +{-# 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 diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/doctests.hs b/test/doctests.hs new file mode 100644 --- /dev/null +++ b/test/doctests.hs @@ -0,0 +1,12 @@ +module Main where + +import Build_doctests (flags, pkgs, module_sources) +import Data.Foldable (traverse_) +import Test.DocTest + +main :: IO () +main = do + traverse_ putStrLn args + doctest args + where + args = flags ++ pkgs ++ module_sources