136 lines
3.1 KiB
Haskell
136 lines
3.1 KiB
Haskell
|
module Nuthatch.Probe.ProductClient
|
||
|
|
( browse
|
||
|
|
, deleteObject
|
||
|
|
, download
|
||
|
|
, downloadFrom
|
||
|
|
, sha256Hex
|
||
|
|
, upload
|
||
|
|
, uploadTo
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Crypto.Hash (Digest, SHA256, hash)
|
||
|
|
import qualified Data.ByteArray as BA
|
||
|
|
import qualified Data.ByteString as BS
|
||
|
|
import qualified Data.ByteString.Base16 as B16
|
||
|
|
import qualified Data.ByteString.Char8 as B8
|
||
|
|
import qualified Data.Text as Text
|
||
|
|
import qualified Data.Text.Encoding as Text
|
||
|
|
import Network.HTTP.Types.URI (urlEncode)
|
||
|
|
import Nuthatch.Probe.Curl
|
||
|
|
import Nuthatch.Probe.Oidc
|
||
|
|
import System.IO.Temp (withSystemTempFile)
|
||
|
|
import System.IO (hClose)
|
||
|
|
|
||
|
|
browse
|
||
|
|
:: ProbeContext
|
||
|
|
-> Session
|
||
|
|
-> String
|
||
|
|
-> IO CurlResponse
|
||
|
|
browse context session query =
|
||
|
|
curl
|
||
|
|
[ "--cookie", sessionCookies session
|
||
|
|
, "--header", "Accept: application/json"
|
||
|
|
, probeBase context <> "/api/browse" <> query
|
||
|
|
]
|
||
|
|
|
||
|
|
download
|
||
|
|
:: ProbeContext
|
||
|
|
-> Session
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> IO CurlResponse
|
||
|
|
download context =
|
||
|
|
downloadFrom (probeBase context) []
|
||
|
|
|
||
|
|
downloadFrom
|
||
|
|
:: String
|
||
|
|
-> [String]
|
||
|
|
-> Session
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> IO CurlResponse
|
||
|
|
downloadFrom base extra session root path =
|
||
|
|
curl
|
||
|
|
( extra
|
||
|
|
<> [ "--cookie", sessionCookies session
|
||
|
|
, base
|
||
|
|
<> "/api/download?root="
|
||
|
|
<> encode root
|
||
|
|
<> "&path="
|
||
|
|
<> encode path
|
||
|
|
]
|
||
|
|
)
|
||
|
|
|
||
|
|
upload
|
||
|
|
:: ProbeContext
|
||
|
|
-> Session
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> BS.ByteString
|
||
|
|
-> IO CurlResponse
|
||
|
|
upload context =
|
||
|
|
uploadTo (probeBase context) []
|
||
|
|
|
||
|
|
uploadTo
|
||
|
|
:: String
|
||
|
|
-> [String]
|
||
|
|
-> Session
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> BS.ByteString
|
||
|
|
-> IO CurlResponse
|
||
|
|
uploadTo base extra session root path operationId body =
|
||
|
|
withSystemTempFile "nuthatch-upload" $ \bodyPath handle -> do
|
||
|
|
BS.hPut handle body
|
||
|
|
hClose handle
|
||
|
|
curl
|
||
|
|
( extra
|
||
|
|
<> [ "--cookie", sessionCookies session
|
||
|
|
, "--header", "Content-Type: application/octet-stream"
|
||
|
|
, "--header", "X-Declared-Size: " <> show (BS.length body)
|
||
|
|
, "--header", "X-Content-SHA256: " <> B8.unpack (sha256Hex body)
|
||
|
|
, "--header"
|
||
|
|
, "X-CSRF-Token: " <> B8.unpack (sessionCsrf session)
|
||
|
|
, "--data-binary", "@" <> bodyPath
|
||
|
|
, base
|
||
|
|
<> "/api/upload?root="
|
||
|
|
<> encode root
|
||
|
|
<> "&path="
|
||
|
|
<> encode path
|
||
|
|
<> "&operation_id="
|
||
|
|
<> encode operationId
|
||
|
|
]
|
||
|
|
)
|
||
|
|
|
||
|
|
deleteObject
|
||
|
|
:: ProbeContext
|
||
|
|
-> Session
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> String
|
||
|
|
-> IO CurlResponse
|
||
|
|
deleteObject context session root path operationId =
|
||
|
|
curl
|
||
|
|
[ "--cookie", sessionCookies session
|
||
|
|
, "--header", "Content-Type: application/json"
|
||
|
|
, "--data"
|
||
|
|
, "{\"root\":\""
|
||
|
|
<> root
|
||
|
|
<> "\",\"path\":\""
|
||
|
|
<> path
|
||
|
|
<> "\",\"operation_id\":\""
|
||
|
|
<> operationId
|
||
|
|
<> "\",\"csrf\":\""
|
||
|
|
<> B8.unpack (sessionCsrf session)
|
||
|
|
<> "\"}"
|
||
|
|
, probeBase context <> "/api/delete"
|
||
|
|
]
|
||
|
|
|
||
|
|
sha256Hex :: BS.ByteString -> BS.ByteString
|
||
|
|
sha256Hex input =
|
||
|
|
B16.encode (BA.convert (hash input :: Digest SHA256))
|
||
|
|
|
||
|
|
encode :: String -> String
|
||
|
|
encode = B8.unpack . urlEncode True . Text.encodeUtf8 . Text.pack
|