ladda från ika fokus

backend/ICAFocus.hs

@@ -0,0 +1,82 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ICAFocus where
+
+import qualified Network.HTTP.Client as H
+import qualified Network.HTTP.Client.TLS as H
+import Network.HTTP.Types.Status
+import Data.Aeson
+import Data.Aeson.Types
+import Data.Aeson.KeyMap
+import Data.Text
+import Text.Read
+import Data.ByteString.Lazy
+import GHC.Generics
+
+newtype ImageLink = ImageLink { getLink :: String }
+  deriving (Show)
+
+newtype ImageData = ImageData { getData :: ByteString }
+instance Show ImageData where
+  show _ = "ImageData { ... }"
+
+data ICAFocusItem a = ICAFocusItem
+  { name :: Text
+  , image :: a
+  , pricePerUnit :: Float
+  , pricePerKg :: Float
+  }
+  deriving (Show, Functor)
+
+type ICAFocusData = ICAFocusItem ImageLink
+type ICAFocusProduct = ICAFocusItem ImageData
+
+instance FromJSON ICAFocusData where
+  parseJSON (Object v) = do
+    productMap <- (v .: "entities") >>= (.: "product") :: Parser Object
+    product <- case elems productMap of
+      [Object x] -> pure x
+      [] -> fail "No products"
+      _ -> fail "Too many products"
+
+    name <- product .: "name"
+    pricePerUnitStr <- product .: "price" >>= (.: "current") >>= (.: "amount") :: Parser String
+    pricePerUnit <- case readEither pricePerUnitStr of
+      Right x -> pure x
+      Left e -> fail e
+    pricePerKgStr <- product .: "price" >>= (.: "unit") >>= (.: "current") >>= (.: "amount") :: Parser String
+    pricePerKg <- case readEither pricePerKgStr of
+      Right x -> pure x
+      Left e -> fail e
+    imageLink <- product .: "image" >>= (.: "src")
+
+    pure $ ICAFocusItem name (ImageLink imageLink) pricePerUnit pricePerKg
+
+loadProductData :: Int -> IO (Either String ICAFocusData)
+loadProductData product_id = do
+  httpman <- H.newManager H.tlsManagerSettings
+  req <- H.parseRequest $ "https://handlaprivatkund.ica.se/stores/1004247/api/v4/products/bop?retailerProductId=" ++ show product_id
+  resp <- H.httpLbs req httpman
+
+  if H.responseStatus resp == status200
+    then pure $ eitherDecode $ H.responseBody resp
+    else pure $ Left "Error status code"
+
+loadProductImage :: ICAFocusData -> IO (Either String ICAFocusProduct)
+loadProductImage x = do
+  httpman <- H.newManager H.tlsManagerSettings
+  req <- H.parseRequest $ (getLink . image) x
+  resp <- H.httpLbs req httpman
+
+  if H.responseStatus resp == status200
+    then do
+      let imageData = H.responseBody resp
+      pure $ Right $ (const (ImageData imageData)) <$> x
+    else pure $ Left "Error status code"
+
+loadProduct :: Int -> IO (Either String ICAFocusProduct)
+loadProduct product_id = do
+  prod <- loadProductData product_id
+  case prod of
+    Right x -> loadProductImage x
+    Left e -> pure $ Left e

flake.nix

@@ -11,7 +11,9 @@
       let pkgs = nixpkgs.legacyPackages.${system};
           buildInputs = [
             pkgs.postgresql_15_jit
-            ( pkgs.ghc.withPackages (ps: with ps; [ scotty postgresql-typed ]) )
+            ( pkgs.ghc.withPackages (ps: with ps; [
+              scotty postgresql-typed http-client-tls aeson
+            ]) )
           ];
       in rec {
         packages = {