Merge pull request #22 from Nike-Inc/feature/csrf-crumb-generation

CSRF crumb generation

.ghci

@@ -0,0 +1,4 @@
+-- Fire up the REPL with some niceties
+:m Control.Lens Data.Aeson Data.Aeson.Lens Network.Wreq
+:l test/ReplSugar.hs
+:set -XOverloadedStrings

bartlett.cabal

@@ -1,5 +1,5 @@
 name:                bartlett
-version:             1.1.3
+version:             1.3.0
 synopsis:            The Jenkins command-line tool to serve your needs.
 description:         Please see README.md
 homepage:            https://github.com/Nike-inc/bartlett
@@ -42,7 +42,9 @@ library
                        lens-aeson,
                        text,
                        http-types,
-                       http-client
+                       http-client,
+                       uri-bytestring,
+                       case-insensitive
 
 executable bartlett
   main-is:             app/Main.hs
@@ -82,4 +84,6 @@ test-suite bartlett-test
                            aeson,
                            wreq,
                            http-types,
-                           lens
+                           lens,
+                           uri-bytestring,
+                           either-unwrap

src/Bartlett/Actions/Config.hs

@@ -21,7 +21,7 @@ import qualified Data.ByteString.Lazy.Char8 as BL
 import Network.Wreq (responseStatus, responseBody, defaults, auth)
 
 -- | Construct a URL to interact with Job configurations.
-configUri :: JenkinsInstance -> JobPath -> BL.ByteString
+configUri :: JenkinsInstance -> JobPath -> JenkinsInstance
 configUri base path =
   mkUrl base path "/config.xml"
 

src/Bartlett/Configuration.hs

@@ -24,8 +24,10 @@ import Bartlett.Util (toText)
 import Bartlett.Types
 
 import qualified Data.Configurator as C
+import Data.ByteString.Lazy.Char8 (toStrict)
 import Data.Configurator.Types
 import System.FilePath ((</>))
+import URI.ByteString (parseURI, strictURIParserOptions)
 
 -- | Default config file location
 defaultConfigLoc :: FilePath
@@ -45,8 +47,17 @@ getUsername cfg =
 
 -- | Retrieve the Jenkins instance for the given profile.
 getJenkinsInstance :: Config -> IO (Maybe JenkinsInstance)
-getJenkinsInstance cfg =
-  C.lookup cfg (toText "jenkins_instance")
+getJenkinsInstance cfg = do
+  ioInst <- C.lookup cfg (toText "jenkins_instance")
+  case ioInst of
+    Nothing ->
+      return Nothing
+    Just inst ->
+      case parseURI strictURIParserOptions (toStrict inst) of
+        Left err ->
+          return Nothing
+        Right i ->
+          return $ Just i
 
 -- | Get the value determining whether the user's password should be stored.
 getStorePassword :: Config -> IO (Maybe Bool)

src/Bartlett/Network.hs

@@ -11,53 +11,83 @@ General network related methods used throughout Bartlett.
 -}
 module Bartlett.Network (
   -- * Request handlers
+  requestCSRFToken,
+  consCSRFHeader,
   execRequest,
   -- * Error Handlers
   simpleErrorHandler,
   recoverableErrorHandler
 )where
 
-import Bartlett.Util (toResponseStatus, withForcedSSL)
-import Bartlett.Types (RequestType(Get, Post))
+import qualified Bartlett.Util as BU
+import           Bartlett.Types (RequestType(Get, Post), JenkinsInstance)
 
 import qualified Control.Exception as E
-import Data.Aeson.Encode.Pretty (encodePretty)
-import Data.ByteString.Lazy.Char8 (ByteString, unpack)
-import Data.Maybe (fromMaybe)
+import           Control.Lens ((.~), (^?), (&))
+import           Data.Aeson.Encode.Pretty (encodePretty)
+import           Data.Aeson.Lens (key, _String)
+import qualified Data.CaseInsensitive as CI
+import           Data.ByteString.Lazy.Char8 (ByteString, unpack, toStrict)
+import           Data.Maybe (fromMaybe)
 import qualified Network.HTTP.Client as NHC
-import System.Exit (die)
-import Network.Wreq (Options, Response)
+import           System.Exit (die)
+import           Network.Wreq (Options, Response, param, responseBody, header, defaults)
 import qualified Network.Wreq.Session as S
 
+
+-- | Attempt to request a CSRF token from the Jenkins server.
+requestCSRFToken ::
+  S.Session                                  -- The current session used to interact with Jenkins.
+  -> Options                                 -- Request parameters to pass along with the request.
+  -> JenkinsInstance                         -- The uri to make the request to
+  -> IO (Maybe ByteString, Maybe ByteString) -- The CSRF crumb to attach to future requests.
+requestCSRFToken sess opts jenkins = do
+  -- TODO fix this ugly mess
+  resp <- E.try (S.getWith reqOpts sess (BU.uriToString reqUri)) :: IO (Either NHC.HttpException (Response ByteString))
+  case resp of
+    Left _ ->
+      return (Nothing, Nothing)
+    Right r ->
+      return $
+        (BU.toByteString <$> (r ^? responseBody . key (BU.toText "crumbRequestField") . _String),
+         BU.toByteString <$> (r ^? responseBody . key (BU.toText "crumb") . _String))
+  where reqUri = BU.setPath jenkins "/crumbIssuer/api/json"
+        reqOpts = opts & param "xpath" .~ [BU.toText "concat(//crumbRequestField,\":\",//crumb)"]
+
+-- | Construct a valid header from a potential CSRF response.
+consCSRFHeader :: IO (Maybe ByteString, Maybe ByteString) -> IO (Options -> Options)
+consCSRFHeader ioCrumb = ioCrumb >>= \ (field, crumb) ->
+  return $ header (CI.mk . toStrict . fromMaybe "" $ field) .~ [(toStrict . fromMaybe "") crumb]
+
+
 -- | General request handler that provides basic error handling.
 execRequest ::
   RequestType                 -- ^ The type of request to make
   -> Options                  -- ^ Request params to pass along with the request.
-  -> ByteString               -- ^ The uri to make the request to
+  -> JenkinsInstance          -- ^ The uri to make the request to
   -> Maybe ByteString         -- ^ The file to upload to the Jenkins instance.
-  -> IO (Response ByteString)
-execRequest requestType opts reqUrl postBody =
+  -> IO (Response ByteString) -- ^ The response from the Jenkins instance.
+execRequest requestType reqOpts reqUrl postBody =
   S.withAPISession $ \session ->
     case requestType of
-      -- TODO Need to get a CSRF crumb
-      -- JENKINS_URL/crumbIssuer/api/json?xpath=?xpath=concat(//crumbRequestField,":",//crumb)')
-      Post ->
-        postSession reqUrl
+      Post -> do
+        csrfCrumb <- consCSRFHeader $ requestCSRFToken session reqOpts reqUrl
+        postSession reqUrl (reqOpts & csrfCrumb)
           `E.catch`
-            recoverableErrorHandler (postSession $ withForcedSSL reqUrl)
+            recoverableErrorHandler (postSession (BU.withForcedSSL reqUrl) (reqOpts & csrfCrumb))
               where fileToUpload = fromMaybe "" postBody :: ByteString
-                    postSession url = S.postWith opts session (unpack url) fileToUpload
+                    postSession url opts = S.postWith opts session (BU.uriToString url) fileToUpload
       Get ->
         getSession reqUrl
           `E.catch`
-            recoverableErrorHandler (getSession $ withForcedSSL reqUrl)
-              where getSession url = S.getWith opts session (unpack url)
+            recoverableErrorHandler (getSession . BU.withForcedSSL $ reqUrl)
+              where getSession url = S.getWith reqOpts session (BU.uriToString url)
 
 
 -- | Handler that returns a JSON representation of the error status.
 simpleErrorHandler :: NHC.HttpException -> IO a
 simpleErrorHandler (NHC.StatusCodeException status _ _) =
-  die . unpack . encodePretty . toResponseStatus $ status
+  die . unpack . encodePretty . BU.toResponseStatus $ status
 
 -- | Attempt to recover from non-fatal errors with the provided action, otherwise
 --   fail again with the 'simpleErrorHandler'

src/Bartlett/Parsers.hs

@@ -12,7 +12,8 @@ module Bartlett.Parsers where
 
 import Bartlett.Types
 
-import Data.ByteString.Lazy.Char8 (ByteString, pack, unpack)
+import Data.ByteString.Lazy.Char8 (ByteString, pack, unpack, toStrict)
+import URI.ByteString (URIRef, Absolute, parseURI, strictURIParserOptions)
 import Options.Applicative
 import Options.Applicative.Types (readerAsk)
 
@@ -22,6 +23,16 @@ readerByteString = do
   s <- readerAsk
   return $ pack s
 
+-- | Parse a command line option as a "URIRef"
+readerUriRef :: ReadM (URIRef Absolute)
+readerUriRef = do
+  s <- readerAsk
+  case parseURI strictURIParserOptions (toStrict $ pack s) of
+    Left a ->
+      readerAbort (ErrorMsg (show a))
+    Right uri ->
+      return uri
+
 -- | Wrap parsers with doc strings and metadata.
 withInfo :: Parser a -> ByteString -> ParserInfo a
 withInfo opts desc = info (helper <*> opts)
@@ -44,7 +55,7 @@ parseUsername = option readerByteString $
 
 -- | Parse a Jenkins instance url.
 parseJenkinsInstance :: Parser JenkinsInstance
-parseJenkinsInstance = option readerByteString $
+parseJenkinsInstance = option readerUriRef $
   short 'j' <> long "jenkins" <> metavar "JENKINS_INSTANCE" <>
   help "The Jenkins instance to interact with"
 

src/Bartlett/Types.hs

@@ -34,8 +34,11 @@ import Data.Aeson (ToJSON, FromJSON)
 import Data.ByteString.Lazy.Char8 (ByteString, toStrict)
 import GHC.Generics (Generic)
 import Network.Wreq (Auth, basicAuth)
+import URI.ByteString (URIRef, Absolute)
 
-type JenkinsInstance = ByteString
+-- TODO use newtypes!! doesn't require boxing
+
+type JenkinsInstance = URIRef Absolute
 -- ^ Base URI for the desired Jenkins instance.
 type Username        = ByteString
 -- ^ Username to authenticate with against Jenkins.

src/Bartlett/Util.hs

@@ -12,15 +12,18 @@ A collection of utility methods used throughout Bartlett.
 -}
 module Bartlett.Util (
   -- * URL Helpers
+  setPath,
   mkUrl,
   mkJobPath,
   withForcedSSL,
   segmentPath,
   pairToTuple,
   -- * Type Conversions
   toText,
+  toByteString,
   toPrettyJson,
   toResponseStatus,
+  uriToString,
   -- * Query Parameter Helpers
   parseParameters,
   parametersBuilder,
@@ -31,18 +34,25 @@ import Prelude hiding (concat, null, dropWhile)
 
 import Bartlett.Types
 
-import Control.Lens (set)
+import Control.Lens (set, (^.))
 import Data.Aeson (decode, Object)
 import Data.Aeson.Encode.Pretty (encodePretty)
 import Data.ByteString.Lazy.Char8
+import Data.ByteString.Builder (toLazyByteString)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import qualified Network.Wreq as W
 import Network.HTTP.Types.Status
+import URI.ByteString (pathL, uriSchemeL, schemeBSL, serializeURIRef)
+
+setPath :: JenkinsInstance -> ByteString -> JenkinsInstance
+setPath jenkins path =
+  set pathL (toStrict path) jenkins
 
 -- | Constructs a valid Jenkins API url.
-mkUrl :: JenkinsInstance -> JobPath -> ByteString -> ByteString
-mkUrl base path suffix = concat [base, mkJobPath path, suffix]
+mkUrl :: JenkinsInstance -> JobPath -> ByteString -> JenkinsInstance
+mkUrl base path suffix =
+  setPath base $ concat [mkJobPath path, suffix]
 
 -- | Given a slash-delimited path, return that same path interspersed with '/job/'.
 mkJobPath :: JobPath -> ByteString
@@ -53,9 +63,11 @@ mkJobPath s   = append "/job/" . intercalate "/job/" . segmentPath $ s
 -- | Given a base Jenkins instance, force the use of HTTPS
 withForcedSSL :: JenkinsInstance -> JenkinsInstance
 withForcedSSL base =
-  if "http://" `isPrefixOf` base || "https://" `isPrefixOf` base
-     then concat ["https", dropWhile (/=':') base]
-     else concat ["https://", base]
+  case base ^. uriSchemeL . schemeBSL of
+    "http" ->
+      set (uriSchemeL . schemeBSL) "https" base
+    _ ->
+      base
 
 -- | Segment a slash-delimited string as well as filter empty elements.
 segmentPath :: ByteString -> [ByteString]
@@ -71,6 +83,9 @@ pairToTuple _      = error "Attempted to convert a list of size != 2 to a 2-tupl
 toText :: ByteString -> T.Text
 toText = TE.decodeUtf8 . toStrict
 
+toByteString :: T.Text -> ByteString
+toByteString = fromStrict . TE.encodeUtf8
+
 -- | Return a pretty-formatted JSON string
 toPrettyJson :: ByteString -> ByteString
 toPrettyJson s = encodePretty (decode s :: Maybe Object)
@@ -83,6 +98,10 @@ toResponseStatus (Status code msg) =
     statusMessage = (unpack . fromStrict) msg
   }
 
+-- | Serialize a URI to a String
+uriToString :: JenkinsInstance -> String
+uriToString = unpack . toLazyByteString . serializeURIRef
+
 -- | Given a comma delimited list of key=value pairs, return a collection
 -- of pairs.
 parseParameters :: ByteString -> [(ByteString, ByteString)]

test/Bartlett/UtilSpec.hs

@@ -12,15 +12,26 @@ import qualified Network.Wreq as W
 import Network.HTTP.Types.Status hiding (statusCode, statusMessage)
 import Test.Hspec
 
+import URI.ByteString
+import Data.Either.Unwrap
+
+-- | Helper to create instances of 'JenkinsInstance'.
+jenkins :: Bool -> JenkinsInstance
+jenkins withSSL =
+  fromRight $ parseURI strictURIParserOptions url
+    where url = if withSSL
+                   then "https://example.com"
+                   else "http://example.com"
+
 spec :: Spec
 spec =
   describe "Util tests" $ do
 
     describe "mkUrl" $ do
       it "should return the JSON API at the root of the base url when no JobPath is given" $
-        unpack (mkUrl "https://example.com" "" "/api/json") `shouldEndWith` "/api/json"
+        uriToString (mkUrl (jenkins False) "" "/api/json") `shouldEndWith` "/api/json"
       it "should return a fully qualified API endpoint when given a JobPath" $
-        unpack (mkUrl "https://example.com" "foo" "/api/json") `shouldBe` "https://example.com/job/foo/api/json"
+        uriToString (mkUrl (jenkins True) "foo" "/api/json") `shouldBe` "https://example.com/job/foo/api/json"
 
     describe "mkJobPath" $ do
       it "should return the empty string given empty input" $
@@ -36,12 +47,9 @@ spec =
 
     describe "withForcedSSL" $ do
       it "should return a uri with the https protocol" $
-        unpack (withForcedSSL "lol") `shouldStartWith` "https://"
-      it "should return a uri with the https protocol when http is provided" $
-        withForcedSSL "http://foo" `shouldBe` "https://foo"
-      it "should return a uri with the https protocol when https is provided" $ do
-        let url = "https://foo"
-        withForcedSSL url `shouldBe` url
+        uriToString (withForcedSSL (jenkins False)) `shouldStartWith` "https://"
+      it "should return a uri with the https protocol when https is provided" $
+        withForcedSSL (jenkins True) `shouldBe` jenkins True
 
     describe "segmentPath" $ do
       it "should return an empty collection if nothing is passed in" $

test/ReplSugar.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+module ReplSugar where
+
+import Control.Lens
+import Bartlett.Types
+import Bartlett.Util
+import Bartlett.Configuration
+import Bartlett.Network
+import Data.Maybe
+import Data.ByteString.Lazy.Char8
+import qualified Network.Wreq as W
+import qualified Network.Wreq.Session as S
+
+-- | Docker Jenkins user.
+usr :: User
+usr = User "test" "password"
+
+usrOpts :: W.Options
+usrOpts =
+  W.defaults & W.auth ?~ getBasicAuth usr
+
+
+jenkins :: IO JenkinsInstance
+jenkins = do
+  c <- getConfiguration "default"
+  j <- getJenkinsInstance c
+  return $ fromJust j
+
+getCSRF :: IO W.Options
+getCSRF = do
+  j <- jenkins
+  S.withAPISession $ \session -> do
+    foo <- consCSRFHeader $ requestCSRFToken session usrOpts j
+    return $ W.defaults & foo