octohat (empty) → 0.1

raw patch · 10 files changed

+600/−0 lines, 10 filesdep +aesondep +basedep +base-compatsetup-changed

Dependencies added: aeson, base, base-compat, base16-bytestring, base64-bytestring, bytestring, containers, cryptohash, dotenv, either, errors, hspec, hspec-expectations, http-client, http-types, lens, mtl, octohat, text, time, transformers, unordered-containers, wreq, xmlhtml

Files

• Setup.hs +2/−0
• octohat.cabal +63/−0
• spec/Network/Octohat/TestData.hs +74/−0
• spec/Network/Octohat/TestUtil.hs +37/−0
• spec/Spec.hs +1/−0
• src/Network/Octohat.hs +62/−0
• src/Network/Octohat/Internal.hs +85/−0
• src/Network/Octohat/Keys.hs +33/−0
• src/Network/Octohat/Members.hs +82/−0
• src/Network/Octohat/Types.hs +161/−0

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

@@ -0,0 +1,63 @@+Name:                octohat+Version:             0.1+Synopsis:            A tested, minimal wrapper around GitHub's API. Very incomplete at the moment+License:             MIT+Author:              Stack Builders+Maintainer:          hackage@stackbuilders.com+Stability:           Experimental+Category:            Network+Build-type:          Simple+Cabal-version:       >=1.10++Library+  hs-source-dirs: src++  Build-depends:+      aeson                == 0.8.*+    , base                 >= 4.5 && < 4.8+    , base-compat          == 0.5.*+    , base16-bytestring    == 0.1.1.*+    , base64-bytestring    == 1.0.*+    , bytestring           >= 0.9+    , containers           >= 0.4+    , cryptohash           == 0.11.*+    , dotenv               == 0.1.*+    , either               == 4.3.*+    , errors               == 1.4.*+    , http-client          == 0.4.*+    , http-types           == 0.8.*+    , lens                 >= 4.0 && <= 4.7+    , mtl                  == 2.*+    , text                 == 1.2.*+    , time                 == 1.4.*+    , transformers         == 0.3.*+    , unordered-containers == 0.2.*+    , wreq                 == 0.3.*+    , xmlhtml              == 0.2.*++  ghc-options:       -Wall+  exposed-modules:   Network.Octohat.Types+                   , Network.Octohat.Members+                   , Network.Octohat.Keys+                   , Network.Octohat++  other-modules:     Network.Octohat.Internal++  default-language: Haskell2010++test-suite spec+  ghc-options     :   -Wall+  type            :   exitcode-stdio-1.0+  hs-source-dirs  :   spec+  main-is         :   Spec.hs+  build-depends   :   base               >= 4.5 && <4.8+                    , base-compat        == 0.5.*+                    , hspec              == 2.1.*+                    , hspec-expectations == 0.6.*+                    , text               == 1.2.*+                    , dotenv             == 0.1.*+                    , transformers       == 0.3.*+                    , octohat+  other-modules:    Network.Octohat.TestData,+                    Network.Octohat.TestUtil+  default-language:   Haskell2010

@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Octohat.TestData ( loadTestOrganizationName+                                , loadOwnerTeam+                                , loadTestAccountOne+                                , loadTestAccountTwo+                                , loadTestAccountThree+                                , publicKeyFixture+                                , publicKeyHostnameFixture+                                , fingerprintFixture+                                , fullPublicKeyFixture+                                ) where++import Network.Octohat.Types+import Network.Octohat (teamForTeamNameInOrg)+import Network.Octohat.Members (userForUsername)++import Control.Monad.IO.Class (liftIO)+import Control.Arrow (second)+import System.Environment.Compat (getEnvironment)+import Configuration.Dotenv (loadFile)+import Control.Applicative ((<$>), (<*>))+import qualified Data.Text as T++data TestEnvironment =+  TestEnvironment {+    organization :: T.Text,+    accountOne   :: T.Text,+    accountTwo   :: T.Text,+    accountThree :: T.Text+  }++readEnv :: [(String, String)] -> Maybe TestEnvironment+readEnv environment =+  TestEnvironment <$> lookup "SANDBOX_ORGANIZATION" env+                  <*> lookup "TEST_ACCOUNT_ONE" env+                  <*> lookup "TEST_ACCOUNT_TWO" env+                  <*> lookup "TEST_ACCOUNT_THREE" env+    where env = map (second T.pack) environment++loadEnv :: IO TestEnvironment+loadEnv = do+  loadFile False ".github-sandbox"+  env <- getEnvironment+  case readEnv env of+    Just res -> return res+    Nothing  -> fail "Environment variables not set correctly, please read README.md"++loadTestOrganizationName :: IO T.Text+loadTestOrganizationName = organization `fmap` loadEnv++loadOwnerTeam :: GitHub Team+loadOwnerTeam = liftIO (organization `fmap` loadEnv) >>= teamForTeamNameInOrg "Owners"++loadTestAccountOne :: GitHub Member+loadTestAccountOne = liftIO (accountOne `fmap` loadEnv) >>= userForUsername++loadTestAccountTwo :: GitHub Member+loadTestAccountTwo = liftIO (accountTwo `fmap` loadEnv) >>= userForUsername++loadTestAccountThree :: GitHub Member+loadTestAccountThree = liftIO (accountThree `fmap` loadEnv) >>= userForUsername++publicKeyHostnameFixture :: T.Text+publicKeyHostnameFixture = "octohat@stackbuilders"++fingerprintFixture :: T.Text+fingerprintFixture = "42:59:20:02:6f:df:b4:4a:1c:0e:fd:1b:86:58:f6:06"++publicKeyFixture :: T.Text+publicKeyFixture = "AAAAB3NzaC1yc2EAAAADAQABAAABAQC1Dopc3yxLWlzJwFqSoj0nAzRCU93R5DwNlogtRr/7NsnUVf443wl/vpRDRNscR0dV/VeNWYCqiZA0wGrXiVJ7HYi9XaWtHrUutLqrLe47aFFvAIdp15+RHkM0sXr963Kb9XMkmqswyXJ2TaZ0cgZfMNgl1ND248Y8fMDBx8elHwdZvyG2onG5aSVtOuKB4dWnmIb+uSQCN1K2kLYwHvQOjmqCiZ2XOP9u+ScphVdp6x4uAczH67CCRSUhI6U2fxSNf6YaDXyCWcqxj1agHUKdskb5rzxPaz5XZ2BgQscjoVo93M338HLmkyvbuP4yl2X6ZdLfE5mk2ZFfWQogxLGd"++fullPublicKeyFixture :: T.Text+fullPublicKeyFixture = T.concat ["ssh-rsa ", publicKeyFixture, " ", publicKeyHostnameFixture]

@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Octohat.TestUtil (findUserId, setupToken, removeTeams) where+++import Network.Octohat.Members+import Network.Octohat.Types+import Network.Octohat.TestData++import Control.Monad.IO.Class (liftIO)+import Configuration.Dotenv (loadFile)+import qualified Data.Text as T++findUserId :: T.Text -> GitHub Integer+findUserId username = memberId `fmap` userForUsername username++deleteAllTeams :: GitHub [DidDelete]+deleteAllTeams = do+  testOrganization <- liftIO loadTestOrganizationName+  allTeams <- teamsForOrganization testOrganization+  let teamsToDelete = map teamId $ filter (\t -> teamName t /= "Owners") allTeams+  mapM deleteTeamFromOrganization teamsToDelete++setupToken :: IO ()+setupToken = do+  loadFile False ".github-sandbox"+  result <- runGitHub deleteAllTeams+  case result of+    Left  _ -> fail "Clean-up failed"+    Right _ -> return ()++removeTeams :: () -> IO ()+removeTeams _ = do+  result <- runGitHub deleteAllTeams+  case result of+    Left  _ -> fail "Clean-up failed"+    Right _ -> return ()

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

@@ -0,0 +1,62 @@+-- | Convenience functions for some common operations with teams. Execute the result of these+--   functions using 'runGitHub' or 'runGitHub''++module Network.Octohat ( addUserToTeam+                       , membersOfTeamInOrganization+                       , keysOfTeamInOrganization+                       , teamForTeamNameInOrg) where++import Control.Error.Safe (tryHead)+import Control.Monad (liftM)+import qualified Data.Text as T++import Network.Octohat.Keys+import Network.Octohat.Members+import Network.Octohat.Types+++-- | Gets all the members of the organization+membersOfTeamInOrganization :: T.Text -- ^ GitHub organization name+                            -> T.Text -- ^ GitHub team name+                            -> GitHub [Member]+membersOfTeamInOrganization nameOfOrg nameOfTeam = teamId `liftM` teamForTeamNameInOrg nameOfOrg nameOfTeam >>= membersForTeam++-- | Adds a user with @nameOfUser@ to the team named @nameOfTeam@ within the organization named `nameOfOrg`+addUserToTeam :: T.Text -- ^ GitHub username+              -> T.Text -- ^ GitHub organization name+              -> T.Text -- ^ GitHub team name+              -> GitHub StatusInTeam+addUserToTeam nameOfUser nameOfOrg nameOfTeam = teamId `liftM` teamForTeamNameInOrg nameOfOrg nameOfTeam >>= addMemberToTeam nameOfUser++-- | Retrieves a list of members in a given team within an organization together with their public keys+keysOfTeamInOrganization :: T.Text -- ^ GitHub organization name+                         -> T.Text -- ^ GitHub team name+                         -> GitHub [MemberWithKey]+keysOfTeamInOrganization nameOfOrg nameOfTeam = do+  members <- membersOfTeamInOrganization nameOfOrg nameOfTeam+  pubKeys <- mapM keysForMember members+  let memberFingerprints = publicKeySetToFingerprints pubKeys+  return $ makeMembersWithKey members pubKeys memberFingerprints++teamForTeamNameInOrg :: T.Text -- ^ Team name+                     -> T.Text -- ^ Organization name+                     -> GitHub Team+teamForTeamNameInOrg nameOfTeam nameOfOrg = do+  teams <- teamsForOrganization nameOfOrg+  tryHead NotFound (teamsWithName nameOfTeam teams)++teamsWithName :: T.Text -> [Team] -> [Team]+teamsWithName nameOfTeam = filter (hasName nameOfTeam)++hasName :: T.Text -> Team -> Bool+hasName name team = name == teamName team+keysForMember :: Member -> GitHub [PublicKey]+keysForMember = publicKeysForUser . memberLogin++makeMembersWithKey :: [Member] -> [[PublicKey]] -> [[PublicKeyFingerprint]] -> [MemberWithKey]+makeMembersWithKey = zipWith3 MemberWithKey++publicKeySetToFingerprints :: [[PublicKey]] -> [[PublicKeyFingerprint]]+publicKeySetToFingerprints = (map.map) fingerprintFor++

@@ -0,0 +1,85 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ViewPatterns      #-}++module Network.Octohat.Internal+  ( putRequestTo+  , getRequestTo+  , postRequestTo+  , deleteRequestTo+  , composeEndpoint) where++import Control.Error.Safe+import Control.Lens (set, view)+import Control.Monad.Reader+import Data.Aeson+import Data.List+import Data.Text.Encoding (encodeUtf8)+import Network.Wreq+import qualified Network.Wreq.Types as WT+import qualified Data.ByteString.Lazy as BSL+import qualified Data.Text as T++import Network.Octohat.Types++composeEndpoint :: [T.Text] -> T.Text+composeEndpoint pathChunks = T.concat $ intersperse "/" ("https://api.github.com" : pathChunks)++getResponseEntity :: FromJSON a => Response BSL.ByteString -> Either GitHubReturnStatus a+getResponseEntity resp =+  case eitherDecode (view responseBody resp) of+    Left errorMessage -> Left (UnexpectedJSON errorMessage)+    Right decoded     -> Right decoded++requestOptions :: GitHub Options+requestOptions = do+  bearerToken <- ask+  let opts   = set auth (Just $ oauth2Bearer (encodeUtf8 $ unBearerToken bearerToken)) defaults+  let opts'  = set checkStatus (Just (\_ _ _ -> Nothing)) opts+  let opts'' = set (header "User-Agent") ["octohat v0.1"] opts'+  return opts''+++postRequestTo :: (ToJSON b, WT.Postable b, FromJSON a) => T.Text -> b -> GitHub a+postRequestTo uri body = do+  opts     <- requestOptions+  response <- liftIO $ postWith opts (T.unpack uri) (toJSON body)+  checkForStatus response+  tryRight $ getResponseEntity response++getRequestTo :: FromJSON a => T.Text -> GitHub a+getRequestTo uri = do+  opts     <- requestOptions+  response <- liftIO $ getWith opts (T.unpack uri)+  checkForStatus response+  tryRight $ getResponseEntity response++putRequestTo :: FromJSON a => T.Text -> GitHub a+putRequestTo uri = do+  opts     <- requestOptions+  response <- liftIO $ putWith opts (T.unpack uri) EmptyBody+  checkForStatus response+  tryRight $ getResponseEntity response++deleteRequestTo :: T.Text -> GitHub DidDelete+deleteRequestTo uri = do+  opts     <- requestOptions+  response <- liftIO $ deleteWith opts (T.unpack uri)+  checkForStatus response+  return $ isDeleted (viewResponse response)++checkForStatus :: Response a -> GitHub ()+checkForStatus (viewResponse -> 404) = tryAssert NotFound False+checkForStatus (viewResponse -> 403) = tryAssert NotAllowed False+checkForStatus (viewResponse -> 401) = tryAssert RequiresAuthentication False+checkForStatus (viewResponse -> 422) = tryAssert ValidationFailed False+checkForStatus (viewResponse -> 500) = tryAssert InternalError False+checkForStatus (viewResponse -> 400) = tryAssert InvalidJSON False+checkForStatus (viewResponse -> _)   = tryAssert AllOk True++viewResponse :: Response a -> Int+viewResponse = view (responseStatus . statusCode)++isDeleted :: Int -> DidDelete+isDeleted 204 = Deleted+isDeleted 200 = Deleted+isDeleted _   = NotDeleted

@@ -0,0 +1,33 @@+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.Octohat.Keys (fingerprintFor) where++import qualified Data.List as L+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Base16 as B16+import qualified Data.Text as T+import qualified Data.Text.Encoding as TE+import qualified Crypto.Hash.MD5 as MD5 -- eww++import Network.Octohat.Types++type RSAPublicKey = T.Text+type Fingerprint  = T.Text++-- | Computes a fingerprint from its Base 64 encoded representation. Assumes leading @ssh-rsa @ (mind the space)+--   prefix and no user@hostname suffix+fingerprintFor :: PublicKey -> PublicKeyFingerprint+fingerprintFor PublicKey{..} = PublicKeyFingerprint publicKeyId (digestToHex publicKey)++digestToHex :: RSAPublicKey -> Fingerprint+digestToHex = T.concat          .+              L.intersperse ":" .+              T.chunksOf 2      .+              T.toLower         .+              TE.decodeUtf8     .+              B16.encode        .+              MD5.hash          .+              B64.decodeLenient .+              TE.encodeUtf8     .+              T.replace "ssh-rsa " ""

@@ -0,0 +1,82 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Execute the result of these functions using 'runGitHub' or 'runGitHub''++module Network.Octohat.Members+  ( membersForOrganization+  , membersForTeam+  , teamsForOrganization+  , addMemberToTeam+  , deleteMemberFromTeam+  , deleteTeamFromOrganization+  , publicKeysForUser+  , addTeamToOrganization+  , userForUsername+  , addPublicKey+  ) where++import Network.Octohat.Internal+import Network.Octohat.Types++import qualified Data.Text as T+import Data.Monoid ((<>))++-- | Takes a new team name, the description of a team and the organization where to create the team+--   and creates a new team. Regular GitHub authorization/authentication applies.+addTeamToOrganization :: T.Text  -- ^ Name of new team+                      -> T.Text  -- ^ Description of new team+                      -> T.Text  -- ^ Organization name where the team will be created+                      -> GitHub Team+addTeamToOrganization nameOfNewTeam descOfTeam orgName =+  postRequestTo (composeEndpoint ["orgs", orgName, "teams"]) (TeamCreateRequest nameOfNewTeam descOfTeam)++-- | Deletes a team from an organization using its team ID.+deleteTeamFromOrganization :: Integer          -- ^ ID of Team to delete+                           -> GitHub DidDelete+deleteTeamFromOrganization idOfTeam = deleteRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam])++-- | Returns a list of members of an organization with the given name.+membersForOrganization :: T.Text          -- ^ The organization name+                       -> GitHub [Member]+membersForOrganization nameOfOrg = getRequestTo (composeEndpoint ["orgs", nameOfOrg, "members"])++-- | Returns a list of members of a team with the given team ID.+membersForTeam :: Integer         -- ^ The team ID+               -> GitHub [Member]+membersForTeam idOfTeam = getRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "members"])++-- | Returns a list of teams for the organization with the given name+teamsForOrganization :: T.Text        -- ^ The organization name+                     -> GitHub [Team]+teamsForOrganization nameOfOrg = getRequestTo (composeEndpoint ["orgs", nameOfOrg, "teams"])++-- | Adds a member to a team, might invite or add the member. Refer to 'StatusInTeam'+addMemberToTeam :: T.Text               -- ^ The GitHub username to add to a team+                -> Integer              -- ^ The Team ID+                -> GitHub StatusInTeam+addMemberToTeam nameOfUser idOfTeam =+  putRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "memberships", nameOfUser])++-- | Deletes a member with the given name from a team with the given ID. Might or might not delete+deleteMemberFromTeam :: T.Text            -- ^ GitHub username+                     -> Integer           -- ^ GitHub team ID+                     -> GitHub DidDelete+deleteMemberFromTeam nameOfUser idOfTeam =+  deleteRequestTo (composeEndpoint ["teams", T.pack $ show idOfTeam, "memberships", nameOfUser])++-- | Returns the public keys of the user with the given name+publicKeysForUser :: T.Text             -- ^ GitHub username+                  -> GitHub [PublicKey]+publicKeysForUser nameOfUser = getRequestTo (composeEndpoint ["users", nameOfUser, "keys"])++-- | Finds a user ID given their username+userForUsername :: T.Text        -- ^ GitHub username+                -> GitHub Member+userForUsername username = getRequestTo (composeEndpoint ["users", username])++-- | Add a key for the currently authenticated user+addPublicKey :: T.Text -- ^ Base64 RSA Key (ssh-rsa AA..)+             -> T.Text -- ^ Key title, e.g @octocat@stackbuilders@+             -> GitHub PublicKey+addPublicKey newKey newTitle =+  postRequestTo (composeEndpoint ["user", "keys"]) (AddPublicKeyRequest ("ssh-rsa " <> newKey) newTitle)

@@ -0,0 +1,161 @@+{-# LANGUAGE TemplateHaskell   #-}+{-# LANGUAGE OverloadedStrings #-}++module Network.Octohat.Types ( Member(..)+                             , MemberWithKey(..)+                             , Team(..)+                             , BearerToken(..)+                             , StatusInTeam(..)+                             , EmptyBody(..)+                             , DidDelete(..)+                             , PublicKey(..)+                             , PublicKeyFingerprint(..)+                             , TeamCreateRequest(..)+                             , GitHubReturnStatus(..)+                             , DidAddKey(..)+                             , AddPublicKeyRequest(..)+                             , runGitHub+                             , runGitHub'+                             , GitHub) where+import Control.Applicative+import Control.Monad.Reader (ReaderT(..))+import Control.Monad.Trans.Either+import Data.Aeson+import Data.Aeson.TH+import Data.Char (toLower)+import Network.HTTP.Client+import Network.Wreq.Types+import System.Environment.Compat (lookupEnv)+import qualified Data.HashMap.Strict as HS+import qualified Data.Text as T++-- | Represents a user in GitHub. Contains no more than login and user ID+data Member =+  Member { memberLogin :: T.Text+         , memberId    :: Integer+         } deriving (Show, Eq)++-- | Represents a team in GitHub. Contains the team's ID, the team's name and an optional description+data Team =+  Team { teamId          :: Integer+       , teamName        :: T.Text+       , teamDescription :: Maybe T.Text+       } deriving (Show, Eq)++-- | Represents a request to create a new team within an organization. The rest of the paramaters+--   are passed in the URL. Refer to <https://developer.github.com/v3/orgs/teams/#create-team>+data TeamCreateRequest =+  TeamCreateRequest { newTeamName        :: T.Text+                    , newTeamDescription :: T.Text+                    } deriving (Show, Eq)++-- | Represents a GitHub user with its public keys and fingerprints. A GitHub user might or might not+--   have any public keys+data MemberWithKey =+  MemberWithKey { member               :: Member+                , memberKey            :: [PublicKey]+                , memberKeyFingerprint :: [PublicKeyFingerprint]+                } deriving (Show, Eq)++-- | Represents a PublicKey within GitHub. It includes its ID and the public key encoded as base 64+data PublicKey =+  PublicKey { publicKeyId    :: Integer+            , publicKey      :: T.Text+            } deriving (Show, Eq)++-- | Represents a Fingerprint. The `fingerprintId` field should match the fingerprint's public key ID+--   within GitHub+data PublicKeyFingerprint =+  PublicKeyFingerprint { fingerprintId        :: Integer+                       , publicKeyFingerprint :: T.Text+                       } deriving (Show, Eq)++-- | Some Wreq functions expect a body, but often GitHub's API will request no body. The PUT verb+--   and its implementation in Wreq is an example of this.+data EmptyBody = EmptyBody deriving (Show, Eq)++-- | When adding a user to a team GitHub will add it immediately if the user already belongs to the+--   to the organization the team is in. Otherwise it will send an email for the user to accept the+--   request to join the team. Functions related adding or removing teams will return either Active+--   or Pending correspondingly.+data StatusInTeam = Active  | Pending deriving (Show, Eq)+++-- | Sum type to represent the success or failure of deletion of a resource within GitHub's API+data DidDelete = Deleted | NotDeleted deriving (Show, Eq)++instance FromJSON PublicKey where+  parseJSON (Object o) = PublicKey <$> o .: "id" <*> o .: "key"+  parseJSON _          = fail "Could not find public keys in document"++data DidAddKey = KeyAdded | KeyNotAdded++data AddPublicKeyRequest =+  AddPublicKeyRequest {+      addPublicKeyRequestKey   :: T.Text,+      addPublicKeyRequestTitle :: T.Text+  }++instance FromJSON StatusInTeam where+  parseJSON (Object o) =+    case HS.lookup "state" o of+      Just "active"  -> pure Active+      Just "pending" -> pure Pending+      Just _         -> fail "\"state\" key not \"active\" or \"pending\""+      Nothing        -> (fail . maybe "No error message from GitHub" show) (HS.lookup "message" o)+  parseJSON _         = fail "Expected a membership document, got something else"++$(deriveJSON defaultOptions { fieldLabelModifier = drop 6  . map toLower } ''Member)+$(deriveJSON defaultOptions { fieldLabelModifier = drop 4  . map toLower } ''Team)+$(deriveJSON defaultOptions { fieldLabelModifier = drop 7  . map toLower } ''TeamCreateRequest)+$(deriveJSON defaultOptions { fieldLabelModifier = drop 19 . map toLower } ''AddPublicKeyRequest)++-- | Error codes GitHub might return when attempting to use an API endpoint+data GitHubReturnStatus =   InvalidJSON             -- ^ GitHub could not parse the JSON document sent+                          | ValidationFailed        -- ^ Validation failed, an example of this error+                                                    --   is trying to create teams with the same name+                                                    --   within one organization+                          | InternalError           -- ^ In case GitHub returns 500 Internal Server Error+                                                    --   to some request+                          | NotFound                -- ^ When a resource has not been found. It does not+                                                    --   imply the resource does not exist+                          | NotAllowed              -- ^ Usually returned after GitHub replies with 403 Forbidden.+                                                    --   The user might not have permission to access/modify+                                                    --   that resource+                          | AllOk                   -- ^ This should never be returned+                          | RequiresAuthentication  -- ^ Accesing this resource requires authentication+                          | UnexpectedJSON String   -- ^ This library has failed to fulfill its purpose and could not+                                                    --   handle GitHub's response+                          deriving (Show, Eq)++-- | Instance that does not add anything to the body or headers of a PUT request+instance Putable EmptyBody where+  putPayload EmptyBody req = return $ req {requestBody = RequestBodyLBS ""}++instance Postable TeamCreateRequest where+  postPayload createRequest req = return $ req { requestBody = RequestBodyLBS (encode createRequest)}++instance Postable AddPublicKeyRequest where+  postPayload createRequest req = return $ req { requestBody = RequestBodyLBS (encode createRequest)}++-- | GitHub's OAuth 2.0 bearer token. This is simply added in an+--   Authorization header+newtype BearerToken = BearerToken { unBearerToken :: T.Text }++-- | The monad transformer where all operations run. Supports initial configuration+--   through a Reader monad and the possibility of failure through Either+type GitHub = EitherT GitHubReturnStatus (ReaderT BearerToken IO)++-- | Executes a computation built within the GitHub monad returning an Either within+--   the IO data type using the provided token+runGitHub' :: GitHub a -> BearerToken -> IO (Either GitHubReturnStatus a)+runGitHub' comp = runReaderT (runEitherT comp)++-- | Executes a computation built within the GitHub monad returning an Either within+--   the IO data type. Reads an API token from an environment variable named GITHUB_TOKEN+runGitHub :: GitHub a -> IO (Either GitHubReturnStatus a)+runGitHub comp = do+  maybeToken <- lookupEnv "GITHUB_TOKEN"+  case maybeToken of+    Just acquiredToken -> runGitHub' comp (BearerToken $ T.pack acquiredToken)+    Nothing            -> fail "Couldn't find GITHUB_TOKEN in environment"