From a29c13a9c222c4ed53b64e28360be6eff93e566d Mon Sep 17 00:00:00 2001 From: Ricky Elrod Date: May 30 2015 10:52:00 +0000 Subject: Initial commit, some groundwork Signed-off-by: Ricky Elrod --- diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..48fe6f3 --- /dev/null +++ b/.gitignore @@ -0,0 +1,15 @@ +dist +cabal-dev +*.o +*.hi +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..5019be0 --- /dev/null +++ b/LICENSE @@ -0,0 +1,26 @@ +Copyright (c) 2015, Ricky Elrod +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + +2. 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. + +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 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/pagure.cabal b/pagure.cabal new file mode 100644 index 0000000..17d9a06 --- /dev/null +++ b/pagure.cabal @@ -0,0 +1,32 @@ +name: pagure +version: 0.1.0.0 +synopsis: A Haskell client to the Pagure API +description: A Haskell client to the Pagure API. Currently targets + API version 0. +homepage: https://pagure.io/pagure-haskell +license: BSD2 +license-file: LICENSE +author: Ricky Elrod +maintainer: relrod@redhat.com +copyright: (c) 2015 Red Hat, Inc. +category: Web +build-type: Simple +-- extra-source-files: +cabal-version: >= 1.10 + +library + exposed-modules: + Web.Pagure.Types + , Web.Pagure.Internal.Wreq + , Web.Pagure.Extras + , Web.Pagure + -- other-modules: + -- other-extensions: + build-depends: aeson >= 0.7 && < 1 + , base >= 4 && < 5 + , bytestring >= 0.9 && < 1 + , lens >= 4 && < 5 + , lens-aeson >= 1 && < 2 + , wreq >= 0.3 && < 1 + hs-source-dirs: src + default-language: Haskell2010 \ No newline at end of file diff --git a/src/Web/Pagure.hs b/src/Web/Pagure.hs new file mode 100644 index 0000000..7d7e5d3 --- /dev/null +++ b/src/Web/Pagure.hs @@ -0,0 +1,15 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Web.Pagure +-- Copyright : (C) 2015 Ricky Elrod +-- License : BSD2 (see LICENSE file) +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- Portability : ghc (lens) +-- +-- Meta module that includes everything except the 'Internal' module. +---------------------------------------------------------------------------- +module Web.Pagure (module P) where + +import Web.Pagure.Extras as P +import Web.Pagure.Types as P diff --git a/src/Web/Pagure/Extras.hs b/src/Web/Pagure/Extras.hs new file mode 100644 index 0000000..4e37831 --- /dev/null +++ b/src/Web/Pagure/Extras.hs @@ -0,0 +1,22 @@ +{-# LANGUAGE TemplateHaskell #-} +----------------------------------------------------------------------------- +-- | +-- Module : Web.Pagure.Extras +-- Copyright : (C) 2015 Ricky Elrod +-- License : BSD2 (see LICENSE file) +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- Portability : ghc (lens) +-- +-- Access to the \"Extras\" endpoints of the Pagure API. +---------------------------------------------------------------------------- +module Web.Pagure.Extras where + +import qualified Data.ByteString.Lazy.Char8 as BL +import Network.Wreq +import Web.Pagure.Internal.Wreq +import Web.Pagure.Types + +-- | Access the @/version@ endpoint. +version :: PagureConfig -> IO (Response BL.ByteString) +version pc = pagureGet pc "/version" diff --git a/src/Web/Pagure/Internal/Wreq.hs b/src/Web/Pagure/Internal/Wreq.hs new file mode 100644 index 0000000..fb9c23e --- /dev/null +++ b/src/Web/Pagure/Internal/Wreq.hs @@ -0,0 +1,51 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} +----------------------------------------------------------------------------- +-- | +-- Module : Web.Pagure.Internal.Wreq +-- Copyright : (C) 2015 Ricky Elrod +-- License : BSD2 (see LICENSE file) +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- Portability : ghc (lens) +-- +-- Low-level access to the Pagure API +---------------------------------------------------------------------------- +module Web.Pagure.Internal.Wreq where + +import Control.Lens +import Data.Aeson (toJSON) +import Data.Aeson.Lens (key, nth) +import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Lazy.Char8 as BL +import Data.List (dropWhile, dropWhileEnd) +import Network.Wreq +import Network.Wreq.Types (Postable) +import Web.Pagure.Types + +-- | The version of the API we are targetting. +apiVersion :: Int +apiVersion = 0 + +-- | Construct an API URL path. Strips any preceeding slashes from the given +-- 'String' parameter as well as the '_baseUrl' of the 'PagureConfig'. +pagureUrl :: PagureConfig -> String -> String +pagureUrl (PagureConfig url _) s = + dropWhileEnd (=='/') url ++ "/api/" ++ show apiVersion ++ + "/" ++ dropWhile (== '/') s + +-- | Set up a (possibly authenticated) request to the Pagure API. +pagureWreqOptions :: PagureConfig -> Options +pagureWreqOptions (PagureConfig _ (Just k)) = + defaults & header "Authorization" .~ [BS.pack k] +pagureWreqOptions _ = defaults + +-- | Perform a @GET@ request to the API. +pagureGet :: PagureConfig -> String -> IO (Response BL.ByteString) +pagureGet pc path = getWith (pagureWreqOptions pc) (pagureUrl pc path) + +-- | Perform a @POST@ request to the API. +pagurePost + :: Postable a => + PagureConfig -> String -> a -> IO (Response BL.ByteString) +pagurePost pc path = postWith (pagureWreqOptions pc) (pagureUrl pc path) diff --git a/src/Web/Pagure/Types.hs b/src/Web/Pagure/Types.hs new file mode 100644 index 0000000..a906d11 --- /dev/null +++ b/src/Web/Pagure/Types.hs @@ -0,0 +1,31 @@ +{-# LANGUAGE TemplateHaskell #-} +----------------------------------------------------------------------------- +-- | +-- Module : Web.Pagure.Types +-- Copyright : (C) 2015 Ricky Elrod +-- License : BSD2 (see LICENSE file) +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- Portability : ghc (lens) +-- +-- Types used within the Pagure API. +---------------------------------------------------------------------------- +module Web.Pagure.Types where + +import Control.Lens + +-- | Describes how to connect to, and authenticate with, the +-- . +-- +-- API keys are used for authenticating to the API. In API version 0, they are +-- apparently project-specific. This means that, short of keeping a local +-- database of all project keys (which expire every 60 days), there is no way of +-- mass-updating your projects. :( +-- +-- Keys are obtained by going to your project's Settings page, and clicking the +-- "Get a new Key" link. +data PagureConfig = PagureConfig { + _baseUrl :: String + , _apiKey :: Maybe String + } deriving (Eq, Show) +makeLenses ''PagureConfig