{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE CPP     #-}
module MiniCurl (
    CURL,
    withLibcurl,
    withCurl,
    curlPerform,
    curlResponseCode,
) where

import Control.Exception        (bracket, bracket_)
import Data.ByteString.Internal (ByteString (..))
import Data.Coerce              (coerce)
import Data.Word                (Word8)
import Foreign.C.String         (CString, withCString)
import Control.Concurrent.MVar
import Foreign.C.Types          (CInt (..), CSize (..))
import Foreign.ForeignPtr       (withForeignPtr)
import Foreign.Ptr              (Ptr)
import GHC.ForeignPtr           (mallocPlainForeignPtrBytes)

-- | Curl handle.
newtype CURL = CURL (MVar (Ptr Curl))

-- | (Globally) initialize @libcurl@.
--
-- Wrap your @main@ in it:
--
-- @
-- main :: IO ()
-- main = 'withLibcurl' $ do
--     ...
-- @
--
withLibcurl :: IO r -> IO r
withLibcurl :: forall r. IO r -> IO r
withLibcurl = forall a b c. IO a -> IO b -> IO c -> IO c
bracket_ IO CInt
c_minicurl_global_init IO ()
c_minicurl_global_cleanup

-- | Create curl handle.
--
-- Note: you can reuse 'CURL' handle for multiple requests.
withCurl :: (CURL -> IO r) -> IO r
withCurl :: forall r. (CURL -> IO r) -> IO r
withCurl CURL -> IO r
kont = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr Curl)
c_minicurl_init Ptr Curl -> IO ()
c_minicurl_cleanup forall a b. (a -> b) -> a -> b
$ \Ptr Curl
ptr ->
    forall a. a -> IO (MVar a)
newMVar Ptr Curl
ptr forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= coerce :: forall a b. Coercible a b => a -> b
coerce CURL -> IO r
kont

-- | Perform request.
--
-- The resulting 'ByteString' will be exactly of the size specified by size argument.
-- If response is smaller, the rest will be zeros; if larger the response will be truncated (not read further)!
-- It's your job to verify that transport was successful, e.g. if you know the expected hash of the download.
--
-- 'curlPerform' is thread-safe (underlying handle in 'CURL' is wrapped in 'MVar').
--
curlPerform
    :: CURL     -- ^ CURL handle
    -> String   -- ^ URL
    -> Int      -- ^ Expected size of the output.
    -> IO ByteString
curlPerform :: CURL -> String -> Int -> IO ByteString
curlPerform (CURL MVar (Ptr Curl)
curlMVar) String
url Int
size = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar (Ptr Curl)
curlMVar forall a b. (a -> b) -> a -> b
$ \Ptr Curl
curl -> do
    ForeignPtr Word8
fptr <- forall a. Int -> IO (ForeignPtr a)
mallocPlainForeignPtrBytes Int
size
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr ->
        forall a. String -> (CString -> IO a) -> IO a
withCString String
url forall a b. (a -> b) -> a -> b
$ \CString
c_url -> do
            CInt
_res <- Ptr Curl -> CString -> Ptr Word8 -> CSize -> IO CInt
c_minicurl_perform Ptr Curl
curl CString
c_url Ptr Word8
ptr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size :: CSize)
            forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if MIN_VERSION_bytestring(0,11,0)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> Int -> ByteString
BS ForeignPtr Word8
fptr Int
size
#else
    return $ PS fptr 0 size
#endif

-- | Get (last) response code.
curlResponseCode :: CURL -> IO Int
curlResponseCode :: CURL -> IO Int
curlResponseCode (CURL MVar (Ptr Curl)
curlMVar) = forall a b. MVar a -> (a -> IO b) -> IO b
withMVar MVar (Ptr Curl)
curlMVar forall a b. (a -> b) -> a -> b
$ \Ptr Curl
curl ->
    forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Curl -> IO CInt
c_minicurl_response_code Ptr Curl
curl

-------------------------------------------------------------------------------
-- FFI
-------------------------------------------------------------------------------

data Curl

foreign import capi safe "hs_minicurl.h hs_minicurl_global_init" c_minicurl_global_init :: IO CInt
foreign import capi safe "hs_minicurl.h hs_minicurl_global_cleanup" c_minicurl_global_cleanup :: IO ()
foreign import capi safe "hs_minicurl.h hs_minicurl_init" c_minicurl_init :: IO (Ptr Curl)
foreign import capi safe "hs_minicurl.h hs_minicurl_cleanup" c_minicurl_cleanup :: Ptr Curl -> IO ()
foreign import capi safe "hs_minicurl.h hs_minicurl_perform" c_minicurl_perform :: Ptr Curl -> CString -> Ptr Word8 -> CSize -> IO CInt
foreign import capi safe "hs_minicurl.h hs_minicurl_response_code" c_minicurl_response_code :: Ptr Curl -> IO CInt