diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, 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: + + * 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 Ricky Elrod 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,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/fedora-packages.cabal b/fedora-packages.cabal new file mode 100644 --- /dev/null +++ b/fedora-packages.cabal @@ -0,0 +1,67 @@ +name: fedora-packages +version: 0.0.1 +synopsis: Haskell interface to the Fedora Packages webapp API. +description: Provides access to the () API. +homepage: https://github.com/CodeBlock/fedora-packages-hs +license: BSD3 +license-file: LICENSE +author: Ricky Elrod +maintainer: ricky@elrod.me +copyright: (c) 2014 Ricky Elrod +category: Web +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Fedora.Packages + , Fedora.Packages.API + , Fedora.Packages.Builds + , Fedora.Packages.Config + , Fedora.Packages.Lens + , Fedora.Packages.Releases + , Fedora.Packages.Search + + build-depends: aeson >= 0.6 + , base >=4.6 && <4.7 + , bytestring >= 0.10 + , containers >= 0.5 + , http-streams >= 0.7 + , HsOpenSSL >= 0.10 + , io-streams >= 1.1 + , lens >= 4 && < 5 + , text >= 0.11 + hs-source-dirs: src + default-language: Haskell2010 + ghc-options: -Wall -O2 + + +test-suite hunit + hs-source-dirs: tests src + main-is: Spec.hs + type: exitcode-stdio-1.0 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + build-depends: aeson >= 0.6 + , base >=4.6 && <4.7 + , bytestring >= 0.10 + , containers >= 0.5 + , http-streams >= 0.7 + , HsOpenSSL >= 0.10 + , io-streams >= 1.1 + , lens >= 4 && < 5 + , text >= 0.11 + -- And of course... + , hspec ==1.8.* + +test-suite hlint + hs-source-dirs: tests + main-is: hlint.hs + type: exitcode-stdio-1.0 + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + build-depends: base + , hlint >= 1.7 + +source-repository head + type: git + location: git://github.com/CodeBlock/fedora-packages-hs.git diff --git a/src/Fedora/Packages.hs b/src/Fedora/Packages.hs new file mode 100644 --- /dev/null +++ b/src/Fedora/Packages.hs @@ -0,0 +1,51 @@ +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2014 Ricky Elrod +-- License : BSD3 +-- +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- +-- Provides a Haskell interface to the +-- API. +-- +-- This module simply re-exports all public modules within the fedora-packages +-- project. +-- +-- Depending on usecase, it might be easiest to import this and Lens, as below: +-- +-- > import Fedora.Packages +-- > import Fedora.Packages.Lens +-- > import Control.Lens +-- +-- But keep in mind that this will clutter your namespace pretty badly, and +-- might not be ideal for all situations. +-- +-- If you don't want to use lenses (but you should because they are awesome), +-- you can do this instead: +-- +-- > import qualified Fedora.Packages as FedPackages +-- +-- ...and then access everything using understored record-style getters, e.g. +-- @_packageName theBuild@. +-- +-- Or you can import specific pieces of @Fedora.Packages.\@ instead +-- of importing @Fedora.Packages@ which re-exports everything. +-- +-- If you do that, however, you'll want to import @Fedora.Packages.API@ and +-- @Fedora.Packages.Config@ as well, so that you have the necessary data types +-- for interacting with the API. +-- +-- TL;DR: This is written to be very modular, and you are free to use it however +-- it best fits in with the rest of your project. Have fun! +---------------------------------------------------------------------------- + +module Fedora.Packages + ( module F + ) where + +import Fedora.Packages.API as F +import Fedora.Packages.Builds as F +import Fedora.Packages.Config as F +import Fedora.Packages.Releases as F +import Fedora.Packages.Search as F diff --git a/src/Fedora/Packages/API.hs b/src/Fedora/Packages/API.hs new file mode 100644 --- /dev/null +++ b/src/Fedora/Packages/API.hs @@ -0,0 +1,90 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2014 Ricky Elrod +-- License : BSD3 +-- +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- +-- Functions and datatypes for directly calling out to the API and handling +-- queries to and responses from it. +---------------------------------------------------------------------------- + +module Fedora.Packages.API + ( -- * Responses + StandardResults (..) + -- * Requests + , Query (..) + , apiGet + ) where + +import Fedora.Packages.Config + +import Control.Applicative +import Control.Monad (mzero) +import Data.Aeson +import qualified Data.ByteString as S +import Data.Monoid +import Network.Http.Client +import OpenSSL (withOpenSSL) + +---------------------------------------------------------------------------- +-- Responses +---------------------------------------------------------------------------- + +data StandardResults a = StandardResults { + _srRows :: [a] + , _srRowsPerPage :: Int + , _srStartRow :: Int + , _srTotalRows :: Int + , _srVisibleRows :: Int + } deriving (Eq, Show) + +instance FromJSON a => FromJSON (StandardResults a) where + parseJSON (Object v) = StandardResults <$> + v .: "rows" + <*> v .: "rows_per_page" + <*> v .: "start_row" + <*> v .: "total_rows" + <*> v .: "visible_rows" + parseJSON _ = mzero + +---------------------------------------------------------------------------- +-- Requests +---------------------------------------------------------------------------- + +-- | Sets things that are common to all requests that we make. +prepareRequest :: Method -> S.ByteString -> RequestBuilder () +prepareRequest m url = do + http m url + setAccept "application/json" + setContentType "application/json" + +finishRequest :: FromJSON a => Connection -> IO a +finishRequest cnx = do + x <- receiveResponse cnx jsonHandler + closeConnection cnx + return x + +-- | Perform a GET request to the API. +apiGet :: FromJSON a => S.ByteString -> PackagesConfig -> IO a +apiGet url c = withOpenSSL $ do + cnx <- establishConnection (_baseurl c) + q <- buildRequest $ prepareRequest GET ("/packages/fcomm_connector/" <> url) + sendRequest cnx q emptyBody + finishRequest cnx + + +data Query a = Query { + _qSearch :: a + , _qRowsPerPage :: Int + , _qStartRow :: Int + } deriving (Eq, Show) + +instance ToJSON a => ToJSON (Query a) where + toJSON (Query s r sr) = object [ "filters" .= s + , "rows_per_page" .= r + , "start_row" .= sr + ] diff --git a/src/Fedora/Packages/Builds.hs b/src/Fedora/Packages/Builds.hs new file mode 100644 --- /dev/null +++ b/src/Fedora/Packages/Builds.hs @@ -0,0 +1,127 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2014 Ricky Elrod +-- License : BSD3 +-- +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- +-- Provides functions and datatypes for accessing information about Fedora +-- package builds. +---------------------------------------------------------------------------- + +module Fedora.Packages.Builds + ( Build (..) + , BuildsFilter (..) + , BuildState (..) + , CompletionTimeDisplay (..) + , builds + ) where + +import Fedora.Packages.API +import Fedora.Packages.Config + +import Control.Applicative +import Control.Monad (mzero) +import Data.Aeson hiding (Success) +import qualified Data.ByteString.Lazy as LS +import Data.Monoid hiding (All) +import qualified Data.Text as T + +data BuildState = + All + | Building + | Success + | Failed + | Cancelled + | Deleted + deriving (Eq, Show) + +buildStateToText :: BuildState -> T.Text +buildStateToText All = "" +buildStateToText Building = "0" +buildStateToText Success = "1" +buildStateToText Deleted = "2" +buildStateToText Failed = "3" +buildStateToText Cancelled = "4" + +data BuildsFilter = BuildsFilter { + _bfPackage :: T.Text + , _bfState :: BuildState + } deriving (Eq, Show) + +instance ToJSON BuildsFilter where + toJSON (BuildsFilter p s) = object [ "package" .= p + , "state" .= buildStateToText s + ] + +data CompletionTimeDisplay = CompletionTimeDisplay { + _elapsed :: T.Text + , _time :: T.Text + , _when :: T.Text + } deriving (Eq, Show) + +instance FromJSON CompletionTimeDisplay where + parseJSON (Object v) = CompletionTimeDisplay <$> + v .: "elapsed" + <*> v .: "time" + <*> v .: "when" + parseJSON _ = mzero + +data Build = Build { + _buildId :: Int + , _completionTime :: T.Text + , _completionTimeDisplay :: CompletionTimeDisplay + , _completionTs :: Double + , _creationEventId :: Int + , _creationTime :: T.Text + , _creationTs :: Double + , _epoch :: Maybe Double + , _name' :: T.Text + , _nvr :: T.Text + , _ownerId :: Int + , _ownerName :: T.Text + , _packageId :: Int + , _packageName :: T.Text + , _packageRelease :: T.Text + , _state :: Int + , _stateStr :: T.Text + , _taskId :: Int + , _version :: T.Text + , _volumeId :: Int + , _volumeName :: T.Text + } deriving (Eq, Show) + +instance FromJSON Build where + parseJSON (Object v) = Build <$> + v .: "build_id" + <*> v .: "completion_time" + <*> v .: "completion_time_display" + <*> v .: "completion_ts" + <*> v .: "creation_event_id" + <*> v .: "creation_time" + <*> v .: "creation_ts" + <*> v .:? "epoch" + <*> v .: "name" + <*> v .: "nvr" + <*> v .: "owner_id" + <*> v .: "owner_name" + <*> v .: "package_id" + <*> v .: "package_name" + <*> v .: "release" + <*> v .: "state" + <*> v .: "state_str" + <*> v .: "task_id" + <*> v .: "version" + <*> v .: "volume_id" + <*> v .: "volume_name" + parseJSON _ = mzero + +-- | Query to find builds for a given package. +builds :: PackagesConfig -- ^ The configuration to use. + -> Query BuildsFilter -- ^ The search query to send. + -> IO (StandardResults Build) +builds c s = + apiGet ("koji/query/query_builds/" <> LS.toStrict (encode s)) c diff --git a/src/Fedora/Packages/Config.hs b/src/Fedora/Packages/Config.hs new file mode 100644 --- /dev/null +++ b/src/Fedora/Packages/Config.hs @@ -0,0 +1,34 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2014 Ricky Elrod +-- License : BSD3 +-- +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- +-- Used for configuring how to connect to the Fedora Packages API. +---------------------------------------------------------------------------- + +module Fedora.Packages.Config + ( PackagesConfig (..) + , defaultConfig + , stagingConfig + ) where + +import Network.Http.Client + +data PackagesConfig = PackagesConfig { + _baseurl :: URL -- ^ The base URL (with protocol) of Fedora Packages. +} deriving (Eq, Show) + +-- | The default configuration, which points to the production instance of +-- Fedora Packages. +defaultConfig :: PackagesConfig +defaultConfig = PackagesConfig "https://apps.fedoraproject.org" + +-- | The staging configuration, which points to the staging instance of Fedora +-- Packages. +stagingConfig :: PackagesConfig +stagingConfig = PackagesConfig "https://apps.stg.fedoraproject.org" diff --git a/src/Fedora/Packages/Lens.hs b/src/Fedora/Packages/Lens.hs new file mode 100644 --- /dev/null +++ b/src/Fedora/Packages/Lens.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE TemplateHaskell #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2014 Ricky Elrod +-- License : BSD3 +-- +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- +-- Provides lenses for data types found within Fedora.Packages. +---------------------------------------------------------------------------- + +module Fedora.Packages.Lens where + +import Control.Lens (makeLenses) + +import Fedora.Packages.API +import Fedora.Packages.Config +import Fedora.Packages.Builds +import Fedora.Packages.Releases +import Fedora.Packages.Search + +makeLenses ''Build +makeLenses ''BuildsFilter +makeLenses ''CompletionTimeDisplay +makeLenses ''PackagesConfig +makeLenses ''Package +makeLenses ''Release +makeLenses ''SearchFilter +makeLenses ''StandardResults +makeLenses ''Query diff --git a/src/Fedora/Packages/Releases.hs b/src/Fedora/Packages/Releases.hs new file mode 100644 --- /dev/null +++ b/src/Fedora/Packages/Releases.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2014 Ricky Elrod +-- License : BSD3 +-- +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- +-- Provides functions and datatypes for getting release information about Fedora +-- packages. +---------------------------------------------------------------------------- + +module Fedora.Packages.Releases + ( Release (..) + , releases + , releases' + ) where + +import Fedora.Packages.API +import Fedora.Packages.Config + +import Control.Applicative +import Control.Monad (mzero) +import Data.Aeson +import qualified Data.ByteString.Lazy as LS +import Data.Monoid +import qualified Data.Text as T + +data Release = Release { + _release :: T.Text + , _stableVersion :: T.Text + , _testingVersion :: T.Text + } deriving (Eq, Show) + +instance FromJSON Release where + parseJSON (Object v) = Release <$> + v .: "release" + <*> v .: "stable_version" + <*> v .: "testing_version" + parseJSON _ = mzero + +data ReleasesFilter = ReleasesFilter { + _rfPackage :: T.Text + } deriving (Eq, Show) + +instance ToJSON ReleasesFilter where + toJSON (ReleasesFilter s) = object [ "package" .= s ] + +-- | Obtain release information about a package. +releases :: PackagesConfig -- ^ The configuration to use. + -> T.Text -- ^ The name of the package to look up. + -> IO (StandardResults Release) +releases c s = + let rJson = Query (ReleasesFilter s) 1 0 + in + apiGet ("bodhi/query/query_active_releases/" <> LS.toStrict (encode rJson)) c + +-- | Helper method to query for release information without having to worry +-- about traversing into 'StandardResults'. +-- +-- This is provided because this is one of the few places where the paging +-- information probably really doesn't matter. +-- +-- Equivalent to: +-- +-- > _srRows <$> releases c q +releases' :: PackagesConfig -- ^ The configuration to use. + -> T.Text -- ^ The name of the package to look up. + -> IO [Release] +releases' c q = _srRows <$> releases c q diff --git a/src/Fedora/Packages/Search.hs b/src/Fedora/Packages/Search.hs new file mode 100644 --- /dev/null +++ b/src/Fedora/Packages/Search.hs @@ -0,0 +1,94 @@ +{-# LANGUAGE OverloadedStrings #-} + +----------------------------------------------------------------------------- +-- | +-- Copyright : (c) 2014 Ricky Elrod +-- License : BSD3 +-- +-- Maintainer : Ricky Elrod +-- Stability : experimental +-- +-- Provides functions and datatypes for searching Fedora Packages. +---------------------------------------------------------------------------- + +module Fedora.Packages.Search + ( Package (..) + , Subpackage (..) + , SearchFilter (..) + , packageInfo + , search + ) where + +import Fedora.Packages.API +import Fedora.Packages.Config + +import Control.Applicative +import Control.Monad (mzero) +import Data.Aeson +import qualified Data.ByteString.Lazy as LS +import Data.Maybe (listToMaybe) +import Data.Monoid +import qualified Data.Text as T + +data SearchFilter = SearchFilter { + _sfSearch :: T.Text + } deriving (Eq, Show) + +instance ToJSON SearchFilter where + toJSON (SearchFilter s) = object [ "search" .= s ] + +data Package = Package { + _develOwner :: T.Text + , _icon :: T.Text + , _link :: T.Text + , _name :: T.Text + , _subPackages :: Maybe [Subpackage] + , _summary :: T.Text + , _upstreamUrl :: T.Text + , _description :: T.Text + } deriving (Eq, Show) + +instance FromJSON Package where + parseJSON (Object v) = Package <$> + v .: "devel_owner" + <*> v .: "icon" + <*> v .: "link" + <*> v .: "name" + <*> v .: "sub_pkgs" + <*> v .: "summary" + <*> v .: "upstream_url" + <*> v .: "description" + parseJSON _ = mzero + +data Subpackage = Subpackage { + _subIcon :: T.Text + , _subLink :: T.Text + , _subName :: T.Text + , _subSummary :: T.Text + , _subDescription :: T.Text + } deriving (Eq, Show) + +instance FromJSON Subpackage where + parseJSON (Object v) = Subpackage <$> + v .: "icon" + <*> v .: "link" + <*> v .: "name" + <*> v .: "summary" + <*> v .: "description" + parseJSON _ = mzero + +-- | Search Fedora Packages for a given pattern. +search :: PackagesConfig -- ^ The configuration to use. + -> Query SearchFilter -- ^ The search query to send. + -> IO (StandardResults Package) +search c s = + apiGet ("xapian/query/search_packages/" <> LS.toStrict (encode s)) c + +-- | Search Fedora Packages and return the package if an exact one is found. +packageInfo :: PackagesConfig -> T.Text -> IO (Maybe Package) +packageInfo c q = do + s <- search c (Query (SearchFilter q) 1 0) + let rows = _srRows s + matches = filter (\x -> _name x == q) rows + in + return $ listToMaybe matches diff --git a/tests/Spec.hs b/tests/Spec.hs new file mode 100644 --- /dev/null +++ b/tests/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/tests/hlint.hs b/tests/hlint.hs new file mode 100644 --- /dev/null +++ b/tests/hlint.hs @@ -0,0 +1,12 @@ +module Main where + +import Control.Monad +import Language.Haskell.HLint +import System.Environment +import System.Exit + +main :: IO () +main = do + args <- getArgs + hints <- hlint $ ["src", "--cpp-define=HLINT", "--cpp-ansi"] ++ args + unless (null hints) exitFailure